Move sources to src/ subdirectory.

451 files changed, 222443 insertions, 0 deletions

diff --git a/src/back_end.adb b/src/back_end.adb
new file mode 100644
index 000000000..81bc20732
--- /dev/null
+++ b/src/back_end.adb
@@ -0,0 +1,38 @@
+--  Back-end specialization
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Flags; use Flags;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Back_End is
+   -- Transform a library identifier into a file name.
+   -- Very simple mechanism: just add '-simVV.cf' extension, where VV
+   -- is the version.
+   function Default_Library_To_File_Name (Library: Iir_Library_Declaration)
+     return String
+   is
+   begin
+      case Vhdl_Std is
+         when Vhdl_87 =>
+            return Image_Identifier (Library) & "-obj87.cf";
+         when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 =>
+            return Image_Identifier (Library) & "-obj93.cf";
+         when Vhdl_08 =>
+            return Image_Identifier (Library) & "-obj08.cf";
+      end case;
+   end Default_Library_To_File_Name;
+end Back_End;
diff --git a/src/back_end.ads b/src/back_end.ads
new file mode 100644
index 000000000..3ee1e686a
--- /dev/null
+++ b/src/back_end.ads
@@ -0,0 +1,57 @@
+--  Back-end specialization
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Back_End is
+   --  Return the name of the library file for LIBRARY.
+   --  The library file describe the contents of LIBRARY.
+   function Default_Library_To_File_Name (Library : Iir_Library_Declaration)
+                                         return String;
+
+   type Library_To_File_Name_Acc is
+     access function (Library : Iir_Library_Declaration) return String;
+
+   Library_To_File_Name : Library_To_File_Name_Acc :=
+     Default_Library_To_File_Name'Access;
+
+   --  Back-end options.
+   type Parse_Option_Acc is access function (Opt : String) return Boolean;
+   Parse_Option : Parse_Option_Acc := null;
+
+   --  Disp back-end option help.
+   type Disp_Option_Acc is access procedure;
+   Disp_Option : Disp_Option_Acc := null;
+
+   --  UNIT is a design unit from parse.
+   --  According to the current back-end, do what is necessary.
+   --
+   --  If MAIN is true, then UNIT is a wanted to be analysed design unit, and
+   --  dump/list options can applied.
+   --  This avoid to dump/list units fetched (through a selected name or a
+   --  use clause) indirectly by the main unit.
+   type Finish_Compilation_Acc is access
+     procedure (Unit : Iir_Design_Unit; Main : Boolean := False);
+
+   Finish_Compilation : Finish_Compilation_Acc := null;
+
+   --  DECL is an architecture (library unit) or a subprogram (specification)
+   --  decorated with a FOREIGN attribute.  Do back-end checks.
+   --  May be NULL for no additionnal checks.
+   type Sem_Foreign_Acc is access procedure (Decl : Iir);
+   Sem_Foreign : Sem_Foreign_Acc := null;
+end Back_End;
diff --git a/src/bug.adb b/src/bug.adb
new file mode 100644
index 000000000..0948b97ff
--- /dev/null
+++ b/src/bug.adb
@@ -0,0 +1,104 @@
+--  Bug handling
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with GNAT.Directory_Operations;
+with Version; use Version;
+
+package body Bug is
+   --  Declared in the files generated by gnatbind.
+   --  Note: since the string is exported with C convension, there is no way
+   --  to know the length (gnat1 crashes if the string is unconstrained).
+   --  Hopefully, the format of the string seems to be fixed.
+   --  We don't use GNAT.Compiler_Version because it doesn't exist
+   --   in gnat 3.15p
+   GNAT_Version : constant String (1 .. 31 + 15);
+   pragma Import (C, GNAT_Version, "__gnat_version");
+
+   function Get_Gnat_Version return String
+   is
+      C : Character;
+   begin
+      for I in GNAT_Version'Range loop
+         C := GNAT_Version (I);
+         case C is
+            when ' '
+              | 'A' .. 'Z'
+              | 'a' .. 'z'
+              | '0' .. '9'
+              | ':'
+              | '-'
+              | '.'
+              | '(' =>
+               --  Accept only a few printable characters.
+               --  Underscore is excluded since the next bytes after
+               --  GNAT_Version is Ada_Main_Program_Name, which often starts
+               --  with _ada_.
+               null;
+            when ')' =>
+               return GNAT_Version (1 .. I);
+            when others =>
+               return GNAT_Version (1 .. I - 1);
+         end case;
+      end loop;
+      return GNAT_Version;
+   end Get_Gnat_Version;
+
+   procedure Disp_Bug_Box (Except : Exception_Occurrence)
+   is
+      Id : Exception_Id;
+   begin
+      New_Line (Standard_Error);
+      Put_Line
+        (Standard_Error,
+         "******************** GHDL Bug occured ****************************");
+      Put_Line
+        (Standard_Error,
+         "Please report this bug on http://gna.org/projects/ghdl");
+      Put_Line (Standard_Error, "GHDL release: " & Ghdl_Release);
+      Put_Line (Standard_Error, "Compiled with " & Get_Gnat_Version);
+      Put_Line (Standard_Error, "In directory: " &
+                GNAT.Directory_Operations.Get_Current_Dir);
+      --Put_Line
+      --  ("Program name: " & Command_Name);
+      --Put_Line
+      --  ("Program arguments:");
+      --for I in 1 .. Argument_Count loop
+      --   Put_Line ("  " & Argument (I));
+      --end loop;
+      Put_Line (Standard_Error, "Command line:");
+      Put (Standard_Error, Command_Name);
+      for I in 1 .. Argument_Count loop
+         Put (Standard_Error, ' ');
+         Put (Standard_Error, Argument (I));
+      end loop;
+      New_Line (Standard_Error);
+      Id := Exception_Identity (Except);
+      if Id /= Null_Id then
+         Put_Line (Standard_Error,
+                   "Exception " & Exception_Name (Id) & " raised");
+         --Put_Line ("exception message: " & Exception_Message (Except));
+         Put_Line (Standard_Error,
+                   "Exception information:");
+         Put (Standard_Error, Exception_Information (Except));
+      end if;
+      Put_Line
+        (Standard_Error,
+         "******************************************************************");
+   end Disp_Bug_Box;
+end Bug;
diff --git a/src/bug.ads b/src/bug.ads
new file mode 100644
index 000000000..c90ca0976
--- /dev/null
+++ b/src/bug.ads
@@ -0,0 +1,26 @@
+--  Bug handling
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Exceptions; use Ada.Exceptions;
+
+package Bug is
+   --  Display a bug box for EXCEPT.
+   procedure Disp_Bug_Box (Except : Exception_Occurrence);
+
+   --  Get the gnat version used to bind the unit.
+   function Get_Gnat_Version return String;
+end Bug;
diff --git a/src/canon.adb b/src/canon.adb
new file mode 100644
index 000000000..cd2dae0fd
--- /dev/null
+++ b/src/canon.adb
@@ -0,0 +1,2735 @@
+--  Canonicalization pass
+--  Copyright (C) 2002, 2003, 2004, 2005, 2008 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Errorout; use Errorout;
+with Iirs_Utils; use Iirs_Utils;
+with Types; use Types;
+with Name_Table;
+with Sem;
+with Iir_Chains; use Iir_Chains;
+with Flags; use Flags;
+with PSL.Nodes;
+with PSL.Rewrites;
+with PSL.Build;
+
+package body Canon is
+   --  Canonicalize a list of declarations.  LIST can be null.
+   --  PARENT must be the parent of the current statements chain for LIST,
+   --  or NULL_IIR if LIST has no corresponding current statments.
+   procedure Canon_Declarations (Top : Iir_Design_Unit;
+                                 Decl_Parent : Iir;
+                                 Parent : Iir);
+   procedure Canon_Declaration (Top : Iir_Design_Unit;
+                                Decl : Iir;
+                                Parent : Iir;
+                                Decl_Parent : Iir);
+
+   --  Canon on expressions, mainly for function calls.
+   procedure Canon_Expression (Expr: Iir);
+
+   --  Canonicalize an association list.
+   --  If ASSOCIATION_LIST is not null, then it is re-ordored and returned.
+   --  If ASSOCIATION_LIST is null then:
+   --    if INTERFACE_LIST is null then returns null.
+   --    if INTERFACE_LIST is not null, a default list is created.
+   function Canon_Association_Chain
+     (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir)
+     return Iir;
+
+   --  Like Canon_Association_Chain but recurse on actuals.
+   function Canon_Association_Chain_And_Actuals
+     (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir)
+     return Iir;
+
+   --  Like Canon_Subprogram_Call, but recurse on actuals.
+   procedure Canon_Subprogram_Call_And_Actuals (Call : Iir);
+
+   --  Canonicalize block configuration CONF.
+   --  TOP is used to added dependences to the design unit which CONF
+   --  belongs to.
+   procedure Canon_Block_Configuration (Top : Iir_Design_Unit;
+                                        Conf : Iir_Block_Configuration);
+
+   procedure Canon_Subtype_Indication (Def : Iir);
+   procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir);
+
+   procedure Canon_Extract_Sensitivity_Aggregate
+     (Aggr : Iir;
+      Sensitivity_List : Iir_List;
+      Is_Target : Boolean;
+      Aggr_Type : Iir;
+      Dim : Natural)
+   is
+      Assoc : Iir;
+   begin
+      Assoc := Get_Association_Choices_Chain (Aggr);
+      if Get_Nbr_Elements (Get_Index_Subtype_List (Aggr_Type)) = Dim then
+         while Assoc /= Null_Iir loop
+            Canon_Extract_Sensitivity
+              (Get_Associated_Expr (Assoc), Sensitivity_List, Is_Target);
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      else
+         while Assoc /= Null_Iir loop
+            Canon_Extract_Sensitivity_Aggregate
+              (Get_Associated_Expr (Assoc), Sensitivity_List,
+               Is_Target, Aggr_Type, Dim + 1);
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      end if;
+   end Canon_Extract_Sensitivity_Aggregate;
+
+   procedure Canon_Extract_Sensitivity
+     (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False)
+   is
+      El : Iir;
+      List: Iir_List;
+   begin
+      if Get_Expr_Staticness (Expr) /= None then
+         return;
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Slice_Name =>
+            if not Is_Target and then
+              Get_Name_Staticness (Expr) >= Globally
+            then
+               if Is_Signal_Object (Expr) then
+                  Add_Element (Sensitivity_List, Expr);
+               end if;
+            else
+               declare
+                  Suff : Iir;
+               begin
+                  Canon_Extract_Sensitivity
+                    (Get_Prefix (Expr), Sensitivity_List, Is_Target);
+                  Suff := Get_Suffix (Expr);
+                  if Get_Kind (Suff) not in Iir_Kinds_Scalar_Type_Definition
+                  then
+                     Canon_Extract_Sensitivity
+                       (Suff, Sensitivity_List, False);
+                  end if;
+               end;
+            end if;
+
+         when Iir_Kind_Selected_Element =>
+            if not Is_Target and then
+              Get_Name_Staticness (Expr) >= Globally
+            then
+               if Is_Signal_Object (Expr) then
+                  Add_Element (Sensitivity_List, Expr);
+               end if;
+            else
+               Canon_Extract_Sensitivity (Get_Prefix (Expr),
+                                          Sensitivity_List,
+                                          Is_Target);
+            end if;
+
+         when Iir_Kind_Indexed_Name =>
+            if not Is_Target
+              and then Get_Name_Staticness (Expr) >= Globally
+            then
+               if Is_Signal_Object (Expr) then
+                  Add_Element (Sensitivity_List, Expr);
+               end if;
+            else
+               Canon_Extract_Sensitivity (Get_Prefix (Expr),
+                                          Sensitivity_List,
+                                          Is_Target);
+               List := Get_Index_List (Expr);
+               for I in Natural loop
+                  El := Get_Nth_Element (List, I);
+                  exit when El = Null_Iir;
+                  Canon_Extract_Sensitivity (El, Sensitivity_List, False);
+               end loop;
+            end if;
+
+         when Iir_Kind_Function_Call =>
+            El := Get_Parameter_Association_Chain (Expr);
+            while El /= Null_Iir loop
+               case Get_Kind (El) is
+                  when Iir_Kind_Association_Element_By_Expression =>
+                     Canon_Extract_Sensitivity
+                       (Get_Actual (El), Sensitivity_List, False);
+                  when Iir_Kind_Association_Element_Open =>
+                     null;
+                  when others =>
+                     Error_Kind ("canon_extract_sensitivity(call)", El);
+               end case;
+               El := Get_Chain (El);
+            end loop;
+
+         when Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression =>
+            Canon_Extract_Sensitivity
+              (Get_Expression (Expr), Sensitivity_List, False);
+
+         when Iir_Kind_Allocator_By_Subtype =>
+            null;
+
+         when Iir_Kinds_Monadic_Operator =>
+            Canon_Extract_Sensitivity
+              (Get_Operand (Expr), Sensitivity_List, False);
+         when Iir_Kinds_Dyadic_Operator =>
+            Canon_Extract_Sensitivity
+              (Get_Left (Expr), Sensitivity_List, False);
+            Canon_Extract_Sensitivity
+              (Get_Right (Expr), Sensitivity_List, False);
+
+         when Iir_Kind_Range_Expression =>
+            Canon_Extract_Sensitivity
+              (Get_Left_Limit (Expr), Sensitivity_List, False);
+            Canon_Extract_Sensitivity
+              (Get_Right_Limit (Expr), Sensitivity_List, False);
+
+         when Iir_Kinds_Type_Attribute =>
+            null;
+         when Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute =>
+            --  LRM 8.1
+            --  An attribute name: [...]; otherwise, apply this rule to the
+            --  prefix of the attribute name.
+            Canon_Extract_Sensitivity
+              (Get_Prefix (Expr), Sensitivity_List, False);
+
+
+         when Iir_Kind_Last_Value_Attribute =>
+            null;
+
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            --  LRM 8.1
+            --  A simple name that denotes a signal, add the longuest static
+            --  prefix of the name to the sensitivity set;
+            --
+            --  An attribute name: if the designator denotes a signal
+            --  attribute, add the longuest static prefix of the name of the
+            --  implicit signal denoted by the attribute name to the
+            --  sensitivity set; [...]
+            if not Is_Target then
+               Add_Element (Sensitivity_List, Expr);
+            end if;
+
+         when Iir_Kind_Object_Alias_Declaration =>
+            Canon_Extract_Sensitivity
+              (Get_Name (Expr), Sensitivity_List, Is_Target);
+
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_File_Declaration =>
+            null;
+
+         when Iir_Kinds_Array_Attribute =>
+            -- was Iir_Kind_Left_Array_Attribute
+            -- ditto Right, Low, High, Length
+            -- add Ascending, Range and Reverse_Range...
+            null;
+            --Canon_Extract_Sensitivity
+            --  (Get_Prefix (Expr), Sensitivity_List, Is_Target);
+
+         when Iir_Kind_Value_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kinds_Scalar_Type_Attribute =>
+            Canon_Extract_Sensitivity
+              (Get_Parameter (Expr), Sensitivity_List, Is_Target);
+
+         when Iir_Kind_Aggregate =>
+            declare
+               Aggr_Type : Iir;
+            begin
+               Aggr_Type := Get_Base_Type (Get_Type (Expr));
+               case Get_Kind (Aggr_Type) is
+                  when Iir_Kind_Array_Type_Definition =>
+                     Canon_Extract_Sensitivity_Aggregate
+                       (Expr, Sensitivity_List, Is_Target, Aggr_Type, 1);
+                  when Iir_Kind_Record_Type_Definition =>
+                     El := Get_Association_Choices_Chain (Expr);
+                     while El /= Null_Iir loop
+                        Canon_Extract_Sensitivity
+                          (Get_Associated_Expr (El), Sensitivity_List,
+                           Is_Target);
+                        El := Get_Chain (El);
+                     end loop;
+                  when others =>
+                     Error_Kind ("canon_extract_sensitivity(aggr)", Aggr_Type);
+               end case;
+            end;
+
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Canon_Extract_Sensitivity
+              (Get_Named_Entity (Expr), Sensitivity_List, Is_Target);
+
+         when others =>
+            Error_Kind ("canon_extract_sensitivity", Expr);
+      end case;
+   end Canon_Extract_Sensitivity;
+
+   procedure Canon_Extract_Sensitivity_If_Not_Null
+     (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is
+   begin
+      if Expr /= Null_Iir then
+         Canon_Extract_Sensitivity (Expr, Sensitivity_List, Is_Target);
+      end if;
+   end Canon_Extract_Sensitivity_If_Not_Null;
+
+   procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity
+     (Chain : Iir; List : Iir_List)
+   is
+      Stmt : Iir;
+   begin
+      Stmt := Chain;
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Assertion_Statement =>
+               --  LRM08 11.3
+               --  * For each assertion, report, next, exit or return
+               --    statement, apply the rule of 10.2 to each expression
+               --    in the statement, and construct the union of the
+               --    resulting sets.
+               Canon_Extract_Sensitivity
+                 (Get_Assertion_Condition (Stmt), List);
+               Canon_Extract_Sensitivity
+                 (Get_Severity_Expression (Stmt), List);
+               Canon_Extract_Sensitivity
+                 (Get_Report_Expression (Stmt), List);
+            when Iir_Kind_Report_Statement =>
+               --  LRM08 11.3
+               --  See assertion_statement case.
+               Canon_Extract_Sensitivity
+                 (Get_Severity_Expression (Stmt), List);
+               Canon_Extract_Sensitivity
+                 (Get_Report_Expression (Stmt), List);
+            when Iir_Kind_Next_Statement
+              | Iir_Kind_Exit_Statement =>
+               --  LRM08 11.3
+               --  See assertion_statement case.
+               Canon_Extract_Sensitivity
+                 (Get_Condition (Stmt), List);
+            when Iir_Kind_Return_Statement =>
+               --  LRM08 11.3
+               --  See assertion_statement case.
+               Canon_Extract_Sensitivity_If_Not_Null
+                 (Get_Expression (Stmt), List);
+            when Iir_Kind_Variable_Assignment_Statement =>
+               --  LRM08 11.3
+               --  * For each assignment statement, apply the rule of 10.2 to
+               --    each expression occuring in the assignment, including any
+               --    expressions occuring in the index names or slice names in
+               --    the target, and construct the union of the resulting sets.
+               Canon_Extract_Sensitivity (Get_Target (Stmt), List, True);
+               Canon_Extract_Sensitivity (Get_Expression (Stmt), List, False);
+            when Iir_Kind_Signal_Assignment_Statement =>
+               --  LRM08 11.3
+               --  See variable assignment statement case.
+               Canon_Extract_Sensitivity (Get_Target (Stmt), List, True);
+               Canon_Extract_Sensitivity_If_Not_Null
+                 (Get_Reject_Time_Expression (Stmt), List);
+               declare
+                  We: Iir_Waveform_Element;
+               begin
+                  We := Get_Waveform_Chain (Stmt);
+                  while We /= Null_Iir loop
+                     Canon_Extract_Sensitivity (Get_We_Value (We), List);
+                     We := Get_Chain (We);
+                  end loop;
+               end;
+            when Iir_Kind_If_Statement =>
+               --  LRM08 11.3
+               --  * For each if statement, apply the rule of 10.2 to the
+               --    condition and apply this rule recursively to each
+               --    sequence of statements within the if statement, and
+               --    construct the union of the resuling sets.
+               declare
+                  El1 : Iir := Stmt;
+                  Cond : Iir;
+               begin
+                  loop
+                     Cond := Get_Condition (El1);
+                     if Cond /= Null_Iir then
+                        Canon_Extract_Sensitivity (Cond, List);
+                     end if;
+                     Canon_Extract_Sequential_Statement_Chain_Sensitivity
+                       (Get_Sequential_Statement_Chain (El1), List);
+                     El1 := Get_Else_Clause (El1);
+                     exit when El1 = Null_Iir;
+                  end loop;
+               end;
+            when Iir_Kind_Case_Statement =>
+               --  LRM08 11.3
+               --  * For each case statement, apply the rule of 10.2 to the
+               --    expression and apply this rule recursively to each
+               --    sequence of statements within the case statement, and
+               --    construct the union of the resulting sets.
+               Canon_Extract_Sensitivity (Get_Expression (Stmt), List);
+               declare
+                  Choice: Iir;
+               begin
+                  Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+                  while Choice /= Null_Iir loop
+                     Canon_Extract_Sequential_Statement_Chain_Sensitivity
+                       (Get_Associated_Chain (Choice), List);
+                     Choice := Get_Chain (Choice);
+                  end loop;
+               end;
+            when Iir_Kind_While_Loop_Statement =>
+               --  LRM08 11.3
+               --  * For each loop statement, apply the rule of 10.2 to each
+               --    expression in the iteration scheme, if present, and apply
+               --    this rule recursively to the sequence of statements within
+               --    the loop statement, and construct the union of the
+               --    resulting sets.
+               Canon_Extract_Sensitivity_If_Not_Null
+                 (Get_Condition (Stmt), List);
+               Canon_Extract_Sequential_Statement_Chain_Sensitivity
+                 (Get_Sequential_Statement_Chain (Stmt), List);
+            when Iir_Kind_For_Loop_Statement =>
+               --  LRM08 11.3
+               --  See loop statement case.
+               declare
+                  It : constant Iir := Get_Parameter_Specification (Stmt);
+                  It_Type : constant Iir := Get_Type (It);
+                  Rng : constant Iir := Get_Range_Constraint (It_Type);
+               begin
+                  if Get_Kind (Rng) = Iir_Kind_Range_Expression then
+                     Canon_Extract_Sensitivity (Rng, List);
+                  end if;
+               end;
+               Canon_Extract_Sequential_Statement_Chain_Sensitivity
+                 (Get_Sequential_Statement_Chain (Stmt), List);
+            when Iir_Kind_Null_Statement =>
+               --  LRM08 11.3
+               --  ?
+               null;
+            when Iir_Kind_Procedure_Call_Statement =>
+               --  LRM08 11.3
+               --  * For each procedure call statement, apply the rule of 10.2
+               --    to each actual designator (other than OPEN) associated
+               --    with each formal parameter of mode IN or INOUT, and
+               --    construct the union of the resulting sets.
+               declare
+                  Param : Iir;
+               begin
+                  Param := Get_Parameter_Association_Chain
+                    (Get_Procedure_Call (Stmt));
+                  while Param /= Null_Iir loop
+                     if (Get_Kind (Param)
+                           = Iir_Kind_Association_Element_By_Expression)
+                       and then (Get_Mode (Get_Association_Interface (Param))
+                                   /= Iir_Out_Mode)
+                     then
+                        Canon_Extract_Sensitivity (Get_Actual (Param), List);
+                     end if;
+                     Param := Get_Chain (Param);
+                  end loop;
+               end;
+            when others =>
+               Error_Kind
+                 ("canon_extract_sequential_statement_chain_sensitivity",
+                  Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Canon_Extract_Sequential_Statement_Chain_Sensitivity;
+
+   procedure Canon_Extract_Sensitivity_From_Callees
+     (Callees_List : Iir_List; Sensitivity_List : Iir_List)
+   is
+      Callee : Iir;
+      Bod : Iir;
+   begin
+      --  LRM08 11.3
+      --  Moreover, for each subprogram for which the process is a parent
+      --  (see 4.3), the sensitivity list includes members of the set
+      --  constructed by apply the preceding rule to the statements of the
+      --  subprogram, but excluding the members that denote formal signal
+      --  parameters or members of formal signal parameters of the subprogram
+      --  or any of its parents.
+      if Callees_List = Null_Iir_List then
+         return;
+      end if;
+      for I in Natural loop
+         Callee := Get_Nth_Element (Callees_List, I);
+         exit when Callee = Null_Iir;
+         if not Get_Seen_Flag (Callee) then
+            Set_Seen_Flag (Callee, True);
+            case Get_All_Sensitized_State (Callee) is
+               when Read_Signal =>
+                  Bod := Get_Subprogram_Body (Callee);
+
+                  --  Extract sensitivity from signals read in the body.
+                  --  FIXME: what about signals read during in declarations ?
+                  Canon_Extract_Sequential_Statement_Chain_Sensitivity
+                    (Get_Sequential_Statement_Chain (Bod), Sensitivity_List);
+
+                  --  Extract sensitivity from subprograms called.
+                  Canon_Extract_Sensitivity_From_Callees
+                    (Get_Callees_List (Bod), Sensitivity_List);
+
+               when No_Signal =>
+                  null;
+
+               when Unknown | Invalid_Signal =>
+                  raise Internal_Error;
+            end case;
+         end if;
+      end loop;
+   end Canon_Extract_Sensitivity_From_Callees;
+
+   function Canon_Extract_Process_Sensitivity
+     (Proc : Iir_Sensitized_Process_Statement)
+     return Iir_List
+   is
+      Res : Iir_List;
+   begin
+      Res := Create_Iir_List;
+
+      --  Signals read by statements.
+      --  FIXME: justify why signals read in declarations don't care.
+      Canon_Extract_Sequential_Statement_Chain_Sensitivity
+        (Get_Sequential_Statement_Chain (Proc), Res);
+
+      --  Signals read indirectly by subprograms called.
+      Canon_Extract_Sensitivity_From_Callees (Get_Callees_List (Proc), Res);
+
+      Set_Seen_Flag (Proc, True);
+      Clear_Seen_Flag (Proc);
+      return Res;
+   end Canon_Extract_Process_Sensitivity;
+
+--   function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir)
+--      return Iir_Aggregate
+--    is
+--       Res : Iir_Aggregate;
+--       Choice : Iir;
+--    begin
+--       Res := Create_Iir (Iir_Kind_Aggregate);
+--       Location_Copy (Res, El);
+--       Choice := Create_Iir (Iir_Kind_Association_Choice_By_None);
+--       Set_Associated (Choice, El);
+--       Append_Element (Get_Association_Choices_List (Res), Choice);
+
+--       --  will call sem_aggregate
+--       return Sem_Expr.Sem_Expression (Res, Array_Type);
+--    end Make_Aggregate;
+
+--    procedure Canon_Concatenation_Operator (Expr : Iir)
+--    is
+--       Array_Type : Iir_Array_Type_Definition;
+--       El_Type : Iir;
+--       Left, Right : Iir;
+--       Func_List : Iir_Implicit_Functions_List;
+--       Func : Iir_Implicit_Function_Declaration;
+--    begin
+--       Array_Type := Get_Type (Expr);
+--       El_Type := Get_Base_Type (Get_Element_Subtype (Array_Type));
+--       Left := Get_Left (Expr);
+--       if Get_Type (Left) = El_Type then
+--          Set_Left (Expr, Make_Aggregate (Array_Type, Left));
+--       end if;
+--       Right := Get_Right (Expr);
+--       if Get_Type (Right) = El_Type then
+--          Set_Right (Expr, Make_Aggregate (Array_Type, Right));
+--       end if;
+
+--       --  FIXME: must convert the implementation.
+--       --  Use implicit declaration list from the array_type ?
+--       Func_List := Get_Implicit_Functions_List
+--         (Get_Type_Declarator (Array_Type));
+--       for I in Natural loop
+--          Func := Get_Nth_Element (Func_List, I);
+--          if Get_Implicit_Definition (Func)
+--            = Iir_Predefined_Array_Array_Concat
+--          then
+--             Set_Implementation (Expr, Func);
+--             exit;
+--          end if;
+--       end loop;
+--    end Canon_Concatenation_Operator;
+
+   procedure Canon_Aggregate_Expression (Expr: Iir)
+   is
+      Assoc : Iir;
+   begin
+      Assoc := Get_Association_Choices_Chain (Expr);
+      while Assoc /= Null_Iir loop
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_Others
+              | Iir_Kind_Choice_By_None
+              | Iir_Kind_Choice_By_Name =>
+               null;
+            when Iir_Kind_Choice_By_Expression =>
+               Canon_Expression (Get_Choice_Expression (Assoc));
+            when Iir_Kind_Choice_By_Range =>
+               declare
+                  Choice : constant Iir := Get_Choice_Range (Assoc);
+               begin
+                  if Get_Kind (Choice) = Iir_Kind_Range_Expression then
+                     Canon_Expression (Choice);
+                  end if;
+               end;
+            when others =>
+               Error_Kind ("canon_aggregate_expression", Assoc);
+         end case;
+         Canon_Expression (Get_Associated_Expr (Assoc));
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Canon_Aggregate_Expression;
+
+   -- canon on expressions, mainly for function calls.
+   procedure Canon_Expression (Expr: Iir)
+   is
+      El : Iir;
+      List: Iir_List;
+   begin
+      if Expr = Null_Iir then
+         return;
+      end if;
+      case Get_Kind (Expr) is
+         when Iir_Kind_Range_Expression =>
+            Canon_Expression (Get_Left_Limit (Expr));
+            Canon_Expression (Get_Right_Limit (Expr));
+
+         when Iir_Kind_Slice_Name =>
+            declare
+               Suffix : Iir;
+            begin
+               Suffix := Get_Suffix (Expr);
+               if Get_Kind (Suffix) not in Iir_Kinds_Discrete_Type_Definition
+               then
+                  Canon_Expression (Suffix);
+               end if;
+               Canon_Expression (Get_Prefix (Expr));
+            end;
+
+         when Iir_Kind_Indexed_Name =>
+            Canon_Expression (Get_Prefix (Expr));
+            List := Get_Index_List (Expr);
+            for I in Natural loop
+               El := Get_Nth_Element (List, I);
+               exit when El = Null_Iir;
+               Canon_Expression (El);
+            end loop;
+
+         when Iir_Kind_Selected_Element =>
+            Canon_Expression (Get_Prefix (Expr));
+         when Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference =>
+            Canon_Expression (Get_Prefix (Expr));
+
+         when Iir_Kinds_Denoting_Name =>
+            Canon_Expression (Get_Named_Entity (Expr));
+
+         when Iir_Kinds_Monadic_Operator =>
+            Canon_Expression (Get_Operand (Expr));
+         when Iir_Kinds_Dyadic_Operator =>
+            Canon_Expression (Get_Left (Expr));
+            Canon_Expression (Get_Right (Expr));
+            if Get_Kind (Expr) = Iir_Kind_Concatenation_Operator
+              and then Canon_Concatenation
+              and then Get_Kind (Get_Implementation (Expr)) =
+              Iir_Kind_Implicit_Function_Declaration
+            then
+               --Canon_Concatenation_Operator (Expr);
+               raise Internal_Error;
+            end if;
+
+         when Iir_Kind_Function_Call =>
+            Canon_Subprogram_Call_And_Actuals (Expr);
+            -- FIXME:
+            -- should canon concatenation.
+
+         when Iir_Kind_Parenthesis_Expression =>
+            Canon_Expression (Get_Expression (Expr));
+         when Iir_Kind_Type_Conversion
+           | Iir_Kind_Qualified_Expression =>
+            Canon_Expression (Get_Expression (Expr));
+         when Iir_Kind_Aggregate =>
+            Canon_Aggregate_Expression (Expr);
+         when Iir_Kind_Allocator_By_Expression =>
+            Canon_Expression (Get_Expression (Expr));
+         when Iir_Kind_Allocator_By_Subtype =>
+            declare
+               Ind : constant Iir := Get_Subtype_Indication (Expr);
+            begin
+               if Get_Kind (Ind) = Iir_Kind_Array_Subtype_Definition then
+                  Canon_Subtype_Indication (Ind);
+               end if;
+            end;
+
+         when Iir_Kinds_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Unit_Declaration =>
+            null;
+
+         when Iir_Kinds_Array_Attribute =>
+            -- No need to canon parameter, since it is a locally static
+            -- expression.
+            declare
+               Prefix : constant Iir := Get_Prefix (Expr);
+            begin
+               if Get_Kind (Prefix) in Iir_Kinds_Denoting_Name
+                 and then (Get_Kind (Get_Named_Entity (Prefix))
+                             in Iir_Kinds_Type_Declaration)
+               then
+                  --  No canon for types.
+                  null;
+               else
+                  Canon_Expression (Prefix);
+               end if;
+            end;
+
+         when Iir_Kinds_Type_Attribute =>
+            null;
+         when Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            --  FIXME: add the default parameter ?
+            Canon_Expression (Get_Prefix (Expr));
+         when Iir_Kind_Event_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute =>
+            Canon_Expression (Get_Prefix (Expr));
+
+         when Iir_Kinds_Scalar_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute =>
+            Canon_Expression (Get_Parameter (Expr));
+
+         when Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute =>
+            null;
+
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Overflow_Literal =>
+            null;
+
+         when Iir_Kind_Element_Declaration =>
+            null;
+
+         when Iir_Kind_Attribute_Value
+           | Iir_Kind_Attribute_Name =>
+            null;
+
+         when others =>
+            Error_Kind ("canon_expression", Expr);
+            null;
+      end case;
+   end Canon_Expression;
+
+   procedure Canon_Discrete_Range (Rng : Iir) is
+   begin
+      case Get_Kind (Rng) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            Canon_Expression (Get_Range_Constraint (Rng));
+         when Iir_Kind_Enumeration_Type_Definition =>
+            null;
+         when others =>
+            Error_Kind ("canon_discrete_range", Rng);
+      end case;
+   end Canon_Discrete_Range;
+
+   procedure Canon_Waveform_Chain
+     (Chain : Iir_Waveform_Element; Sensitivity_List: Iir_List)
+   is
+      We: Iir_Waveform_Element;
+   begin
+      We := Chain;
+      while We /= Null_Iir loop
+         if Sensitivity_List /= Null_Iir_List then
+            Canon_Extract_Sensitivity
+              (Get_We_Value (We), Sensitivity_List, False);
+         end if;
+         if Canon_Flag_Expressions then
+            Canon_Expression (Get_We_Value (We));
+            if Get_Time (We) /= Null_Iir then
+               Canon_Expression (Get_Time (We));
+            end if;
+         end if;
+         We := Get_Chain (We);
+      end loop;
+   end Canon_Waveform_Chain;
+
+   -- Names associations by position,
+   -- reorder associations by name,
+   -- create omitted association,
+   function Canon_Association_Chain
+     (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir)
+     return Iir
+   is
+      -- The canon list of association.
+      N_Chain, Last : Iir;
+      Inter : Iir;
+      Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir;
+      Assoc_Chain : Iir;
+
+      Found : Boolean;
+   begin
+      --  No argument, so return now.
+      if Interface_Chain = Null_Iir then
+         pragma Assert (Association_Chain = Null_Iir);
+         return Null_Iir;
+      end if;
+
+      Sub_Chain_Init (N_Chain, Last);
+      Assoc_Chain := Association_Chain;
+
+      -- Reorder the list of association in the interface order.
+      -- Add missing associations.
+      Inter := Interface_Chain;
+      while Inter /= Null_Iir loop
+         --  Search associations with INTERFACE.
+         Found := False;
+         Assoc_El := Assoc_Chain;
+         Prev_Assoc_El := Null_Iir;
+         while Assoc_El /= Null_Iir loop
+            Next_Assoc_El := Get_Chain (Assoc_El);
+            if Get_Formal (Assoc_El) = Null_Iir then
+               Set_Formal (Assoc_El, Inter);
+            end if;
+            if Get_Association_Interface (Assoc_El) = Inter then
+
+               --  Remove ASSOC_EL from ASSOC_CHAIN
+               if Prev_Assoc_El /= Null_Iir then
+                  Set_Chain (Prev_Assoc_El, Next_Assoc_El);
+               else
+                  Assoc_Chain := Next_Assoc_El;
+               end if;
+
+               --  Append ASSOC_EL in N_CHAIN.
+               Set_Chain (Assoc_El, Null_Iir);
+               Sub_Chain_Append (N_Chain, Last, Assoc_El);
+
+               case Get_Kind (Assoc_El) is
+                  when Iir_Kind_Association_Element_Open =>
+                     goto Done;
+                  when Iir_Kind_Association_Element_By_Expression =>
+                     if Get_Whole_Association_Flag (Assoc_El) then
+                        goto Done;
+                     end if;
+                  when Iir_Kind_Association_Element_By_Individual =>
+                     Found := True;
+                  when Iir_Kind_Association_Element_Package =>
+                     goto Done;
+                  when others =>
+                     Error_Kind ("canon_association_chain", Assoc_El);
+               end case;
+            elsif Found then
+               --  No more associations.
+               goto Done;
+            else
+               Prev_Assoc_El := Assoc_El;
+            end if;
+            Assoc_El := Next_Assoc_El;
+         end loop;
+         if Found then
+            goto Done;
+         end if;
+
+         -- No association, use default expr.
+         Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open);
+         Set_Artificial_Flag (Assoc_El, True);
+         Set_Whole_Association_Flag (Assoc_El, True);
+         Location_Copy (Assoc_El, Loc);
+         Set_Formal (Assoc_El, Inter);
+         Sub_Chain_Append (N_Chain, Last, Assoc_El);
+
+         << Done >> null;
+         Inter := Get_Chain (Inter);
+      end loop;
+      pragma Assert (Assoc_Chain = Null_Iir);
+
+      return N_Chain;
+   end Canon_Association_Chain;
+
+   procedure Canon_Association_Chain_Actuals (Association_Chain : Iir)
+   is
+      Assoc_El : Iir;
+   begin
+      --  Canon actuals.
+      Assoc_El := Association_Chain;
+      while Assoc_El /= Null_Iir loop
+         if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_By_Expression
+         then
+            Canon_Expression (Get_Actual (Assoc_El));
+         end if;
+         Assoc_El := Get_Chain (Assoc_El);
+      end loop;
+   end Canon_Association_Chain_Actuals;
+
+   function Canon_Association_Chain_And_Actuals
+     (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir)
+     return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Canon_Association_Chain (Interface_Chain, Association_Chain, Loc);
+      if Canon_Flag_Expressions then
+         Canon_Association_Chain_Actuals (Res);
+      end if;
+      return Res;
+   end Canon_Association_Chain_And_Actuals;
+
+   procedure Canon_Subprogram_Call (Call : Iir)
+   is
+      Imp : constant Iir := Get_Implementation (Call);
+      Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp);
+      Assoc_Chain : Iir;
+   begin
+      Assoc_Chain := Get_Parameter_Association_Chain (Call);
+      Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call);
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+   end Canon_Subprogram_Call;
+
+   procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is
+   begin
+      Canon_Subprogram_Call (Call);
+      if Canon_Flag_Expressions then
+         Canon_Association_Chain_Actuals
+           (Get_Parameter_Association_Chain (Call));
+      end if;
+   end Canon_Subprogram_Call_And_Actuals;
+
+   --  Create a default association list for INTERFACE_LIST.
+   --  The default is a list of interfaces associated with open.
+   function Canon_Default_Association_Chain (Interface_Chain : Iir)
+     return Iir
+   is
+      Res : Iir;
+      Last : Iir;
+      Assoc, El : Iir;
+   begin
+      El := Interface_Chain;
+      Sub_Chain_Init (Res, Last);
+      while El /= Null_Iir loop
+         Assoc := Create_Iir (Iir_Kind_Association_Element_Open);
+         Set_Whole_Association_Flag (Assoc, True);
+         Set_Artificial_Flag (Assoc, True);
+         Set_Formal (Assoc, El);
+         Location_Copy (Assoc, El);
+         Sub_Chain_Append (Res, Last, Assoc);
+         El := Get_Chain (El);
+      end loop;
+      return Res;
+   end Canon_Default_Association_Chain;
+
+--    function Canon_Default_Map_Association_List
+--      (Formal_List, Actual_List : Iir_List; Loc : Location_Type)
+--      return Iir_Association_List
+--    is
+--       Res : Iir_Association_List;
+--       Formal, Actual : Iir;
+--       Assoc : Iir;
+--       Nbr_Assoc : Natural;
+--    begin
+--       --  formal is the entity port/generic.
+--       if Formal_List = Null_Iir_List then
+--          if Actual_List /= Null_Iir_List then
+--             raise Internal_Error;
+--          end if;
+--          return Null_Iir_List;
+--       end if;
+
+--       Res := Create_Iir (Iir_Kind_Association_List);
+--       Set_Location (Res, Loc);
+--       Nbr_Assoc := 0;
+--       for I in Natural loop
+--          Formal := Get_Nth_Element (Formal_List, I);
+--          exit when Formal = Null_Iir;
+--          Actual := Find_Name_In_List (Actual_List, Get_Identifier (Formal));
+--          if Actual /= Null_Iir then
+--            Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+--             Set_Whole_Association_Flag (Assoc, True);
+--             Set_Actual (Assoc, Actual);
+--             Nbr_Assoc := Nbr_Assoc + 1;
+--          else
+--             Assoc := Create_Iir (Iir_Kind_Association_Element_Open);
+--          end if;
+--          Set_Location (Assoc, Loc);
+--          Set_Formal (Assoc, Formal);
+--          Set_Associated_Formal (Assoc, Formal);
+--          Append_Element (Res, Assoc);
+--       end loop;
+--       if Nbr_Assoc /= Get_Nbr_Elements (Actual_List) then
+--          --  There is non-associated actuals.
+--          raise Internal_Error;
+--       end if;
+--       return Res;
+--    end Canon_Default_Map_Association_List;
+
+   --  Inner loop if any; used to canonicalize exit/next statement.
+   Cur_Loop : Iir;
+
+   procedure Canon_Sequential_Stmts (First : Iir)
+   is
+      Stmt: Iir;
+      Expr: Iir;
+      Prev_Loop : Iir;
+   begin
+      Stmt := First;
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_If_Statement =>
+               declare
+                  Cond: Iir;
+                  Clause: Iir := Stmt;
+               begin
+                  while Clause /= Null_Iir loop
+                     Cond := Get_Condition (Clause);
+                     if Cond /= Null_Iir then
+                        Canon_Expression (Cond);
+                     end if;
+                     Canon_Sequential_Stmts
+                       (Get_Sequential_Statement_Chain (Clause));
+                     Clause := Get_Else_Clause (Clause);
+                  end loop;
+               end;
+
+            when Iir_Kind_Signal_Assignment_Statement =>
+               Canon_Expression (Get_Target (Stmt));
+               Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List);
+
+            when Iir_Kind_Variable_Assignment_Statement =>
+               Canon_Expression (Get_Target (Stmt));
+               Canon_Expression (Get_Expression (Stmt));
+
+            when Iir_Kind_Wait_Statement =>
+               declare
+                  Expr: Iir;
+                  List: Iir_List;
+               begin
+                  Expr := Get_Timeout_Clause (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+                  Expr := Get_Condition_Clause (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+                  List := Get_Sensitivity_List (Stmt);
+                  if List = Null_Iir_List and then Expr /= Null_Iir then
+                     List := Create_Iir_List;
+                     Canon_Extract_Sensitivity (Expr, List, False);
+                     Set_Sensitivity_List (Stmt, List);
+                  end if;
+               end;
+
+            when Iir_Kind_Case_Statement =>
+               Canon_Expression (Get_Expression (Stmt));
+               declare
+                  Choice: Iir;
+               begin
+                  Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+                  while Choice /= Null_Iir loop
+                     -- FIXME: canon choice expr.
+                     Canon_Sequential_Stmts (Get_Associated_Chain (Choice));
+                     Choice := Get_Chain (Choice);
+                  end loop;
+               end;
+
+            when Iir_Kind_Assertion_Statement
+              | Iir_Kind_Report_Statement =>
+               if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then
+                  Canon_Expression (Get_Assertion_Condition (Stmt));
+               end if;
+               Expr := Get_Report_Expression (Stmt);
+               if Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+               Expr := Get_Severity_Expression (Stmt);
+               if Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+
+            when Iir_Kind_For_Loop_Statement =>
+               -- FIXME: decl.
+               Prev_Loop := Cur_Loop;
+               Cur_Loop := Stmt;
+               if Canon_Flag_Expressions then
+                  Canon_Discrete_Range
+                    (Get_Type (Get_Parameter_Specification (Stmt)));
+               end if;
+               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt));
+               Cur_Loop := Prev_Loop;
+
+            when Iir_Kind_While_Loop_Statement =>
+               Expr := Get_Condition (Stmt);
+               if Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+               Prev_Loop := Cur_Loop;
+               Cur_Loop := Stmt;
+               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt));
+               Cur_Loop := Prev_Loop;
+
+            when Iir_Kind_Next_Statement
+              | Iir_Kind_Exit_Statement =>
+               declare
+                  Loop_Label : Iir;
+               begin
+                  Expr := Get_Condition (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+                  Loop_Label := Get_Loop_Label (Stmt);
+                  if Loop_Label = Null_Iir then
+                     Set_Loop_Label (Stmt, Build_Simple_Name (Cur_Loop, Stmt));
+                  end if;
+               end;
+
+            when Iir_Kind_Procedure_Call_Statement =>
+               Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt));
+
+            when Iir_Kind_Null_Statement =>
+               null;
+
+            when Iir_Kind_Return_Statement =>
+               Canon_Expression (Get_Expression (Stmt));
+
+            when others =>
+               Error_Kind ("canon_sequential_stmts", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Canon_Sequential_Stmts;
+
+   -- Create a statement transform from concurrent_signal_assignment
+   -- statement STMT (either selected or conditional).
+   -- waveform transformation is not done.
+   -- PROC is the process created.
+   -- PARENT is the place where signal assignment must be placed.  This may
+   --  be PROC, or an 'if' statement if the assignment is guarded.
+   -- See LRM93 9.5
+   procedure Canon_Concurrent_Signal_Assignment
+     (Stmt: Iir;
+      Proc: out Iir_Sensitized_Process_Statement;
+      Chain : out Iir)
+   is
+      If_Stmt: Iir;
+      Sensitivity_List : Iir_List;
+   begin
+      Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
+      Location_Copy (Proc, Stmt);
+      Set_Parent (Proc, Get_Parent (Stmt));
+      Sensitivity_List := Create_Iir_List;
+      Set_Sensitivity_List (Proc, Sensitivity_List);
+      Set_Process_Origin (Proc, Stmt);
+
+      --  LRM93 9.5
+      --  1. If a label appears on the concurrent signal assignment, then the
+      --     same label appears on the process statement.
+      Set_Label (Proc, Get_Label (Stmt));
+
+      --  LRM93 9.5
+      --  2.  The equivalent process statement is a postponed process if and
+      --      only if the current signal assignment statement includes the
+      --      reserved word POSTPONED.
+      Set_Postponed_Flag (Proc, Get_Postponed_Flag (Proc));
+
+      Canon_Extract_Sensitivity (Get_Target (Stmt), Sensitivity_List, True);
+
+      if Canon_Flag_Expressions then
+         Canon_Expression (Get_Target (Stmt));
+      end if;
+
+      if Get_Guard (Stmt) /= Null_Iir then
+         -- LRM93 9.1
+         -- If the option guarded appears in the concurrent signal assignment
+         -- statement, then the concurrent signal assignment is called a
+         -- guarded assignment.
+         -- If the concurrent signal assignement statement is a guarded
+         -- assignment and the target of the concurrent signal assignment is
+         -- a guarded target, then the statement transform is as follow:
+         --   if GUARD then signal_transform else disconnect_statements end if;
+         -- Otherwise, if the concurrent signal assignment statement is a
+         -- guarded assignement, but the target if the concurrent signal
+         -- assignment is not a guarded target, the then statement transform
+         -- is as follows:
+         --  if GUARD then signal_transform end if;
+         If_Stmt := Create_Iir (Iir_Kind_If_Statement);
+         Set_Parent (If_Stmt, Proc);
+         Set_Sequential_Statement_Chain (Proc, If_Stmt);
+         Location_Copy (If_Stmt, Stmt);
+         Canon_Extract_Sensitivity (Get_Guard (Stmt), Sensitivity_List, False);
+         Set_Condition (If_Stmt, Get_Guard (Stmt));
+         Chain := If_Stmt;
+
+         declare
+            Target : Iir;
+            Else_Clause : Iir_Elsif;
+            Dis_Stmt : Iir_Signal_Assignment_Statement;
+         begin
+            Target := Get_Target (Stmt);
+            if Get_Guarded_Target_State (Stmt) = True then
+               --  The target is a guarded target.
+               --  create the disconnection statement.
+               Else_Clause := Create_Iir (Iir_Kind_Elsif);
+               Location_Copy (Else_Clause, Stmt);
+               Set_Else_Clause (If_Stmt, Else_Clause);
+               Dis_Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement);
+               Location_Copy (Dis_Stmt, Stmt);
+               Set_Parent (Dis_Stmt, If_Stmt);
+               Set_Target (Dis_Stmt, Target);
+               Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt);
+               --  XX
+               Set_Waveform_Chain (Dis_Stmt, Null_Iir);
+            end if;
+         end;
+      else
+         -- LRM93 9.1
+         -- Finally, if the concurrent signal assignment statement is not a
+         -- guarded assignment, and the traget of the concurrent signal
+         -- assignment is not a guarded target, then the statement transform
+         -- is as follows:
+         --    signal_transform
+         Chain := Proc;
+      end if;
+   end Canon_Concurrent_Signal_Assignment;
+
+   function Canon_Concurrent_Procedure_Call (El : Iir)
+     return Iir_Sensitized_Process_Statement
+   is
+      Proc : Iir_Sensitized_Process_Statement;
+      Call_Stmt : Iir_Procedure_Call_Statement;
+      Wait_Stmt : Iir_Wait_Statement;
+      Call : constant Iir_Procedure_Call := Get_Procedure_Call (El);
+      Imp : constant Iir := Get_Implementation (Call);
+      Assoc_Chain : Iir;
+      Assoc : Iir;
+      Inter : Iir;
+      Sensitivity_List : Iir_List;
+      Is_Sensitized : Boolean;
+   begin
+      --  Optimization: the process is a sensitized process only if the
+      --  procedure is known not to have wait statement.
+      Is_Sensitized := Get_Wait_State (Imp) = False;
+
+      --  LRM93 9.3
+      --  The equivalent process statement has also no sensitivity list, an
+      --  empty declarative part, and a statement part that consists of a
+      --  procedure call statement followed by a wait statement.
+      if Is_Sensitized then
+         Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
+      else
+         Proc := Create_Iir (Iir_Kind_Process_Statement);
+      end if;
+      Location_Copy (Proc, El);
+      Set_Parent (Proc, Get_Parent (El));
+      Set_Process_Origin (Proc, El);
+
+      --  LRM93 9.3
+      --  The equivalent process statement has a label if and only if the
+      --  concurrent procedure call statement has a label; if the equivalent
+      --  process statement has a label, it is the same as that of the
+      --  concurrent procedure call statement.
+      Set_Label (Proc, Get_Label (El));
+
+      --  LRM93 9.3
+      --  The equivalent process statement is a postponed process if and only
+      --  if the concurrent procedure call statement includes the reserved
+      --  word POSTPONED.
+      Set_Postponed_Flag (Proc, Get_Postponed_Flag (El));
+
+      Set_Attribute_Value_Chain (Proc, Get_Attribute_Value_Chain (El));
+
+      Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement);
+      Set_Sequential_Statement_Chain (Proc, Call_Stmt);
+      Location_Copy (Call_Stmt, El);
+      Set_Parent (Call_Stmt, Proc);
+      Set_Procedure_Call (Call_Stmt, Call);
+      Assoc_Chain := Canon_Association_Chain_And_Actuals
+        (Get_Interface_Declaration_Chain (Imp),
+         Get_Parameter_Association_Chain (Call),
+         Call);
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+      Assoc := Assoc_Chain;
+
+      --  LRM93 9.3
+      --  If there exists a name that denotes a signal in the actual part of
+      --  any association element in the concurrent procedure call statement,
+      --  and that actual is associated with a formal parameter of mode IN or
+      --  INOUT, then the equivalent process statement includes a final wait
+      --  statement with a sensitivity clause that is constructed by taking
+      --  the union of the sets constructed by applying th rule of Section 8.1
+      --  to each actual part associated with a formal parameter.
+      Sensitivity_List := Create_Iir_List;
+      while Assoc /= Null_Iir loop
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_By_Expression =>
+               Inter := Get_Association_Interface (Assoc);
+               if Get_Mode (Inter) in Iir_In_Modes then
+                  Canon_Extract_Sensitivity
+                    (Get_Actual (Assoc), Sensitivity_List, False);
+               end if;
+            when Iir_Kind_Association_Element_Open
+              | Iir_Kind_Association_Element_By_Individual =>
+               null;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      if Is_Sensitized then
+         Set_Sensitivity_List (Proc, Sensitivity_List);
+      else
+         Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement);
+         Location_Copy (Wait_Stmt, El);
+         Set_Parent (Wait_Stmt, Proc);
+         Set_Sensitivity_List (Wait_Stmt, Sensitivity_List);
+         Set_Chain (Call_Stmt, Wait_Stmt);
+      end if;
+      return Proc;
+   end Canon_Concurrent_Procedure_Call;
+
+   --  Return a statement from a waveform.
+   function Canon_Wave_Transform
+     (Orig_Stmt : Iir; Waveform_Chain : Iir_Waveform_Element; Proc : Iir)
+     return Iir
+   is
+      Stmt : Iir;
+   begin
+      if Waveform_Chain = Null_Iir then
+         --  LRM 9.5.1 Conditionnal Signal Assignment
+         --  If the waveform is of the form:
+         --    UNAFFECTED
+         --  then the wave transform in the corresponding process statement
+         --  is of the form:
+         --    NULL;
+         --  In this example, the final NULL causes the driver to be unchanged,
+         --  rather than disconnected.
+         --  (This is the null statement not a null waveform element).
+         Stmt := Create_Iir (Iir_Kind_Null_Statement);
+      else
+         --  LRM 9.5.1 Conditionnal Signal Assignment
+         --  If the waveform is of the form:
+         --    waveform_element1, waveform_element1, ..., waveform_elementN
+         --  then the wave transform in the corresponding process statement is
+         --  of the form:
+         --    target <= [ delay_mechanism ] waveform_element1,
+         --       waveform_element2, ..., waveform_elementN;
+         Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement);
+         Set_Target (Stmt, Get_Target (Orig_Stmt));
+         Canon_Waveform_Chain (Waveform_Chain, Get_Sensitivity_List (Proc));
+         Set_Waveform_Chain (Stmt, Waveform_Chain);
+         Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt));
+         Set_Reject_Time_Expression
+           (Stmt, Get_Reject_Time_Expression (Orig_Stmt));
+      end if;
+      Location_Copy (Stmt, Orig_Stmt);
+      return Stmt;
+   end Canon_Wave_Transform;
+
+   --  Create signal_transform for a conditional concurrent signal assignment.
+   procedure Canon_Conditional_Concurrent_Signal_Assigment
+     (Conc_Stmt : Iir; Proc : Iir; Parent : Iir)
+   is
+      Expr : Iir;
+      Stmt : Iir;
+      Res1 : Iir;
+      Last_Res : Iir;
+      Wf : Iir;
+      Cond_Wf : Iir_Conditional_Waveform;
+      Cond_Wf_Chain : Iir_Conditional_Waveform;
+   begin
+      Cond_Wf_Chain := Get_Conditional_Waveform_Chain (Conc_Stmt);
+      Stmt := Null_Iir;
+      Cond_Wf := Cond_Wf_Chain;
+      Last_Res := Null_Iir;
+
+      while Cond_Wf /= Null_Iir loop
+         Expr := Get_Condition (Cond_Wf);
+         Wf := Canon_Wave_Transform
+           (Conc_Stmt, Get_Waveform_Chain (Cond_Wf), Proc);
+         Set_Parent (Wf, Parent);
+         if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then
+            Res1 := Wf;
+         else
+            if Expr /= Null_Iir then
+               if Canon_Flag_Expressions then
+                  Canon_Expression (Expr);
+               end if;
+               Canon_Extract_Sensitivity
+                 (Expr, Get_Sensitivity_List (Proc), False);
+            end if;
+            if Stmt = Null_Iir then
+               Res1 := Create_Iir (Iir_Kind_If_Statement);
+               Set_Parent (Res1, Parent);
+            else
+               Res1 := Create_Iir (Iir_Kind_Elsif);
+            end if;
+            Location_Copy (Res1, Cond_Wf);
+            Set_Condition (Res1, Expr);
+            Set_Sequential_Statement_Chain (Res1, Wf);
+         end if;
+         if Stmt = Null_Iir then
+            Stmt := Res1;
+         else
+            Set_Else_Clause (Last_Res, Res1);
+         end if;
+         Last_Res := Res1;
+         Cond_Wf := Get_Chain (Cond_Wf);
+      end loop;
+      Set_Sequential_Statement_Chain (Parent, Stmt);
+   end Canon_Conditional_Concurrent_Signal_Assigment;
+
+   procedure Canon_Selected_Concurrent_Signal_Assignment
+     (Conc_Stmt : Iir; Proc : Iir; Parent : Iir)
+   is
+      Selected_Waveform : Iir;
+      Case_Stmt: Iir_Case_Statement;
+      Expr : Iir;
+      Stmt : Iir;
+      Assoc : Iir;
+   begin
+      Case_Stmt := Create_Iir (Iir_Kind_Case_Statement);
+      Set_Parent (Case_Stmt, Parent);
+      Set_Sequential_Statement_Chain (Parent, Case_Stmt);
+      Location_Copy (Case_Stmt, Conc_Stmt);
+      Expr := Get_Expression (Conc_Stmt);
+      if Canon_Flag_Expressions then
+         Canon_Expression (Expr);
+      end if;
+      Set_Expression (Case_Stmt, Expr);
+      Canon_Extract_Sensitivity
+        (Expr, Get_Sensitivity_List (Proc), False);
+
+      Selected_Waveform := Get_Selected_Waveform_Chain (Conc_Stmt);
+      Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform);
+      while Selected_Waveform /= Null_Iir loop
+         Assoc := Get_Associated_Chain (Selected_Waveform);
+         if Assoc /= Null_Iir then
+            Stmt := Canon_Wave_Transform (Conc_Stmt, Assoc, Proc);
+            Set_Parent (Stmt, Case_Stmt);
+            Set_Associated_Chain (Selected_Waveform, Stmt);
+         end if;
+         Selected_Waveform := Get_Chain (Selected_Waveform);
+      end loop;
+   end Canon_Selected_Concurrent_Signal_Assignment;
+
+   procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir)
+   is
+      --  Current element in the chain of concurrent statements.
+      El: Iir;
+      --  Previous element or NULL_IIR if EL is the first element.
+      --  This is used to make Replace_Stmt efficient.
+      Prev_El : Iir;
+
+      --  Replace in the chain EL by N_STMT.
+      procedure Replace_Stmt (N_Stmt : Iir) is
+      begin
+         if Prev_El = Null_Iir then
+            Set_Concurrent_Statement_Chain (Parent, N_Stmt);
+         else
+            Set_Chain (Prev_El, N_Stmt);
+         end if;
+         Set_Chain (N_Stmt, Get_Chain (El));
+      end Replace_Stmt;
+
+      Proc: Iir;
+      Stmt: Iir;
+      Sub_Chain : Iir;
+      Expr: Iir;
+      Proc_Num : Natural := 0;
+      Sensitivity_List : Iir_List;
+   begin
+      Prev_El := Null_Iir;
+      El := Get_Concurrent_Statement_Chain (Parent);
+      while El /= Null_Iir loop
+         --  Add a label if required.
+         if Canon_Flag_Add_Labels then
+            case Get_Kind (El) is
+               when Iir_Kind_Psl_Declaration =>
+                  null;
+               when others =>
+                  if Get_Label (El) = Null_Identifier then
+                     declare
+                        Str : String := Natural'Image (Proc_Num);
+                     begin
+                        --  Note: the label starts with a capitalized letter,
+                        --  to avoid any clash with user's identifiers.
+                        Str (1) := 'P';
+                        Set_Label (El, Name_Table.Get_Identifier (Str));
+                     end;
+                     Proc_Num := Proc_Num + 1;
+                  end if;
+            end case;
+         end if;
+
+         case Get_Kind (El) is
+            when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+               Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain);
+
+               Canon_Conditional_Concurrent_Signal_Assigment
+                 (El, Proc, Sub_Chain);
+
+               Replace_Stmt (Proc);
+               Free_Iir (El);
+               El := Proc;
+
+            when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+               Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain);
+
+               Canon_Selected_Concurrent_Signal_Assignment
+                 (El, Proc, Sub_Chain);
+
+               Replace_Stmt (Proc);
+               Free_Iir (El);
+               El := Proc;
+
+            when Iir_Kind_Concurrent_Assertion_Statement =>
+               -- Create a new entry.
+               Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
+               Location_Copy (Proc, El);
+               Set_Parent (Proc, Get_Parent (El));
+               Set_Process_Origin (Proc, El);
+
+               --  LRM93 9.4
+               --  The equivalent process statement has a label if and only if
+               --  the current assertion statement has a label; if the
+               --  equivalent process statement has a label; it is the same
+               --  as that of the concurrent assertion statement.
+               Set_Label (Proc, Get_Label (El));
+
+               --  LRM93 9.4
+               --  The equivalent process statement is a postponed process if
+               --  and only if the current assertion statement includes the
+               --  reserved word POSTPONED.
+               Set_Postponed_Flag (Proc, Get_Postponed_Flag (El));
+
+               Stmt := Create_Iir (Iir_Kind_Assertion_Statement);
+               Set_Sequential_Statement_Chain (Proc, Stmt);
+               Set_Parent (Stmt, Proc);
+               Location_Copy (Stmt, El);
+               Sensitivity_List := Create_Iir_List;
+               Set_Sensitivity_List (Proc, Sensitivity_List);
+
+               -- Expand the expression, fill the sensitivity list,
+               Canon_Extract_Sensitivity
+                 (Get_Assertion_Condition (El), Sensitivity_List, False);
+               if Canon_Flag_Expressions then
+                  Canon_Expression (Get_Assertion_Condition (El));
+               end if;
+               Set_Assertion_Condition
+                 (Stmt, Get_Assertion_Condition (El));
+
+               Expr := Get_Report_Expression (El);
+               if Canon_Flag_Expressions and Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+               Set_Report_Expression (Stmt, Expr);
+
+               Expr := Get_Severity_Expression (El);
+               if Canon_Flag_Expressions and Expr /= Null_Iir then
+                  Canon_Expression (Expr);
+               end if;
+               Set_Severity_Expression (Stmt, Expr);
+
+               Replace_Stmt (Proc);
+               El := Proc;
+
+            when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+               Proc := Canon_Concurrent_Procedure_Call (El);
+               Replace_Stmt (Proc);
+               El := Proc;
+
+            when Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Process_Statement =>
+               Canon_Declarations (Top, El, Null_Iir);
+               if Canon_Flag_Sequentials_Stmts then
+                  Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El));
+               end if;
+               if Canon_Flag_All_Sensitivity
+                 and then Canon_Flag_Sequentials_Stmts
+                 and then Get_Kind (El) = Iir_Kind_Sensitized_Process_Statement
+                 and then Get_Sensitivity_List (El) = Iir_List_All
+               then
+                  Set_Sensitivity_List
+                    (El, Canon_Extract_Process_Sensitivity (El));
+               end if;
+
+            when Iir_Kind_Component_Instantiation_Statement =>
+               declare
+                  Inst : Iir;
+                  Assoc_Chain : Iir;
+               begin
+                  Inst := Get_Instantiated_Unit (El);
+                  Inst := Get_Entity_From_Entity_Aspect (Inst);
+                  Assoc_Chain := Canon_Association_Chain_And_Actuals
+                    (Get_Generic_Chain (Inst),
+                     Get_Generic_Map_Aspect_Chain (El),
+                     El);
+                  Set_Generic_Map_Aspect_Chain (El, Assoc_Chain);
+
+                  Assoc_Chain := Canon_Association_Chain_And_Actuals
+                    (Get_Port_Chain (Inst),
+                     Get_Port_Map_Aspect_Chain (El),
+                     El);
+                  Set_Port_Map_Aspect_Chain (El, Assoc_Chain);
+               end;
+
+            when Iir_Kind_Block_Statement =>
+               declare
+                  Header : Iir_Block_Header;
+                  Chain : Iir;
+                  Guard : Iir_Guard_Signal_Declaration;
+               begin
+                  Guard := Get_Guard_Decl (El);
+                  if Guard /= Null_Iir then
+                     Expr := Get_Guard_Expression (Guard);
+                     Set_Guard_Sensitivity_List (Guard, Create_Iir_List);
+                     Canon_Extract_Sensitivity
+                       (Expr, Get_Guard_Sensitivity_List (Guard), False);
+                     if Canon_Flag_Expressions then
+                        Canon_Expression (Expr);
+                     end if;
+                  end if;
+                  Header := Get_Block_Header (El);
+                  if Header /= Null_Iir then
+                     --  Generics.
+                     Chain := Get_Generic_Map_Aspect_Chain (Header);
+                     if Chain /= Null_Iir then
+                        Chain := Canon_Association_Chain_And_Actuals
+                          (Get_Generic_Chain (Header), Chain, Chain);
+                     else
+                        Chain := Canon_Default_Association_Chain
+                          (Get_Generic_Chain (Header));
+                     end if;
+                     Set_Generic_Map_Aspect_Chain (Header, Chain);
+
+                     --  Ports.
+                     Chain := Get_Port_Map_Aspect_Chain (Header);
+                     if Chain /= Null_Iir then
+                        Chain := Canon_Association_Chain_And_Actuals
+                          (Get_Port_Chain (Header), Chain, Chain);
+                     else
+                        Chain := Canon_Default_Association_Chain
+                          (Get_Port_Chain (Header));
+                     end if;
+                     Set_Port_Map_Aspect_Chain (Header, Chain);
+                  end if;
+                  Canon_Declarations (Top, El, El);
+                  Canon_Concurrent_Stmts (Top, El);
+               end;
+
+            when Iir_Kind_Generate_Statement =>
+               declare
+                  Scheme : Iir;
+               begin
+                  Scheme := Get_Generation_Scheme (El);
+                  if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                     Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir);
+                  elsif Canon_Flag_Expressions then
+                     Canon_Expression (Scheme);
+                  end if;
+                  Canon_Declarations (Top, El, El);
+                  Canon_Concurrent_Stmts (Top, El);
+               end;
+
+            when Iir_Kind_Psl_Assert_Statement
+              | Iir_Kind_Psl_Cover_Statement =>
+               declare
+                  use PSL.Nodes;
+                  Prop : PSL_Node;
+                  Fa : PSL_NFA;
+               begin
+                  Prop := Get_Psl_Property (El);
+                  Prop := PSL.Rewrites.Rewrite_Property (Prop);
+                  Set_Psl_Property (El, Prop);
+                  --  Generate the NFA.
+                  Fa := PSL.Build.Build_FA (Prop);
+                  Set_PSL_NFA (El, Fa);
+
+                  --  FIXME: report/severity.
+               end;
+
+            when Iir_Kind_Psl_Default_Clock =>
+               null;
+            when Iir_Kind_Psl_Declaration =>
+               declare
+                  use PSL.Nodes;
+                  Decl : PSL_Node;
+                  Prop : PSL_Node;
+                  Fa : PSL_NFA;
+               begin
+                  Decl := Get_Psl_Declaration (El);
+                  case Get_Kind (Decl) is
+                     when N_Property_Declaration =>
+                        Prop := Get_Property (Decl);
+                        Prop := PSL.Rewrites.Rewrite_Property (Prop);
+                        Set_Property (Decl, Prop);
+                        if Get_Parameter_List (Decl) = Null_Node then
+                           --  Generate the NFA.
+                           Fa := PSL.Build.Build_FA (Prop);
+                           Set_PSL_NFA (El, Fa);
+                        end if;
+                     when N_Sequence_Declaration
+                       | N_Endpoint_Declaration =>
+                        Prop := Get_Sequence (Decl);
+                        Prop := PSL.Rewrites.Rewrite_SERE (Prop);
+                        Set_Sequence (Decl, Prop);
+                     when others =>
+                        Error_Kind ("canon psl_declaration", Decl);
+                  end case;
+               end;
+
+            when Iir_Kind_Simple_Simultaneous_Statement =>
+               if Canon_Flag_Expressions then
+                  Canon_Expression (Get_Simultaneous_Left (El));
+                  Canon_Expression (Get_Simultaneous_Right (El));
+               end if;
+
+            when others =>
+               Error_Kind ("canon_concurrent_stmts", El);
+         end case;
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+   end Canon_Concurrent_Stmts;
+
+--    procedure Canon_Binding_Indication
+--      (Component: Iir; Binding : Iir_Binding_Indication)
+--    is
+--       List : Iir_Association_List;
+--    begin
+--       if Binding = Null_Iir then
+--          return;
+--       end if;
+--       List := Get_Generic_Map_Aspect_List (Binding);
+--       List := Canon_Association_List (Get_Generic_List (Component), List);
+--       Set_Generic_Map_Aspect_List (Binding, List);
+--       List := Get_Port_Map_Aspect_List (Binding);
+--       List := Canon_Association_List (Get_Port_List (Component), List);
+--       Set_Port_Map_Aspect_List (Binding, List);
+--    end Canon_Binding_Indication;
+
+   procedure Add_Binding_Indication_Dependence (Top : Iir_Design_Unit;
+                                                Binding : Iir)
+   is
+      Aspect : Iir;
+   begin
+      if Binding = Null_Iir then
+         return;
+      end if;
+      Aspect := Get_Entity_Aspect (Binding);
+      if Aspect = Null_Iir then
+         return;
+      end if;
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            if Get_Architecture (Aspect) /= Null_Iir then
+               Add_Dependence (Top, Aspect);
+            else
+               Add_Dependence (Top, Get_Design_Unit (Get_Entity (Aspect)));
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Add_Dependence (Top, Get_Design_Unit (Get_Configuration (Aspect)));
+         when Iir_Kind_Entity_Aspect_Open =>
+            null;
+         when others =>
+            Error_Kind ("add_binding_indication_dependence", Aspect);
+      end case;
+   end Add_Binding_Indication_Dependence;
+
+   --  Canon the component_configuration or configuration_specification CFG.
+   procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir)
+   is
+      --  True iff CFG is a component_configuration.
+      --  False iff CFG is a configuration_specification.
+      Is_Config : constant Boolean :=
+        Get_Kind (Cfg) = Iir_Kind_Component_Configuration;
+
+      Bind : Iir;
+      Instances : Iir_List;
+      Entity_Aspect : Iir;
+      Block : Iir_Block_Configuration;
+      Map_Chain : Iir;
+      Entity : Iir;
+   begin
+      Bind := Get_Binding_Indication (Cfg);
+      if Bind = Null_Iir then
+         --  Add a default binding indication
+         --  Extract a component instantiation
+         Instances := Get_Instantiation_List (Cfg);
+         if Instances = Iir_List_All or Instances = Iir_List_Others then
+            --  designator_all and designator_others must have been replaced
+            --  by a list during canon.
+            raise Internal_Error;
+         else
+            Bind := Get_Default_Binding_Indication
+              (Get_Named_Entity (Get_First_Element (Instances)));
+         end if;
+         if Bind = Null_Iir then
+            --  Component is not bound.
+            return;
+         end if;
+         Set_Binding_Indication (Cfg, Bind);
+         Add_Binding_Indication_Dependence (Top, Bind);
+         return;
+      else
+         Entity_Aspect := Get_Entity_Aspect (Bind);
+         if Entity_Aspect = Null_Iir then
+            Entity_Aspect := Get_Default_Entity_Aspect (Bind);
+            Set_Entity_Aspect (Bind, Entity_Aspect);
+         end if;
+         if Entity_Aspect /= Null_Iir then
+            Add_Binding_Indication_Dependence (Top, Bind);
+            Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect);
+            Map_Chain := Get_Generic_Map_Aspect_Chain (Bind);
+            if Map_Chain = Null_Iir then
+               if Is_Config then
+                  Map_Chain := Get_Default_Generic_Map_Aspect_Chain (Bind);
+               end if;
+            else
+               Map_Chain := Canon_Association_Chain
+                 (Get_Generic_Chain (Entity), Map_Chain, Map_Chain);
+            end if;
+            Set_Generic_Map_Aspect_Chain (Bind, Map_Chain);
+
+            Map_Chain := Get_Port_Map_Aspect_Chain (Bind);
+            if Map_Chain = Null_Iir then
+               if Is_Config then
+                  Map_Chain := Get_Default_Port_Map_Aspect_Chain (Bind);
+               end if;
+            else
+               Map_Chain := Canon_Association_Chain
+                 (Get_Port_Chain (Entity), Map_Chain, Map_Chain);
+            end if;
+            Set_Port_Map_Aspect_Chain (Bind, Map_Chain);
+
+            if Get_Kind (Cfg) = Iir_Kind_Component_Configuration then
+               Block := Get_Block_Configuration (Cfg);
+               if Block /= Null_Iir then
+                  --  If there is no architecture_identifier in the binding,
+                  --  set it from the block_configuration.
+                  if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity
+                    and then Get_Architecture (Entity_Aspect) = Null_Iir
+                  then
+                     Entity := Get_Entity (Entity_Aspect);
+                     if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then
+                        raise Internal_Error;
+                     end if;
+                     Set_Architecture
+                       (Entity_Aspect, Get_Block_Specification (Block));
+                  end if;
+                  Canon_Block_Configuration (Top, Block);
+               end if;
+            end if;
+         end if;
+      end if;
+   end Canon_Component_Configuration;
+
+   procedure Canon_Incremental_Binding
+     (Conf_Spec : Iir_Configuration_Specification;
+      Comp_Conf : Iir_Component_Configuration;
+      Parent : Iir)
+   is
+      function Merge_Association_Chain
+        (Inter_Chain : Iir; First_Chain : Iir; Sec_Chain : Iir)
+        return Iir
+      is
+         --  Result (chain).
+         First, Last : Iir;
+
+         --  Copy an association and append new elements to FIRST/LAST.
+         procedure Copy_Association (Assoc : in out Iir; Inter : Iir)
+         is
+            El : Iir;
+         begin
+            loop
+               El := Create_Iir (Get_Kind (Assoc));
+               Location_Copy (El, Assoc);
+               Set_Formal (El, Get_Formal (Assoc));
+               Set_Whole_Association_Flag
+                 (El, Get_Whole_Association_Flag (Assoc));
+
+               case Get_Kind (Assoc) is
+                  when Iir_Kind_Association_Element_Open =>
+                     null;
+                  when Iir_Kind_Association_Element_By_Expression =>
+                     Set_Actual (El, Get_Actual (Assoc));
+                     Set_In_Conversion (El, Get_In_Conversion (Assoc));
+                     Set_Out_Conversion (El, Get_Out_Conversion (Assoc));
+                     Set_Collapse_Signal_Flag
+                       (Assoc,
+                        Sem.Can_Collapse_Signals (Assoc, Get_Formal (Assoc)));
+                  when Iir_Kind_Association_Element_By_Individual =>
+                     Set_Actual_Type (El, Get_Actual_Type (Assoc));
+                     Set_Individual_Association_Chain
+                       (El, Get_Individual_Association_Chain (Assoc));
+                  when others =>
+                     Error_Kind ("copy_association", Assoc);
+               end case;
+
+               Sub_Chain_Append (First, Last, El);
+               Assoc := Get_Chain (Assoc);
+               exit when Assoc = Null_Iir;
+               exit when Get_Association_Interface (Assoc) /= Inter;
+            end loop;
+         end Copy_Association;
+
+         procedure Advance (Assoc : in out Iir; Inter : Iir)
+         is
+         begin
+            loop
+               Assoc := Get_Chain (Assoc);
+               exit when Assoc = Null_Iir;
+               exit when Get_Association_Interface (Assoc) /= Inter;
+            end loop;
+         end Advance;
+
+         Inter : Iir;
+         F_El : Iir;
+         S_El : Iir;
+      begin
+         if Sec_Chain = Null_Iir then
+            --  Short-cut.
+            return First_Chain;
+         end if;
+         F_El := First_Chain;
+         Sub_Chain_Init (First, Last);
+         Inter := Inter_Chain;
+         while Inter /= Null_Iir loop
+            --  Consistency check.
+            pragma Assert (Get_Association_Interface (F_El) = Inter);
+
+            --  Find the associated in the second chain.
+            S_El := Sec_Chain;
+            while S_El /= Null_Iir loop
+               exit when Get_Association_Interface (S_El) = Inter;
+               S_El := Get_Chain (S_El);
+            end loop;
+            if S_El /= Null_Iir
+              and then Get_Kind (S_El) /= Iir_Kind_Association_Element_Open
+            then
+               Copy_Association (S_El, Inter);
+               Advance (F_El, Inter);
+            else
+               Copy_Association (F_El, Inter);
+            end if;
+            Inter := Get_Chain (Inter);
+         end loop;
+         return First;
+      end Merge_Association_Chain;
+
+      Res : Iir_Component_Configuration;
+      Cs_Binding : Iir_Binding_Indication;
+      Cc_Binding : Iir_Binding_Indication;
+      Cs_Chain : Iir;
+      Res_Binding : Iir_Binding_Indication;
+      Entity : Iir;
+      Instance_List : Iir_List;
+      Conf_Instance_List : Iir_List;
+      Instance : Iir;
+      Instance_Name : Iir;
+      N_Nbr : Natural;
+   begin
+      --  Create the new component configuration
+      Res := Create_Iir (Iir_Kind_Component_Configuration);
+      Location_Copy (Res, Comp_Conf);
+      Set_Parent (Res, Parent);
+      Set_Component_Name (Res, Get_Component_Name (Conf_Spec));
+
+--       --  Keep in the designator list only the non-incrementally
+--       --  bound instances.
+--       Inst_List := Get_Instantiation_List (Comp_Conf);
+--       Designator_List := Create_Iir_List;
+--       for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop
+--          Inst := Get_Nth_Element (Inst_List, I);
+--          if Get_Component_Configuration (Inst) = Comp_Conf then
+--             Set_Component_Configuration (Inst, Res);
+--             Append_Element (Designator_List, Inst);
+--          end if;
+--       end loop;
+--       Set_Instantiation_List (Res, Designator_List);
+--       Set_Binding_Indication
+--         (Res, Get_Binding_Indication (Comp_Conf));
+--       Append (Last_Item, Conf, Comp_Conf);
+
+      Cs_Binding := Get_Binding_Indication (Conf_Spec);
+      Cc_Binding := Get_Binding_Indication (Comp_Conf);
+      Res_Binding := Create_Iir (Iir_Kind_Binding_Indication);
+      Location_Copy (Res_Binding, Res);
+      Set_Binding_Indication (Res, Res_Binding);
+
+      Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding));
+
+      --  Merge generic map aspect.
+      Cs_Chain := Get_Generic_Map_Aspect_Chain (Cs_Binding);
+      if Cs_Chain = Null_Iir then
+         Cs_Chain := Get_Default_Generic_Map_Aspect_Chain (Cs_Binding);
+      end if;
+      Set_Generic_Map_Aspect_Chain
+        (Res_Binding,
+         Merge_Association_Chain (Get_Generic_Chain (Entity),
+                                  Cs_Chain,
+                                  Get_Generic_Map_Aspect_Chain (Cc_Binding)));
+
+      --  merge port map aspect
+      Cs_Chain := Get_Port_Map_Aspect_Chain (Cs_Binding);
+      if Cs_Chain = Null_Iir then
+         Cs_Chain := Get_Default_Port_Map_Aspect_Chain (Cs_Binding);
+      end if;
+      Set_Port_Map_Aspect_Chain
+        (Res_Binding,
+         Merge_Association_Chain (Get_Port_Chain (Entity),
+                                  Cs_Chain,
+                                  Get_Port_Map_Aspect_Chain (Cc_Binding)));
+
+      --  set entity aspect
+      Set_Entity_Aspect (Res_Binding, Get_Entity_Aspect (Cs_Binding));
+
+      --  create list of instances:
+      --   * keep common instances
+      --   replace component_configuration of them
+      --   remove them in the instance list of COMP_CONF
+      Instance_List := Create_Iir_List;
+      Set_Instantiation_List (Res, Instance_List);
+      Conf_Instance_List := Get_Instantiation_List (Comp_Conf);
+      N_Nbr := 0;
+      for I in 0 .. Get_Nbr_Elements (Conf_Instance_List) - 1 loop
+         Instance_Name := Get_Nth_Element (Conf_Instance_List, I);
+         Instance := Get_Named_Entity (Instance_Name);
+         if Get_Component_Configuration (Instance) = Conf_Spec then
+            --  The incremental binding applies to this instance.
+            Set_Component_Configuration (Instance, Res);
+            Append_Element (Instance_List, Instance_Name);
+         else
+            Replace_Nth_Element (Conf_Instance_List, N_Nbr, Instance_Name);
+            N_Nbr := N_Nbr + 1;
+         end if;
+      end loop;
+      Set_Nbr_Elements (Conf_Instance_List, N_Nbr);
+
+      --  Insert RES.
+      Set_Chain (Res, Get_Chain (Comp_Conf));
+      Set_Chain (Comp_Conf, Res);
+   end Canon_Incremental_Binding;
+
+   procedure Canon_Component_Specification_All_Others
+     (Conf : Iir; Parent : Iir; Spec : Iir_List; List : Iir_List; Comp : Iir)
+   is
+      El : Iir;
+      Comp_Conf : Iir;
+   begin
+      El := Get_Concurrent_Statement_Chain (Parent);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Component_Instantiation_Statement =>
+               if Is_Component_Instantiation (El)
+                 and then Get_Named_Entity (Get_Instantiated_Unit (El)) = Comp
+               then
+                  Comp_Conf := Get_Component_Configuration (El);
+                  if Comp_Conf = Null_Iir then
+                     --  The component is not yet configured.
+                     Append_Element (List, Build_Simple_Name (El, El));
+                     Set_Component_Configuration (El, Conf);
+                  else
+                     --  The component is already configured.
+                     --  Handle incremental configuration.
+                     if (Get_Kind (Comp_Conf)
+                         = Iir_Kind_Configuration_Specification)
+                       and then Spec = Iir_List_All
+                     then
+                        --  FIXME: handle incremental configuration.
+                        raise Internal_Error;
+                     end if;
+                     if Spec = Iir_List_All then
+                        --  Several component configuration for an instance.
+                        --  Must have been caught by sem.
+                        raise Internal_Error;
+                     elsif Spec = Iir_List_Others then
+                        null;
+                     else
+                        raise Internal_Error;
+                     end if;
+                  end if;
+               end if;
+            when Iir_Kind_Generate_Statement =>
+               if False
+                 and then Vhdl_Std = Vhdl_87
+                 and then
+                 Get_Kind (Conf) = Iir_Kind_Configuration_Specification
+               then
+                  Canon_Component_Specification_All_Others
+                    (Conf, El, Spec, List, Comp);
+               end if;
+            when others =>
+               null;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Canon_Component_Specification_All_Others;
+
+   procedure Canon_Component_Specification_List
+     (Conf : Iir; Parent : Iir; Spec : Iir_List)
+   is
+      El : Iir;
+      Comp_Conf : Iir;
+   begin
+      --  Already has a designator list.
+      for I in Natural loop
+         El := Get_Nth_Element (Spec, I);
+         exit when El = Null_Iir;
+         El := Get_Named_Entity (El);
+         Comp_Conf := Get_Component_Configuration (El);
+         if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then
+            if Get_Kind (Comp_Conf) /= Iir_Kind_Configuration_Specification
+              or else Get_Kind (Conf) /= Iir_Kind_Component_Configuration
+            then
+               raise Internal_Error;
+            end if;
+            Canon_Incremental_Binding (Comp_Conf, Conf, Parent);
+         else
+            Set_Component_Configuration (El, Conf);
+         end if;
+      end loop;
+   end Canon_Component_Specification_List;
+
+   --  PARENT is the parent for the chain of concurrent statements.
+   procedure Canon_Component_Specification (Conf : Iir; Parent : Iir)
+   is
+      Spec : constant Iir_List := Get_Instantiation_List (Conf);
+      List : Iir_Designator_List;
+   begin
+      if Spec = Iir_List_All or Spec = Iir_List_Others then
+         List := Create_Iir_List;
+         Canon_Component_Specification_All_Others
+           (Conf, Parent, Spec, List,
+            Get_Named_Entity (Get_Component_Name (Conf)));
+         Set_Instantiation_List (Conf, List);
+      else
+         --  Has Already a designator list.
+         Canon_Component_Specification_List (Conf, Parent, Spec);
+      end if;
+   end Canon_Component_Specification;
+
+   --  Replace ALL/OTHERS with the explicit list of signals.
+   procedure Canon_Disconnection_Specification
+     (Dis : Iir_Disconnection_Specification; Decl_Parent : Iir)
+   is
+      Signal_List : Iir_List;
+      Force : Boolean;
+      El : Iir;
+      N_List : Iir_Designator_List;
+      Dis_Type : Iir;
+   begin
+      if Canon_Flag_Expressions then
+         Canon_Expression (Get_Expression (Dis));
+      end if;
+      Signal_List := Get_Signal_List (Dis);
+      if Signal_List = Iir_List_All then
+         Force := True;
+      elsif Signal_List = Iir_List_Others then
+         Force := False;
+      else
+         return;
+      end if;
+      Dis_Type := Get_Type (Get_Type_Mark (Dis));
+      N_List := Create_Iir_List;
+      Set_Signal_List (Dis, N_List);
+      El := Get_Declaration_Chain (Decl_Parent);
+      while El /= Null_Iir loop
+         if Get_Kind (El) = Iir_Kind_Signal_Declaration
+           and then Get_Type (El) = Dis_Type
+           and then Get_Signal_Kind (El) /= Iir_No_Signal_Kind
+         then
+            if not Get_Has_Disconnect_Flag (El) then
+               Set_Has_Disconnect_Flag (El, True);
+               Append_Element (N_List, El);
+            else
+               if Force then
+                  raise Internal_Error;
+               end if;
+            end if;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+   end Canon_Disconnection_Specification;
+
+   procedure Canon_Subtype_Indication (Def : Iir) is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Indexes : constant Iir_List := Get_Index_Subtype_List (Def);
+               Index : Iir;
+            begin
+               for I in Natural loop
+                  Index := Get_Nth_Element (Indexes, I);
+                  exit when Index = Null_Iir;
+                  Canon_Subtype_Indication_If_Anonymous (Index);
+               end loop;
+            end;
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            declare
+               Rng : constant Iir := Get_Range_Constraint (Def);
+            begin
+               if Get_Kind (Rng) = Iir_Kind_Range_Expression then
+                  Canon_Expression (Rng);
+               end if;
+            end;
+         when Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            null;
+         when Iir_Kind_Access_Subtype_Definition =>
+            null;
+         when others =>
+            Error_Kind ("canon_subtype_indication", Def);
+      end case;
+   end Canon_Subtype_Indication;
+
+   procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir) is
+   begin
+      if Is_Anonymous_Type_Definition (Def) then
+         Canon_Subtype_Indication (Def);
+      end if;
+   end Canon_Subtype_Indication_If_Anonymous;
+
+   procedure Canon_Declaration (Top : Iir_Design_Unit;
+                                Decl : Iir;
+                                Parent : Iir;
+                                Decl_Parent : Iir)
+   is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            Canon_Declarations (Top, Decl, Null_Iir);
+            if Canon_Flag_Sequentials_Stmts then
+               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl));
+            end if;
+
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            null;
+
+         when Iir_Kind_Type_Declaration =>
+            declare
+               Def : Iir;
+            begin
+               Def := Get_Type_Definition (Decl);
+               if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then
+                  Canon_Declarations (Decl, Def, Null_Iir);
+               end if;
+            end;
+
+         when Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            null;
+
+         when Iir_Kind_Protected_Type_Body =>
+            Canon_Declarations (Top, Decl, Null_Iir);
+
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Constant_Declaration =>
+            if Canon_Flag_Expressions then
+               Canon_Subtype_Indication_If_Anonymous (Get_Type (Decl));
+               Canon_Expression (Get_Default_Value (Decl));
+            end if;
+
+         when Iir_Kind_Iterator_Declaration =>
+            null;
+
+         when Iir_Kind_Object_Alias_Declaration =>
+            null;
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_File_Declaration =>
+            -- FIXME
+            null;
+
+         when Iir_Kind_Attribute_Declaration =>
+            null;
+         when Iir_Kind_Attribute_Specification =>
+            if Canon_Flag_Expressions then
+               Canon_Expression (Get_Expression (Decl));
+            end if;
+         when Iir_Kind_Disconnection_Specification =>
+            Canon_Disconnection_Specification (Decl, Decl_Parent);
+
+         when Iir_Kind_Group_Template_Declaration =>
+            null;
+         when Iir_Kind_Group_Declaration =>
+            null;
+
+         when Iir_Kind_Use_Clause =>
+            null;
+
+         when Iir_Kind_Component_Declaration =>
+            null;
+
+         when Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            null;
+
+         when Iir_Kind_Configuration_Specification =>
+            Canon_Component_Specification (Decl, Parent);
+            Canon_Component_Configuration (Top, Decl);
+--             declare
+--                List : Iir_List;
+--                Binding : Iir_Binding_Indication;
+--                Component : Iir_Component_Declaration;
+--                Aspect : Iir;
+--                Entity : Iir;
+--             begin
+--                Binding := Get_Binding_Indication (Decl);
+--                Component := Get_Component_Name (Decl);
+--                Aspect := Get_Entity_Aspect (Binding);
+--                case Get_Kind (Aspect) is
+--                   when Iir_Kind_Entity_Aspect_Entity =>
+--                      Entity := Get_Entity (Aspect);
+--                   when others =>
+--                      Error_Kind ("configuration_specification", Aspect);
+--                end case;
+--                Entity := Get_Library_Unit (Entity);
+--                List := Get_Generic_Map_Aspect_List (Binding);
+--                if List = Null_Iir_List then
+--                   Set_Generic_Map_Aspect_List
+--                     (Binding,
+--                      Canon_Default_Map_Association_List
+--                    (Get_Generic_List (Entity), Get_Generic_List (Component),
+--                       Get_Location (Decl)));
+--                end if;
+--                List := Get_Port_Map_Aspect_List (Binding);
+--                if List = Null_Iir_List then
+--                   Set_Port_Map_Aspect_List
+--                     (Binding,
+--                      Canon_Default_Map_Association_List
+--                      (Get_Port_List (Entity), Get_Port_List (Component),
+--                       Get_Location (Decl)));
+--                end if;
+--             end;
+
+         when Iir_Kinds_Signal_Attribute =>
+            null;
+
+         when Iir_Kind_Nature_Declaration =>
+            null;
+         when Iir_Kind_Terminal_Declaration =>
+            null;
+         when Iir_Kinds_Quantity_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("canon_declaration", Decl);
+      end case;
+   end Canon_Declaration;
+
+   procedure Canon_Declarations (Top : Iir_Design_Unit;
+                                 Decl_Parent : Iir;
+                                 Parent : Iir)
+   is
+      Decl : Iir;
+   begin
+      if Parent /= Null_Iir then
+         Clear_Instantiation_Configuration (Parent, True);
+      end if;
+      Decl := Get_Declaration_Chain (Decl_Parent);
+      while Decl /= Null_Iir loop
+         Canon_Declaration (Top, Decl, Parent, Decl_Parent);
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Canon_Declarations;
+
+   procedure Canon_Block_Configuration (Top : Iir_Design_Unit;
+                                        Conf : Iir_Block_Configuration)
+   is
+      use Iir_Chains.Configuration_Item_Chain_Handling;
+      Spec : constant Iir := Get_Block_Specification (Conf);
+      Blk : constant Iir := Get_Block_From_Block_Specification (Spec);
+      Stmts : constant Iir := Get_Concurrent_Statement_Chain (Blk);
+      El : Iir;
+      Sub_Blk : Iir;
+      Last_Item : Iir;
+   begin
+      --  Note: the only allowed declarations are use clauses, which are not
+      --  canonicalized.
+
+      --  FIXME: handle indexed/sliced name?
+
+      Clear_Instantiation_Configuration (Blk, False);
+
+      Build_Init (Last_Item, Conf);
+
+      --  1) Configure instantiations with configuration specifications.
+      --  TODO: merge.
+      El := Get_Declaration_Chain (Blk);
+      while El /= Null_Iir loop
+         if Get_Kind (El) = Iir_Kind_Configuration_Specification then
+            --  Already canoncalized during canon of block declarations.
+            --  But need to set configuration on instantiations.
+            Canon_Component_Specification (El, Blk);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      --  2) Configure instantations with component configurations,
+      --     and map block configurations with block/generate statements.
+      El := Get_Configuration_Item_Chain (Conf);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Configuration_Specification =>
+               raise Internal_Error;
+            when Iir_Kind_Component_Configuration =>
+               Canon_Component_Specification (El, Blk);
+            when Iir_Kind_Block_Configuration =>
+               Sub_Blk := Strip_Denoting_Name (Get_Block_Specification (El));
+               case Get_Kind (Sub_Blk) is
+                  when Iir_Kind_Block_Statement =>
+                     Set_Block_Block_Configuration (Sub_Blk, El);
+                  when Iir_Kind_Indexed_Name
+                    | Iir_Kind_Slice_Name =>
+                     Sub_Blk := Strip_Denoting_Name (Get_Prefix (Sub_Blk));
+                     Set_Prev_Block_Configuration
+                       (El, Get_Generate_Block_Configuration (Sub_Blk));
+                     Set_Generate_Block_Configuration (Sub_Blk, El);
+                  when Iir_Kind_Generate_Statement =>
+                     Set_Generate_Block_Configuration (Sub_Blk, El);
+                  when others =>
+                     Error_Kind ("canon_block_configuration(0)", Sub_Blk);
+               end case;
+            when others =>
+               Error_Kind ("canon_block_configuration(1)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      --  3) Add default component configuration for unspecified component
+      --     instantiation statements,
+      --     Add default block configuration for unconfigured block statements.
+      El := Stmts;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Component_Instantiation_Statement =>
+               declare
+                  Comp_Conf : Iir;
+                  Res : Iir_Component_Configuration;
+                  Designator_List : Iir_List;
+                  Inst_List : Iir_List;
+                  Inst : Iir;
+                  Inst_Name : Iir;
+               begin
+                  Comp_Conf := Get_Component_Configuration (El);
+                  if Comp_Conf = Null_Iir then
+                     if Is_Component_Instantiation (El) then
+                        --  Create a component configuration.
+                        --  FIXME: should merge all these default configuration
+                        --    of the same component.
+                        Res := Create_Iir (Iir_Kind_Component_Configuration);
+                        Location_Copy (Res, El);
+                        Set_Parent (Res, Conf);
+                        Set_Component_Name (Res, Get_Instantiated_Unit (El));
+                        Designator_List := Create_Iir_List;
+                        Append_Element
+                          (Designator_List, Build_Simple_Name (El, El));
+                        Set_Instantiation_List (Res, Designator_List);
+                        Append (Last_Item, Conf, Res);
+                     end if;
+                  elsif Get_Kind (Comp_Conf)
+                    = Iir_Kind_Configuration_Specification
+                  then
+                     --  Create component configuration
+                     Res := Create_Iir (Iir_Kind_Component_Configuration);
+                     Location_Copy (Res, Comp_Conf);
+                     Set_Parent (Res, Conf);
+                     Set_Component_Name (Res, Get_Component_Name (Comp_Conf));
+                     --  Keep in the designator list only the non-incrementally
+                     --  bound instances, and only the instances in the current
+                     --  statements parts (vhdl-87 generate issue).
+                     Inst_List := Get_Instantiation_List (Comp_Conf);
+                     Designator_List := Create_Iir_List;
+                     for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop
+                        Inst_Name := Get_Nth_Element (Inst_List, I);
+                        Inst := Get_Named_Entity (Inst_Name);
+                        if Get_Component_Configuration (Inst) = Comp_Conf
+                          and then Get_Parent (Inst) = Blk
+                        then
+                           Set_Component_Configuration (Inst, Res);
+                           Append_Element (Designator_List, Inst_Name);
+                        end if;
+                     end loop;
+                     Set_Instantiation_List (Res, Designator_List);
+                     Set_Binding_Indication
+                       (Res, Get_Binding_Indication (Comp_Conf));
+                     Append (Last_Item, Conf, Res);
+                  end if;
+               end;
+            when Iir_Kind_Block_Statement =>
+               declare
+                  Res : Iir_Block_Configuration;
+               begin
+                  if Get_Block_Block_Configuration (El) = Null_Iir then
+                     Res := Create_Iir (Iir_Kind_Block_Configuration);
+                     Location_Copy (Res, El);
+                     Set_Parent (Res, Conf);
+                     Set_Block_Specification (Res, El);
+                     Append (Last_Item, Conf, Res);
+                  end if;
+               end;
+            when Iir_Kind_Generate_Statement =>
+               declare
+                  Res : Iir_Block_Configuration;
+                  Scheme : Iir;
+                  Blk_Config : Iir_Block_Configuration;
+                  Blk_Spec : Iir;
+               begin
+                  Scheme := Get_Generation_Scheme (El);
+                  Blk_Config := Get_Generate_Block_Configuration (El);
+                  if Blk_Config = Null_Iir then
+                     --  No block configuration for the (implicit) internal
+                     --  block.  Create one.
+                     Res := Create_Iir (Iir_Kind_Block_Configuration);
+                     Location_Copy (Res, El);
+                     Set_Parent (Res, Conf);
+                     Set_Block_Specification (Res, El);
+                     Append (Last_Item, Conf, Res);
+                  elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                     Blk_Spec := Strip_Denoting_Name
+                       (Get_Block_Specification (Blk_Config));
+                     if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement then
+                        --  There are partial configurations.
+                        --  Create a default block configuration.
+                        Res := Create_Iir (Iir_Kind_Block_Configuration);
+                        Location_Copy (Res, El);
+                        Set_Parent (Res, Conf);
+                        Blk_Spec := Create_Iir (Iir_Kind_Indexed_Name);
+                        Location_Copy (Blk_Spec, Res);
+                        Set_Index_List (Blk_Spec, Iir_List_Others);
+                        Set_Base_Name (Blk_Spec, El);
+                        Set_Prefix (Blk_Spec, Build_Simple_Name (El, Res));
+                        Set_Block_Specification (Res, Blk_Spec);
+                        Append (Last_Item, Conf, Res);
+                     end if;
+                  end if;
+               end;
+
+            when Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Process_Statement
+              | Iir_Kind_Psl_Assert_Statement
+              | Iir_Kind_Psl_Cover_Statement
+              | Iir_Kind_Psl_Default_Clock
+              | Iir_Kind_Psl_Declaration
+              | Iir_Kind_Simple_Simultaneous_Statement =>
+               null;
+
+            when others =>
+               Error_Kind ("canon_block_configuration(3)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      --  4) Canon component configuration and block configuration (recursion).
+      El := Get_Configuration_Item_Chain (Conf);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Block_Configuration =>
+               Canon_Block_Configuration (Top, El);
+            when Iir_Kind_Component_Configuration =>
+               Canon_Component_Configuration (Top, El);
+            when others =>
+               Error_Kind ("canon_block_configuration", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Canon_Block_Configuration;
+
+   procedure Canon_Interface_List (Chain : Iir)
+   is
+      Inter : Iir;
+   begin
+      if Canon_Flag_Expressions then
+         Inter := Chain;
+         while Inter /= Null_Iir loop
+            Canon_Expression (Get_Default_Value (Inter));
+            Inter := Get_Chain (Inter);
+         end loop;
+      end if;
+   end Canon_Interface_List;
+
+   procedure Canonicalize (Unit: Iir_Design_Unit)
+   is
+      El: Iir;
+   begin
+      if False then
+         --  Canon context clauses.
+         --  This code is not executed since context clauses are already
+         --  canonicalized.
+         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 ("canonicalize1", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end if;
+
+      El := Get_Library_Unit (Unit);
+      case Get_Kind (El) is
+         when Iir_Kind_Entity_Declaration =>
+            Canon_Interface_List (Get_Generic_Chain (El));
+            Canon_Interface_List (Get_Port_Chain (El));
+            Canon_Declarations (Unit, El, El);
+            Canon_Concurrent_Stmts (Unit, El);
+         when Iir_Kind_Architecture_Body =>
+            Canon_Declarations (Unit, El, El);
+            Canon_Concurrent_Stmts (Unit, El);
+         when Iir_Kind_Package_Declaration =>
+            Canon_Declarations (Unit, El, Null_Iir);
+         when Iir_Kind_Package_Body =>
+            Canon_Declarations (Unit, El, Null_Iir);
+         when Iir_Kind_Configuration_Declaration =>
+            Canon_Declarations (Unit, El, Null_Iir);
+            Canon_Block_Configuration (Unit, Get_Block_Configuration (El));
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            declare
+               Pkg : constant Iir :=
+                 Get_Named_Entity (Get_Uninstantiated_Package_Name (El));
+               Hdr : constant Iir := Get_Package_Header (Pkg);
+            begin
+               Set_Generic_Map_Aspect_Chain
+                 (El,
+                  Canon_Association_Chain_And_Actuals
+                    (Get_Generic_Chain (Hdr),
+                     Get_Generic_Map_Aspect_Chain (El), El));
+            end;
+         when others =>
+            Error_Kind ("canonicalize2", El);
+      end case;
+   end Canonicalize;
+
+--    --  Create a default component configuration for component instantiation
+--    --  statement INST.
+--    function Create_Default_Component_Configuration
+--      (Inst : Iir_Component_Instantiation_Statement;
+--       Parent : Iir;
+--       Config_Unit : Iir_Design_Unit)
+--      return Iir_Component_Configuration
+--    is
+--       Res : Iir_Component_Configuration;
+--       Designator : Iir;
+--       Comp : Iir_Component_Declaration;
+--       Bind : Iir;
+--       Aspect : Iir;
+--    begin
+--       Bind := Get_Default_Binding_Indication (Inst);
+
+--       if Bind = Null_Iir then
+--          --  Component is not bound.
+--          return Null_Iir;
+--       end if;
+
+--       Res := Create_Iir (Iir_Kind_Component_Configuration);
+--       Location_Copy (Res, Inst);
+--       Set_Parent (Res, Parent);
+--       Comp := Get_Instantiated_Unit (Inst);
+
+--       Set_Component_Name (Res, Comp);
+--       --  Create the instantiation list with only one element: INST.
+--       Designator := Create_Iir (Iir_Kind_Designator_List);
+--       Append_Element (Designator, Inst);
+--       Set_Instantiation_List (Res, Designator);
+
+--       Set_Binding_Indication (Res, Bind);
+--       Aspect := Get_Entity_Aspect (Bind);
+--       case Get_Kind (Aspect) is
+--          when Iir_Kind_Entity_Aspect_Entity =>
+--             Add_Dependence (Config_Unit, Get_Entity (Aspect));
+--             if Get_Architecture (Aspect) /= Null_Iir then
+--                raise Internal_Error;
+--             end if;
+--          when others =>
+--             Error_Kind ("Create_Default_Component_Configuration", Aspect);
+--       end case;
+
+--       return Res;
+--    end Create_Default_Component_Configuration;
+
+   --  Create a default configuration declaration for architecture ARCH.
+   function Create_Default_Configuration_Declaration
+     (Arch : Iir_Architecture_Body)
+     return Iir_Design_Unit
+   is
+      Loc : constant Location_Type := Get_Location (Arch);
+      Config : Iir_Configuration_Declaration;
+      Res : Iir_Design_Unit;
+      Blk_Cfg : Iir_Block_Configuration;
+   begin
+      Res := Create_Iir (Iir_Kind_Design_Unit);
+      Set_Location (Res, Loc);
+      Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch)));
+      Set_Date_State (Res, Date_Analyze);
+      Set_Date (Res, Date_Uptodate);
+
+      Config := Create_Iir (Iir_Kind_Configuration_Declaration);
+      Set_Location (Config, Loc);
+      Set_Library_Unit (Res, Config);
+      Set_Design_Unit (Config, Res);
+      Set_Entity_Name (Config, Get_Entity_Name (Arch));
+      Set_Dependence_List (Res, Create_Iir_List);
+      Add_Dependence (Res, Get_Design_Unit (Get_Entity (Config)));
+      Add_Dependence (Res, Get_Design_Unit (Arch));
+
+      Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration);
+      Set_Location (Blk_Cfg, Loc);
+      Set_Parent (Blk_Cfg, Config);
+      Set_Block_Specification (Blk_Cfg, Arch);
+      Set_Block_Configuration (Config, Blk_Cfg);
+
+      Canon_Block_Configuration (Res, Blk_Cfg);
+
+      return Res;
+   end Create_Default_Configuration_Declaration;
+
+end Canon;
diff --git a/src/canon.ads b/src/canon.ads
new file mode 100644
index 000000000..574a31824
--- /dev/null
+++ b/src/canon.ads
@@ -0,0 +1,70 @@
+--  Canonicalization pass
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Canon is
+   --  If true, a label will be added for statements which do not have a
+   --  label.
+   Canon_Flag_Add_Labels : Boolean := False;
+
+   --  If true, canon sequentials statements (processes and subprograms).
+   Canon_Flag_Sequentials_Stmts : Boolean := False;
+
+   --  If true, canon expressions.
+   Canon_Flag_Expressions : Boolean := False;
+
+   --  If true, replace 'all' sensitivity list by the explicit list
+   --  (If true, Canon_Flag_Sequentials_Stmts must be true)
+   Canon_Flag_All_Sensitivity : Boolean := False;
+
+   --  If true, operands of type array element of a concatenation operator
+   --  are converted (by an aggregate) into array.
+   Canon_Concatenation : Boolean := False;
+
+   -- Do canonicalization:
+   --  Transforms concurrent statements into sensitized process statements
+   --   (all but component instanciation and block).
+   --  This computes sensivity list.
+   --
+   --  Association list are completed:
+   --  * Formal are added.
+   --  * association are created for formal not associated (actual is open).
+   --  * an association is created (for block header only).
+   procedure Canonicalize (Unit: Iir_Design_Unit);
+
+   --  Create a default configuration declaration for architecture ARCH.
+   function Create_Default_Configuration_Declaration
+     (Arch : Iir_Architecture_Body)
+     return Iir_Design_Unit;
+
+   --  Canonicalize a subprogram call.
+   procedure Canon_Subprogram_Call (Call : Iir);
+
+   -- Compute the sensivity list of EXPR and add it to SENSIVITY_LIST.
+   -- If IS_TARGET is true, the longuest static prefix of the signal name
+   -- is not added to the sensitivity list, but other static prefix (such
+   -- as indexes of an indexed name) are added.
+   procedure Canon_Extract_Sensitivity
+     (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False);
+
+   --  Compute the sensitivity list of all-sensitized process PROC.
+   --  Used for vhdl 08.
+   function Canon_Extract_Process_Sensitivity
+     (Proc : Iir_Sensitized_Process_Statement)
+     return Iir_List;
+end Canon;
diff --git a/src/canon_psl.adb b/src/canon_psl.adb
new file mode 100644
index 000000000..1e1d8de18
--- /dev/null
+++ b/src/canon_psl.adb
@@ -0,0 +1,43 @@
+--  Canonicalization pass for PSL.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with PSL.Nodes; use PSL.Nodes;
+with PSL.Errors; use PSL.Errors;
+with Canon; use Canon;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Canon_PSL is
+   --  Version of Canon.Canon_Extract_Sensitivity for PSL nodes.
+   procedure Canon_Extract_Sensitivity
+     (Expr: PSL_Node; Sensitivity_List: Iir_List)
+   is
+   begin
+      case Get_Kind (Expr) is
+         when N_HDL_Expr =>
+            Canon_Extract_Sensitivity (Get_HDL_Node (Expr), Sensitivity_List);
+         when N_And_Bool
+           | N_Or_Bool =>
+            Canon_Extract_Sensitivity (Get_Left (Expr), Sensitivity_List);
+            Canon_Extract_Sensitivity (Get_Right (Expr), Sensitivity_List);
+         when N_Not_Bool =>
+            Canon_Extract_Sensitivity (Get_Boolean (Expr), Sensitivity_List);
+         when others =>
+            Error_Kind ("PSL.Canon_extract_Sensitivity", Expr);
+      end case;
+   end Canon_Extract_Sensitivity;
+end Canon_PSL;
diff --git a/src/canon_psl.ads b/src/canon_psl.ads
new file mode 100644
index 000000000..3a8c501ac
--- /dev/null
+++ b/src/canon_psl.ads
@@ -0,0 +1,26 @@
+--  Canonicalization pass for PSL.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Canon_PSL is
+   --  Version of Canon.Canon_Extract_Sensitivity for PSL nodes.
+   procedure Canon_Extract_Sensitivity
+     (Expr: PSL_Node; Sensitivity_List: Iir_List);
+end Canon_PSL;
diff --git a/src/configuration.adb b/src/configuration.adb
new file mode 100644
index 000000000..f570b692e
--- /dev/null
+++ b/src/configuration.adb
@@ -0,0 +1,614 @@
+--  Configuration generation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Libraries;
+with Errorout; use Errorout;
+with Std_Package;
+with Sem_Names;
+with Name_Table; use Name_Table;
+with Flags;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Configuration is
+   procedure Add_Design_Concurrent_Stmts (Parent : Iir);
+   procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration);
+   procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean);
+
+   Current_File_Dependence : Iir_List := Null_Iir_List;
+   Current_Configuration : Iir_Configuration_Declaration := Null_Iir;
+
+   --  UNIT is a design unit of a configuration declaration.
+   --  Fill the DESIGN_UNITS table with all design units required to build
+   --  UNIT.
+   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir)
+   is
+      List : Iir_List;
+      El : Iir;
+      Lib_Unit : Iir;
+      File : Iir_Design_File;
+      Prev_File_Dependence : Iir_List;
+   begin
+      if Flag_Build_File_Dependence then
+         File := Get_Design_File (Unit);
+         if Current_File_Dependence /= Null_Iir_List then
+            Add_Element (Current_File_Dependence, File);
+         end if;
+      end if;
+
+      --  If already in the table, then nothing to do.
+      if Get_Elab_Flag (Unit) then
+         return;
+      end if;
+
+      --  May be enabled to debug dependency construction.
+      if False then
+         if From = Null_Iir then
+            Warning_Msg_Elab (Disp_Node (Unit) & " added", Unit);
+         else
+            Warning_Msg_Elab
+              (Disp_Node (Unit) & " added by " & Disp_Node (From), From);
+         end if;
+      end if;
+
+      Set_Elab_Flag (Unit, True);
+
+      Lib_Unit := Get_Library_Unit (Unit);
+
+      if Flag_Build_File_Dependence then
+         Prev_File_Dependence := Current_File_Dependence;
+
+         if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration
+           and then Get_Identifier (Lib_Unit) = Null_Identifier
+         then
+            --  Do not add dependence for default configuration.
+            Current_File_Dependence := Null_Iir_List;
+         else
+            File := Get_Design_File (Unit);
+            Current_File_Dependence := Get_File_Dependence_List (File);
+            --  Create a list if not yet created.
+            if Current_File_Dependence = Null_Iir_List then
+               Current_File_Dependence := Create_Iir_List;
+               Set_File_Dependence_List (File, Current_File_Dependence);
+            end if;
+         end if;
+      end if;
+
+      if Flag_Load_All_Design_Units then
+         Libraries.Load_Design_Unit (Unit, From);
+      end if;
+
+      --  Add packages from depend list.
+      --  If Flag_Build_File_Dependences is set, add design units of the
+      --  dependence list are added, because of LRM 11.4 Analysis Order.
+      --  Note: a design unit may be referenced but unused.
+      --  (eg: component specification which does not apply).
+      List := Get_Dependence_List (Unit);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         El := Libraries.Find_Design_Unit (El);
+         if El /= Null_Iir then
+            Lib_Unit := Get_Library_Unit (El);
+            if Flag_Build_File_Dependence
+              or else Get_Kind (Lib_Unit) in Iir_Kinds_Package_Declaration
+            then
+               Add_Design_Unit (El, Unit);
+            end if;
+         end if;
+      end loop;
+
+      --  Lib_Unit may have changed.
+      Lib_Unit := Get_Library_Unit (Unit);
+
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Package_Declaration =>
+            --  Analyze the package declaration, so that Set_Package below
+            --  will set the full package (and not a stub).
+            Libraries.Load_Design_Unit (Unit, From);
+            Lib_Unit := Get_Library_Unit (Unit);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            --  The uninstantiated package is part of the dependency.
+            null;
+         when Iir_Kind_Configuration_Declaration =>
+            --  Add entity and architecture.
+            --  find all sub-configuration
+            Libraries.Load_Design_Unit (Unit, From);
+            Lib_Unit := Get_Library_Unit (Unit);
+            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit);
+            declare
+               Blk : Iir_Block_Configuration;
+               Prev_Configuration : Iir_Configuration_Declaration;
+               Arch : Iir;
+            begin
+               Prev_Configuration := Current_Configuration;
+               Current_Configuration := Lib_Unit;
+               Blk := Get_Block_Configuration (Lib_Unit);
+               Arch := Get_Block_Specification (Blk);
+               Add_Design_Block_Configuration (Blk);
+               Current_Configuration := Prev_Configuration;
+               Add_Design_Unit (Get_Design_Unit (Arch), Unit);
+            end;
+         when Iir_Kind_Architecture_Body =>
+            --  Add entity
+            --  find all entity/architecture/configuration instantiation
+            Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit);
+            Add_Design_Concurrent_Stmts (Lib_Unit);
+         when Iir_Kind_Entity_Declaration =>
+            null;
+         when Iir_Kind_Package_Body =>
+            null;
+         when others =>
+            Error_Kind ("add_design_unit", Lib_Unit);
+      end case;
+
+      --  Add it in the table, after the dependencies.
+      Design_Units.Append (Unit);
+
+      --  Restore now the file dependence.
+      --  Indeed, we may add a package body when we are in a package
+      --  declaration.  However, the later does not depend on the former.
+      --  The file which depends on the package declaration also depends on
+      --  the package body.
+      if Flag_Build_File_Dependence then
+         Current_File_Dependence := Prev_File_Dependence;
+      end if;
+
+      if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then
+         --  Add body (if any).
+         declare
+            Bod : Iir_Design_Unit;
+         begin
+            Bod := Libraries.Find_Secondary_Unit (Unit, Null_Identifier);
+            if Get_Need_Body (Lib_Unit) then
+               if not Flags.Flag_Elaborate_With_Outdated then
+                  --  LIB_UNIT requires a body.
+                  if Bod = Null_Iir then
+                     Error_Msg_Elab ("body of " & Disp_Node (Lib_Unit)
+                                     & " was never analyzed", Lib_Unit);
+                  elsif Get_Date (Bod) < Get_Date (Unit) then
+                     Error_Msg_Elab (Disp_Node (Bod) & " is outdated");
+                     Bod := Null_Iir;
+                  end if;
+               end if;
+            else
+               if Bod /= Null_Iir
+                 and then Get_Date (Bod) < Get_Date (Unit)
+               then
+                  --  There is a body for LIB_UNIT (which doesn't
+                  --  require it) but it is outdated.
+                  Bod := Null_Iir;
+               end if;
+            end if;
+            if Bod /= Null_Iir then
+               Set_Package (Get_Library_Unit (Bod), Lib_Unit);
+               Add_Design_Unit (Bod, Unit);
+            end if;
+         end;
+      end if;
+   end Add_Design_Unit;
+
+   procedure Add_Design_Concurrent_Stmts (Parent : Iir)
+   is
+      Stmt : Iir;
+   begin
+      Stmt := Get_Concurrent_Statement_Chain (Parent);
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Component_Instantiation_Statement =>
+               if Is_Entity_Instantiation (Stmt) then
+                  --  Entity or configuration instantiation.
+                  Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True);
+               end if;
+            when Iir_Kind_Generate_Statement
+              | Iir_Kind_Block_Statement =>
+               Add_Design_Concurrent_Stmts (Stmt);
+            when Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Psl_Assert_Statement
+              | Iir_Kind_Psl_Cover_Statement
+              | Iir_Kind_Psl_Default_Clock
+              | Iir_Kind_Psl_Declaration
+              | Iir_Kind_Simple_Simultaneous_Statement =>
+               null;
+            when others =>
+               Error_Kind ("add_design_concurrent_stmts(2)", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Add_Design_Concurrent_Stmts;
+
+   procedure Add_Design_Aspect (Aspect : Iir; Add_Default : Boolean)
+   is
+      use Libraries;
+
+      Entity : Iir;
+      Arch : Iir;
+      Config : Iir;
+      Id : Name_Id;
+      Entity_Lib : Iir;
+   begin
+      if Aspect = Null_Iir then
+         return;
+      end if;
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            --  Add the entity.
+            Entity_Lib := Get_Entity (Aspect);
+            Entity := Get_Design_Unit (Entity_Lib);
+            Add_Design_Unit (Entity, Aspect);
+
+            --  Extract and add the architecture.
+            Arch := Get_Architecture (Aspect);
+            if Arch /= Null_Iir then
+               case Get_Kind (Arch) is
+                  when Iir_Kind_Simple_Name =>
+                     Id := Get_Identifier (Arch);
+                     Arch := Load_Secondary_Unit (Entity, Id, Aspect);
+                     if Arch = Null_Iir then
+                        Error_Msg_Elab
+                          ("cannot find architecture " & Name_Table.Image (Id)
+                           & " of " & Disp_Node (Entity_Lib));
+                        return;
+                     else
+                        Set_Architecture (Aspect, Get_Library_Unit (Arch));
+                     end if;
+                  when Iir_Kind_Architecture_Body =>
+                     Arch := Get_Design_Unit (Arch);
+                  when others =>
+                     Error_Kind ("add_design_aspect", Arch);
+               end case;
+            else
+               Arch := Get_Latest_Architecture (Entity_Lib);
+               if Arch = Null_Iir then
+                  Error_Msg_Elab ("no architecture in library for "
+                                  & Disp_Node (Entity_Lib), Aspect);
+                  return;
+               end if;
+               Arch := Get_Design_Unit (Arch);
+            end if;
+            Load_Design_Unit (Arch, Aspect);
+            Add_Design_Unit (Arch, Aspect);
+
+            --  Add the default configuration if required.
+            if Add_Default then
+               Config := Get_Default_Configuration_Declaration
+                 (Get_Library_Unit (Arch));
+               if Config /= Null_Iir then
+                  Add_Design_Unit (Config, Aspect);
+               end if;
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Add_Design_Unit
+              (Get_Design_Unit (Get_Configuration (Aspect)), Aspect);
+         when Iir_Kind_Entity_Aspect_Open =>
+            null;
+         when others =>
+            Error_Kind ("add_design_aspect", Aspect);
+      end case;
+   end Add_Design_Aspect;
+
+   --  Return TRUE is PORT must not be open, and emit an error message only if
+   --  LOC is not NULL_IIR.
+   function Check_Open_Port (Port : Iir; Loc : Iir) return Boolean is
+   begin
+      case Get_Mode (Port) is
+         when Iir_In_Mode =>
+            --  LRM 1.1.1.2 Ports
+            --  A port of mode IN may be unconnected or unassociated only if
+            --  its declaration includes a default expression.
+            if Get_Default_Value (Port) = Null_Iir then
+               if Loc /= Null_Iir then
+                  Error_Msg_Elab
+                    ("IN " & Disp_Node (Port) & " must be connected", Loc);
+               end if;
+               return True;
+            end if;
+         when Iir_Out_Mode
+           | Iir_Inout_Mode
+           | Iir_Buffer_Mode
+           | Iir_Linkage_Mode =>
+            --  LRM 1.1.1.2  Ports
+            --  A port of any mode other than IN may be unconnected or
+            --  unassociated as long as its type is not an unconstrained array
+            --  type.
+            if Get_Kind (Get_Type (Port)) in Iir_Kinds_Array_Type_Definition
+              and then (Get_Constraint_State (Get_Type (Port))
+                          /= Fully_Constrained)
+            then
+               if Loc /= Null_Iir then
+                  Error_Msg_Elab ("unconstrained " & Disp_Node (Port)
+                                  & " must be connected", Loc);
+               end if;
+               return True;
+            end if;
+         when others =>
+            Error_Kind ("check_open_port", Port);
+      end case;
+      return False;
+   end Check_Open_Port;
+
+   procedure Check_Binding_Indication (Conf : Iir)
+   is
+      Assoc : Iir;
+      Conf_Chain : Iir;
+      Inst_Chain : Iir;
+      Bind : Iir_Binding_Indication;
+      Err : Boolean;
+      Inst : Iir;
+      Inst_List : Iir_List;
+      Formal : Iir;
+      Assoc_1 : Iir;
+      Actual : Iir;
+   begin
+      Bind := Get_Binding_Indication (Conf);
+      Conf_Chain := Get_Port_Map_Aspect_Chain (Bind);
+
+      Err := False;
+      --  Note: the assoc chain is already canonicalized.
+
+      --  First pass: check for open associations in configuration.
+      Assoc := Conf_Chain;
+      while Assoc /= Null_Iir loop
+         if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+            Formal := Get_Association_Interface (Assoc);
+            Err := Err or Check_Open_Port (Formal, Assoc);
+            if Flags.Warn_Binding and then not Get_Artificial_Flag (Assoc) then
+               Warning_Msg_Elab
+                 (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
+                  & " is not bound", Assoc);
+               Warning_Msg_Elab
+                 ("(in " & Disp_Node (Current_Configuration) & ")",
+                  Current_Configuration);
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      if Err then
+         return;
+      end if;
+
+      --  Second pass: check for port connected to open in instantiation.
+      Inst_List := Get_Instantiation_List (Conf);
+      for I in Natural loop
+         Inst := Get_Nth_Element (Inst_List, I);
+         exit when Inst = Null_Iir;
+         Inst := Get_Named_Entity (Inst);
+         Err := False;
+
+         --  Mark component ports not associated.
+         Inst_Chain := Get_Port_Map_Aspect_Chain (Inst);
+         Assoc := Inst_Chain;
+         while Assoc /= Null_Iir loop
+            if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+               Formal := Get_Association_Interface (Assoc);
+               Set_Open_Flag (Formal, True);
+               Err := True;
+            end if;
+            Assoc := Get_Chain (Assoc);
+         end loop;
+
+         --  If there is any component port open, search them in the
+         --  configuration.
+         if Err then
+            Assoc := Conf_Chain;
+            while Assoc /= Null_Iir loop
+               Formal := Get_Association_Interface (Assoc);
+               if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+                  Actual := Null_Iir;
+               else
+                  Actual := Get_Actual (Assoc);
+                  Actual := Sem_Names.Name_To_Object (Actual);
+                  if Actual /= Null_Iir then
+                     Actual := Get_Object_Prefix (Actual);
+                  end if;
+               end if;
+               if Actual /= Null_Iir
+                 and then Get_Open_Flag (Actual)
+                 and then Check_Open_Port (Formal, Null_Iir)
+               then
+                  --  For a better message, find the location.
+                  Assoc_1 := Inst_Chain;
+                  while Assoc_1 /= Null_Iir loop
+                     if Get_Kind (Assoc_1) = Iir_Kind_Association_Element_Open
+                       and then Actual = Get_Association_Interface (Assoc_1)
+                     then
+                        Err := Check_Open_Port (Formal, Assoc_1);
+                        exit;
+                     end if;
+                     Assoc_1 := Get_Chain (Assoc_1);
+                  end loop;
+               end if;
+               Assoc := Get_Chain (Assoc);
+            end loop;
+
+            --  Clear open flag.
+            Assoc := Inst_Chain;
+            while Assoc /= Null_Iir loop
+               if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+                  Formal := Get_Association_Interface (Assoc);
+                  Set_Open_Flag (Formal, False);
+               end if;
+               Assoc := Get_Chain (Assoc);
+            end loop;
+         end if;
+      end loop;
+   end Check_Binding_Indication;
+
+   --  CONF is either a configuration specification or a component
+   --   configuration.
+   --  If ADD_DEFAULT is true, then the default configuration for the design
+   --  binding must be added if required.
+   procedure Add_Design_Binding_Indication (Conf : Iir; Add_Default : Boolean)
+   is
+      Bind : constant Iir_Binding_Indication := Get_Binding_Indication (Conf);
+      Inst : Iir;
+   begin
+      if Bind = Null_Iir then
+         if Flags.Warn_Binding then
+            Inst := Get_First_Element (Get_Instantiation_List (Conf));
+            Warning_Msg_Elab
+              (Disp_Node (Inst) & " is not bound", Conf);
+            Warning_Msg_Elab
+              ("(in " & Disp_Node (Current_Configuration) & ")",
+               Current_Configuration);
+         end if;
+         return;
+      end if;
+      Check_Binding_Indication (Conf);
+      Add_Design_Aspect (Get_Entity_Aspect (Bind), Add_Default);
+   end Add_Design_Binding_Indication;
+
+   procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration)
+   is
+      Item : Iir;
+      Sub_Config : Iir;
+   begin
+      if Blk = Null_Iir then
+         return;
+      end if;
+      Item := Get_Configuration_Item_Chain (Blk);
+      while Item /= Null_Iir loop
+         case Get_Kind (Item) is
+            when Iir_Kind_Configuration_Specification =>
+               Add_Design_Binding_Indication (Item, True);
+            when Iir_Kind_Component_Configuration =>
+               Sub_Config := Get_Block_Configuration (Item);
+               Add_Design_Binding_Indication (Item, Sub_Config = Null_Iir);
+               Add_Design_Block_Configuration (Sub_Config);
+            when Iir_Kind_Block_Configuration =>
+               Add_Design_Block_Configuration (Item);
+            when others =>
+               Error_Kind ("add_design_block_configuration", Item);
+         end case;
+         Item := Get_Chain (Item);
+      end loop;
+   end Add_Design_Block_Configuration;
+
+   --  elaboration of a design hierarchy:
+   --  creates a list of design unit.
+   --
+   --  find top configuration (may be a default one), add it to the list.
+   --  For each element of the list:
+   --  add direct dependences (packages, entity, arch) if not in the list
+   --  for architectures and configuration: find instantiations and add
+   --  corresponding configurations
+   function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id)
+     return Iir
+   is
+      use Libraries;
+
+      Unit : Iir_Design_Unit;
+      Lib_Unit : Iir;
+      Top : Iir;
+   begin
+      Unit := Find_Primary_Unit (Work_Library, Primary_Id);
+      if Unit = Null_Iir then
+         Error_Msg_Elab ("cannot find entity or configuration "
+                         & Name_Table.Image (Primary_Id));
+         return Null_Iir;
+      end if;
+      Lib_Unit := Get_Library_Unit (Unit);
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            Load_Design_Unit (Unit, Null_Iir);
+            Lib_Unit := Get_Library_Unit (Unit);
+            if Secondary_Id /= Null_Identifier then
+               Unit := Find_Secondary_Unit (Unit, Secondary_Id);
+               if Unit = Null_Iir then
+                  Error_Msg_Elab
+                    ("cannot find architecture "
+                     & Name_Table.Image (Secondary_Id)
+                     & " of " & Disp_Node (Lib_Unit));
+                  return Null_Iir;
+               end if;
+            else
+               declare
+                  Arch_Unit : Iir_Architecture_Body;
+               begin
+                  Arch_Unit := Get_Latest_Architecture (Lib_Unit);
+                  if Arch_Unit = Null_Iir then
+                     Error_Msg_Elab
+                       (Disp_Node (Lib_Unit)
+                        & " has no architecture in library "
+                        & Name_Table.Image (Get_Identifier (Work_Library)));
+                     return Null_Iir;
+                  end if;
+                  Unit := Get_Design_Unit (Arch_Unit);
+               end;
+            end if;
+            Load_Design_Unit (Unit, Lib_Unit);
+            if Nbr_Errors /= 0 then
+               return Null_Iir;
+            end if;
+            Lib_Unit := Get_Library_Unit (Unit);
+            Top := Get_Default_Configuration_Declaration (Lib_Unit);
+            if Top = Null_Iir then
+               --  No default configuration for this architecture.
+               raise Internal_Error;
+            end if;
+         when Iir_Kind_Configuration_Declaration =>
+            Top := Unit;
+         when others =>
+            Error_Msg_Elab (Name_Table.Image (Primary_Id)
+                            & " is neither an entity nor a configuration");
+            return Null_Iir;
+      end case;
+
+      Set_Elab_Flag (Std_Package.Std_Standard_Unit, True);
+
+      Add_Design_Unit (Top, Null_Iir);
+      return Top;
+   end Configure;
+
+   procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration)
+   is
+      Has_Error : Boolean := False;
+
+      procedure Error (Msg : String; Loc : Iir) is
+      begin
+         if not Has_Error then
+            Error_Msg_Elab
+              (Disp_Node (Entity) & " cannot be at the top of a design");
+            Has_Error := True;
+         end if;
+         Error_Msg_Elab (Msg, Loc);
+      end Error;
+
+      El : Iir;
+   begin
+      --  Check generics.
+      El := Get_Generic_Chain (Entity);
+      while El /= Null_Iir loop
+         if Get_Default_Value (El) = Null_Iir then
+            Error ("(" & Disp_Node (El) & " has no default value)", El);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      --  Check port.
+      El := Get_Port_Chain (Entity);
+      while El /= Null_Iir loop
+         if not Is_Fully_Constrained_Type (Get_Type (El))
+           and then Get_Default_Value (El) = Null_Iir
+         then
+            Error ("(" & Disp_Node (El)
+                     & " is unconstrained and has no default value)", El);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+   end Check_Entity_Declaration_Top;
+end Configuration;
diff --git a/src/configuration.ads b/src/configuration.ads
new file mode 100644
index 000000000..0a19a23c2
--- /dev/null
+++ b/src/configuration.ads
@@ -0,0 +1,55 @@
+--  Configuration generation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+with GNAT.Table;
+
+package Configuration is
+   package Design_Units is new GNAT.Table
+     (Table_Component_Type => Iir_Design_Unit,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   --  Get the top configuration to build a design hierarchy whose top is
+   --  PRIMARY + SECONDARY.
+   --  PRIMARY must designate a configuration declaration or an entity
+   --  declaration.  In the last case, SECONDARY must be null_identifier or
+   --  designates an architecture declaration.
+   --
+   --  creates a list of design unit.
+   --  and return the top configuration.
+   --  Note: this set the Elab_Flag on units.
+   function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id)
+     return Iir;
+
+   --  Add design unit UNIT (with its dependences) in the design_units table.
+   procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir);
+
+   --  If set, all design units (even package bodies) are loaded.
+   Flag_Load_All_Design_Units : Boolean := True;
+
+   Flag_Build_File_Dependence : Boolean := False;
+
+   --  Check if ENTITY can be at the top of a hierarchy, ie:
+   --  ENTITY has no generics or all generics have a default expression
+   --  ENTITY has no ports or all ports type are constrained.
+   --  If not, emit a elab error message.
+   procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration);
+end Configuration;
diff --git a/src/disp_tree.adb b/src/disp_tree.adb
new file mode 100644
index 000000000..fbaaa939b
--- /dev/null
+++ b/src/disp_tree.adb
@@ -0,0 +1,511 @@
+--  Node displaying (for debugging).
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+--  Display trees in raw form.  Mainly used for debugging.
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Name_Table;
+with Str_Table;
+with Tokens;
+with Errorout;
+with Files_Map;
+with PSL.Dump_Tree;
+with Nodes_Meta;
+
+--  Do not add a use clause for iirs_utils, as it may crash for ill-formed
+--  trees, which is annoying while debugging.
+
+package body Disp_Tree is
+   --  function Is_Anonymous_Type_Definition (Def : Iir) return Boolean
+   --    renames Iirs_Utils.Is_Anonymous_Type_Definition;
+
+   procedure Disp_Iir (N : Iir;
+                       Indent : Natural := 1;
+                       Flat : Boolean := False);
+   procedure Disp_Header (N : Iir);
+
+   procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural);
+   pragma Unreferenced (Disp_Tree_List_Flat);
+
+   procedure Put_Indent (Tab: Natural) is
+      Blanks : constant String (1 .. 2 * Tab) := (others => ' ');
+   begin
+      Put (Blanks);
+   end Put_Indent;
+
+   procedure Disp_Iir_Number (Node: Iir)
+   is
+      Res : String (1 .. 10) := "         ]";
+      N : Int32 := Int32 (Node);
+   begin
+      for I in reverse 2 .. 9 loop
+         Res (I) := Character'Val (Character'Pos ('0') + (N mod 10));
+         N := N / 10;
+         if N = 0 then
+            Res (I - 1) := '[';
+            Put (Res (I - 1 .. Res'Last));
+            return;
+         end if;
+      end loop;
+      Put (Res);
+   end Disp_Iir_Number;
+
+   -- For iir.
+
+   procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural) is
+   begin
+      Disp_Iir (Tree, Tab, True);
+   end Disp_Tree_Flat;
+
+   procedure Disp_Iir_List
+     (Tree_List : Iir_List; Tab : Natural := 0; Flat : Boolean := False)
+   is
+      El: Iir;
+   begin
+      if Tree_List = Null_Iir_List then
+         Put_Line ("null-list");
+      elsif Tree_List = Iir_List_All then
+         Put_Line ("list-all");
+      elsif Tree_List = Iir_List_Others then
+         Put_Line ("list-others");
+      else
+         New_Line;
+         for I in Natural loop
+            El := Get_Nth_Element (Tree_List, I);
+            exit when El = Null_Iir;
+            Put_Indent (Tab);
+            Disp_Iir (El, Tab + 1, Flat);
+         end loop;
+      end if;
+   end Disp_Iir_List;
+
+   procedure Disp_Chain
+     (Tree_Chain: Iir; Indent: Natural; Flat : Boolean := False)
+   is
+      El: Iir;
+   begin
+      New_Line;
+      El := Tree_Chain;
+      while El /= Null_Iir loop
+         Put_Indent (Indent);
+         Disp_Iir (El, Indent + 1, Flat);
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Chain;
+
+   procedure Disp_Tree_Flat_Chain (Tree_Chain: Iir; Tab: Natural)
+   is
+      El: Iir;
+   begin
+      El := Tree_Chain;
+      while El /= Null_Iir loop
+         Disp_Iir (El, Tab, True);
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Tree_Flat_Chain;
+   pragma Unreferenced (Disp_Tree_Flat_Chain);
+
+   procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural)
+   is
+      El: Iir;
+   begin
+      if Tree_List = Null_Iir_List then
+         Put_Indent (Tab);
+         Put_Line (" null-list");
+      elsif Tree_List = Iir_List_All then
+         Put_Indent (Tab);
+         Put_Line (" list-all");
+      elsif Tree_List = Iir_List_Others then
+         Put_Indent (Tab);
+         Put_Line (" list-others");
+      else
+         for I in Natural loop
+            El := Get_Nth_Element (Tree_List, I);
+            exit when El = Null_Iir;
+            Disp_Tree_Flat (El, Tab);
+         end loop;
+      end if;
+   end Disp_Tree_List_Flat;
+
+   function Image_Name_Id (Ident: Name_Id) return String
+   is
+      use Name_Table;
+   begin
+      if Ident /= Null_Identifier then
+         Image (Ident);
+         return ''' & Name_Buffer (1 .. Name_Length) & ''';
+      else
+         return "<anonymous>";
+      end if;
+   end Image_Name_Id;
+
+   function Image_Iir_Staticness (Static: Iir_Staticness) return String is
+   begin
+      case Static is
+         when Unknown =>
+            return "???";
+         when None =>
+            return "none";
+         when Globally =>
+            return "global";
+         when Locally =>
+            return "local";
+      end case;
+   end Image_Iir_Staticness;
+
+   function Image_Boolean (Bool : Boolean) return String is
+   begin
+      if Bool then
+         return "true";
+      else
+         return "false";
+      end if;
+   end Image_Boolean;
+
+   function Image_Iir_Delay_Mechanism (Mech : Iir_Delay_Mechanism)
+                                      return String is
+   begin
+      case Mech is
+         when Iir_Inertial_Delay =>
+            return "inertial";
+         when Iir_Transport_Delay =>
+            return "transport";
+      end case;
+   end Image_Iir_Delay_Mechanism;
+
+   function Image_Iir_Lexical_Layout_Type (V : Iir_Lexical_Layout_Type)
+                                          return String is
+   begin
+      if (V and Iir_Lexical_Has_Mode) /= 0 then
+         return " +mode"
+           & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Mode);
+      elsif (V and Iir_Lexical_Has_Class) /= 0 then
+         return " +class"
+           & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Class);
+      elsif (V and Iir_Lexical_Has_Type) /= 0 then
+         return " +type"
+           & Image_Iir_Lexical_Layout_Type (V and not Iir_Lexical_Has_Type);
+      else
+         return "";
+      end if;
+   end Image_Iir_Lexical_Layout_Type;
+
+   function Image_Iir_Mode (Mode : Iir_Mode) return String is
+   begin
+      case Mode is
+         when Iir_Unknown_Mode =>
+            return "???";
+         when Iir_Linkage_Mode =>
+            return "linkage";
+         when Iir_Buffer_Mode =>
+            return "buffer";
+         when Iir_Out_Mode =>
+            return "out";
+         when Iir_Inout_Mode =>
+            return "inout";
+         when Iir_In_Mode =>
+            return "in";
+      end case;
+   end Image_Iir_Mode;
+
+   function Image_Iir_Signal_Kind (Kind : Iir_Signal_Kind) return String is
+   begin
+      case Kind is
+         when Iir_No_Signal_Kind =>
+            return "no";
+         when Iir_Register_Kind =>
+            return "register";
+         when Iir_Bus_Kind =>
+            return "bus";
+      end case;
+   end Image_Iir_Signal_Kind;
+
+   function Image_Iir_Pure_State (State : Iir_Pure_State) return String is
+   begin
+      case State is
+         when Pure =>
+            return "pure";
+         when Impure =>
+            return "impure";
+         when Maybe_Impure =>
+            return "maybe_impure";
+         when Unknown =>
+            return "unknown";
+      end case;
+   end Image_Iir_Pure_State;
+
+   function Image_Iir_All_Sensitized (Sig : Iir_All_Sensitized)
+                                     return String is
+   begin
+      case Sig is
+         when Unknown =>
+            return "???";
+         when No_Signal =>
+            return "no_signal";
+         when Read_Signal =>
+            return "read_signal";
+         when Invalid_Signal =>
+            return "invalid_signal";
+      end case;
+   end Image_Iir_All_Sensitized;
+
+   function Image_Iir_Constraint (Const : Iir_Constraint) return String is
+   begin
+      case Const is
+         when Unconstrained =>
+            return "unconstrained";
+         when Partially_Constrained =>
+            return "partially constrained";
+         when Fully_Constrained =>
+            return "fully constrained";
+      end case;
+   end Image_Iir_Constraint;
+
+   function Image_Date_State_Type (State : Date_State_Type) return String is
+   begin
+      case State is
+         when Date_Extern =>
+            return "extern";
+         when Date_Disk =>
+            return "disk";
+         when Date_Parse =>
+            return "parse";
+         when Date_Analyze =>
+            return "analyze";
+      end case;
+   end Image_Date_State_Type;
+
+   function Image_Tri_State_Type (State : Tri_State_Type) return String is
+   begin
+      case State is
+         when True =>
+            return "true";
+         when False =>
+            return "false";
+         when Unknown =>
+            return "unknown";
+      end case;
+   end Image_Tri_State_Type;
+
+   function Image_Time_Stamp_Id (Id : Time_Stamp_Id) return String
+     renames Files_Map.Get_Time_Stamp_String;
+
+   function Image_Iir_Predefined_Functions (F : Iir_Predefined_Functions)
+                                           return String is
+   begin
+      return Iir_Predefined_Functions'Image (F);
+   end Image_Iir_Predefined_Functions;
+
+   function Image_String_Id (S : String_Id) return String
+     renames Str_Table.Image;
+
+   procedure Disp_PSL_Node (N : PSL_Node; Indent : Natural) is
+   begin
+      Put_Indent (Indent);
+      PSL.Dump_Tree.Dump_Tree (N, True);
+   end Disp_PSL_Node;
+
+   procedure Disp_PSL_NFA (N : PSL_NFA; Indent : Natural) is
+   begin
+      null;
+   end Disp_PSL_NFA;
+
+   function Image_Location_Type (Loc : Location_Type) return String is
+   begin
+      return Errorout.Get_Location_Str (Loc);
+   end Image_Location_Type;
+
+   function Image_Iir_Direction (Dir : Iir_Direction) return String is
+   begin
+      case Dir is
+         when Iir_To =>
+            return "to";
+         when Iir_Downto =>
+            return "downto";
+      end case;
+   end Image_Iir_Direction;
+
+   function Image_Token_Type (Tok : Tokens.Token_Type) return String
+     renames Tokens.Image;
+
+   procedure Header (Str : String; Indent : Natural) is
+   begin
+      Put_Indent (Indent);
+      Put (Str);
+      Put (": ");
+   end Header;
+
+   procedure Disp_Header (N : Iir)
+   is
+      use Nodes_Meta;
+      K : Iir_Kind;
+   begin
+      if N = Null_Iir then
+         Put_Line ("*null*");
+         return;
+      end if;
+
+      K := Get_Kind (N);
+      Put (Get_Iir_Image (K));
+      if Has_Identifier (K) then
+         Put (' ');
+         Put (Image_Name_Id (Get_Identifier (N)));
+      end if;
+
+      Put (' ');
+      Disp_Iir_Number (N);
+
+      New_Line;
+   end Disp_Header;
+
+   procedure Disp_Iir (N : Iir;
+                       Indent : Natural := 1;
+                       Flat : Boolean := False)
+   is
+      Sub_Indent : constant Natural := Indent + 1;
+   begin
+      Disp_Header (N);
+
+      if Flat or else N = Null_Iir then
+         return;
+      end if;
+
+      Header ("location", Indent);
+      Put_Line (Image_Location_Type (Get_Location (N)));
+
+      --  Protect against infinite recursions.
+      if Indent > 20 then
+         Put_Indent (Indent);
+         Put_Line ("...");
+         return;
+      end if;
+
+      declare
+         use Nodes_Meta;
+         Fields : constant Fields_Array := Get_Fields (Get_Kind (N));
+         F : Fields_Enum;
+      begin
+         for I in Fields'Range loop
+            F := Fields (I);
+            Header (Get_Field_Image (F), Indent);
+            case Get_Field_Type (F) is
+               when Type_Iir =>
+                  case Get_Field_Attribute (F) is
+                     when Attr_None =>
+                        Disp_Iir (Get_Iir (N, F), Sub_Indent);
+                     when Attr_Ref =>
+                        Disp_Iir (Get_Iir (N, F), Sub_Indent, True);
+                     when Attr_Maybe_Ref =>
+                        Disp_Iir (Get_Iir (N, F), Sub_Indent, Get_Is_Ref (N));
+                     when Attr_Chain =>
+                        Disp_Chain (Get_Iir (N, F), Sub_Indent);
+                     when Attr_Chain_Next =>
+                        Disp_Iir_Number (Get_Iir (N, F));
+                        New_Line;
+                     when Attr_Of_Ref =>
+                        raise Internal_Error;
+                  end case;
+               when Type_Iir_List =>
+                  Disp_Iir_List (Get_Iir_List (N, F), Sub_Indent,
+                                 Get_Field_Attribute (F) = Attr_Of_Ref);
+               when Type_PSL_NFA =>
+                  Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent);
+               when Type_String_Id =>
+                  Put_Line (Image_String_Id (Get_String_Id (N, F)));
+               when Type_PSL_Node =>
+                  Disp_PSL_Node (Get_PSL_Node (N, F), Sub_Indent);
+               when Type_Source_Ptr =>
+                  Put_Line (Source_Ptr'Image (Get_Source_Ptr (N, F)));
+               when Type_Date_Type =>
+                  Put_Line (Date_Type'Image (Get_Date_Type (N, F)));
+               when Type_Base_Type =>
+                  Put_Line (Base_Type'Image (Get_Base_Type (N, F)));
+               when Type_Iir_Constraint =>
+                  Put_Line (Image_Iir_Constraint
+                              (Get_Iir_Constraint (N, F)));
+               when Type_Iir_Mode =>
+                  Put_Line (Image_Iir_Mode (Get_Iir_Mode (N, F)));
+               when Type_Iir_Index32 =>
+                  Put_Line (Iir_Index32'Image (Get_Iir_Index32 (N, F)));
+               when Type_Iir_Int64 =>
+                  Put_Line (Iir_Int64'Image (Get_Iir_Int64 (N, F)));
+               when Type_Boolean =>
+                  Put_Line (Image_Boolean
+                              (Get_Boolean (N, F)));
+               when Type_Iir_Staticness =>
+                  Put_Line (Image_Iir_Staticness
+                              (Get_Iir_Staticness (N, F)));
+               when Type_Date_State_Type =>
+                  Put_Line (Image_Date_State_Type
+                              (Get_Date_State_Type (N, F)));
+               when Type_Iir_All_Sensitized =>
+                  Put_Line (Image_Iir_All_Sensitized
+                              (Get_Iir_All_Sensitized (N, F)));
+               when Type_Iir_Signal_Kind =>
+                  Put_Line (Image_Iir_Signal_Kind
+                              (Get_Iir_Signal_Kind (N, F)));
+               when Type_Tri_State_Type =>
+                  Put_Line (Image_Tri_State_Type
+                              (Get_Tri_State_Type (N, F)));
+               when Type_Iir_Pure_State =>
+                  Put_Line (Image_Iir_Pure_State
+                              (Get_Iir_Pure_State (N, F)));
+               when Type_Iir_Delay_Mechanism =>
+                  Put_Line (Image_Iir_Delay_Mechanism
+                              (Get_Iir_Delay_Mechanism (N, F)));
+               when Type_Iir_Lexical_Layout_Type =>
+                  Put_Line (Image_Iir_Lexical_Layout_Type
+                              (Get_Iir_Lexical_Layout_Type (N, F)));
+               when Type_Iir_Predefined_Functions =>
+                  Put_Line (Image_Iir_Predefined_Functions
+                              (Get_Iir_Predefined_Functions (N, F)));
+               when Type_Iir_Direction =>
+                  Put_Line (Image_Iir_Direction
+                              (Get_Iir_Direction (N, F)));
+               when Type_Location_Type =>
+                  Put_Line (Image_Location_Type
+                              (Get_Location_Type (N, F)));
+               when Type_Iir_Int32 =>
+                  Put_Line (Iir_Int32'Image (Get_Iir_Int32 (N, F)));
+               when Type_Int32 =>
+                  Put_Line (Int32'Image (Get_Int32 (N, F)));
+               when Type_Iir_Fp64 =>
+                  Put_Line (Iir_Fp64'Image (Get_Iir_Fp64 (N, F)));
+               when Type_Time_Stamp_Id =>
+                  Put_Line (Image_Time_Stamp_Id
+                              (Get_Time_Stamp_Id (N, F)));
+               when Type_Token_Type =>
+                  Put_Line (Image_Token_Type (Get_Token_Type (N, F)));
+               when Type_Name_Id =>
+                  Put_Line (Image_Name_Id (Get_Name_Id (N, F)));
+            end case;
+         end loop;
+      end;
+   end Disp_Iir;
+
+   procedure Disp_Tree_For_Psl (N : Int32) is
+   begin
+      Disp_Tree_Flat (Iir (N), 1);
+   end Disp_Tree_For_Psl;
+
+   procedure Disp_Tree (Tree : Iir;
+                        Flat : Boolean := false) is
+   begin
+      Disp_Iir (Tree, 1, Flat);
+   end Disp_Tree;
+end Disp_Tree;
diff --git a/src/disp_tree.ads b/src/disp_tree.ads
new file mode 100644
index 000000000..94b1d29e3
--- /dev/null
+++ b/src/disp_tree.ads
@@ -0,0 +1,27 @@
+--  Node displaying (for debugging).
+--  Copyright (C) 2002, 2003, 2004, 2005, 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Disp_Tree is
+   --  Disp TREE recursively.
+   procedure Disp_Tree (Tree : Iir;
+                        Flat : Boolean := False);
+
+   procedure Disp_Tree_For_Psl (N : Int32);
+end Disp_Tree;
diff --git a/src/disp_vhdl.adb b/src/disp_vhdl.adb
new file mode 100644
index 000000000..73a8e420f
--- /dev/null
+++ b/src/disp_vhdl.adb
@@ -0,0 +1,3247 @@
+--  VHDL regeneration from internal nodes.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+--  Re-print a tree as VHDL sources.  Except for comments and parenthesis, the
+--  sequence of tokens displayed is the same as the sequence of tokens in the
+--  input file.  If parenthesis are kept by the parser, the only differences
+--  are comments and layout.
+with GNAT.OS_Lib;
+with Std_Package;
+with Flags; use Flags;
+with Errorout; use Errorout;
+with Iirs_Utils; use Iirs_Utils;
+with Name_Table;
+with Std_Names;
+with Tokens;
+with PSL.Nodes;
+with PSL.Prints;
+with PSL.NFAs;
+
+package body Disp_Vhdl is
+
+   subtype Count is Positive;
+
+   Col : Count := 1;
+
+   IO_Error : exception;
+
+   --  Disp the name of DECL.
+   procedure Disp_Name_Of (Decl: Iir);
+
+   --  Indentation for nested declarations and statements.
+   Indentation: constant Count := 2;
+
+   --  Line length (used to try to have a nice display).
+   Line_Length : constant Count := 80;
+
+   --  If True, display extra parenthesis to make priority of operators
+   --  explicit.
+   Flag_Parenthesis : constant Boolean := False;
+
+   -- If set, disp after a string literal the type enclosed into brackets.
+   Disp_String_Literal_Type: constant Boolean := False;
+
+   -- If set, disp position number of associations
+   --Disp_Position_Number: constant Boolean := False;
+
+--    procedure Disp_Tab (Tab: Natural) is
+--       Blanks : String (1 .. Tab) := (others => ' ');
+--    begin
+--       Put (Blanks);
+--    end Disp_Tab;
+
+   procedure Disp_Type (A_Type: Iir);
+   procedure Disp_Nature (Nature : Iir);
+   procedure Disp_Range (Rng : Iir);
+
+   procedure Disp_Concurrent_Statement (Stmt: Iir);
+   procedure Disp_Concurrent_Statement_Chain (Parent: Iir; Indent : Count);
+   procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count);
+   procedure Disp_Process_Statement (Process: Iir);
+   procedure Disp_Sequential_Statements (First : Iir);
+   procedure Disp_Choice (Choice: in out Iir);
+   procedure Disp_Association_Chain (Chain : Iir);
+   procedure Disp_Block_Configuration
+     (Block: Iir_Block_Configuration; Indent: Count);
+   procedure Disp_Subprogram_Declaration (Subprg: Iir);
+   procedure Disp_Binding_Indication (Bind : Iir; Indent : Count);
+   procedure Disp_Subtype_Indication (Def : Iir; Full_Decl : Boolean := False);
+   procedure Disp_Parametered_Attribute (Name : String; Expr : Iir);
+
+   procedure Put (Str : String)
+   is
+      use GNAT.OS_Lib;
+      Len : constant Natural := Str'Length;
+   begin
+      if Write (Standout, Str'Address, Len) /= Len then
+         raise IO_Error;
+      end if;
+      Col := Col + Len;
+   end Put;
+
+   procedure Put (C : Character) is
+   begin
+      Put ((1 => C));
+   end Put;
+
+   procedure New_Line is
+   begin
+      Put (ASCII.LF);
+      Col := 1;
+   end New_Line;
+
+   procedure Put_Line (Str : String) is
+   begin
+      Put (Str);
+      New_Line;
+   end Put_Line;
+
+   procedure Set_Col (P : Count) is
+   begin
+      if Col = P then
+         return;
+      end if;
+      if Col >= P then
+         New_Line;
+      end if;
+      Put ((Col .. P - 1 => ' '));
+   end Set_Col;
+
+   procedure Disp_Ident (Id: Name_Id) is
+   begin
+      Put (Name_Table.Image (Id));
+   end Disp_Ident;
+
+   procedure Disp_Identifier (Node : Iir)
+   is
+      Ident : Name_Id;
+   begin
+      Ident := Get_Identifier (Node);
+      if Ident /= Null_Identifier then
+         Disp_Ident (Ident);
+      else
+         Put ("<anonymous>");
+      end if;
+   end Disp_Identifier;
+
+   procedure Disp_Character_Literal (Lit: Iir_Character_Literal) is
+   begin
+      Put (''' & Name_Table.Get_Character (Get_Identifier (Lit)) & ''');
+   end Disp_Character_Literal;
+
+   procedure Disp_Function_Name (Func: Iir)
+   is
+      use Name_Table;
+      use Std_Names;
+      Id: Name_Id;
+   begin
+      Id := Get_Identifier (Func);
+      case Id is
+         when Name_Id_Operators
+           | Name_Word_Operators
+           | Name_Xnor
+           | Name_Shift_Operators =>
+            Put ("""");
+            Put (Image (Id));
+            Put ("""");
+         when others =>
+            Disp_Ident (Id);
+      end case;
+   end Disp_Function_Name;
+
+   --  Disp the name of DECL.
+   procedure Disp_Name_Of (Decl: Iir) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Component_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kinds_Quantity_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Character_Literal
+           | Iir_Kinds_Process_Statement =>
+            Disp_Identifier (Decl);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Put ('<');
+            Disp_Ident (Get_Identifier (Decl));
+            Put ('>');
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            Disp_Function_Name (Decl);
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            Disp_Identifier (Decl);
+         when Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration =>
+            --  Used for 'end' DECL_NAME.
+            Disp_Identifier (Get_Type_Declarator (Decl));
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Disp_Ident (Get_Label (Decl));
+         when Iir_Kind_Design_Unit =>
+            Disp_Name_Of (Get_Library_Unit (Decl));
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Simple_Name =>
+            Disp_Identifier (Decl);
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            declare
+               Ident : constant Name_Id := Get_Label (Decl);
+            begin
+               if Ident /= Null_Identifier then
+                  Disp_Ident (Ident);
+               else
+                  Put ("<anonymous>");
+               end if;
+            end;
+         when Iir_Kind_Package_Body =>
+            Disp_Identifier (Get_Package (Decl));
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            Disp_Function_Name (Get_Subprogram_Specification (Decl));
+         when Iir_Kind_Protected_Type_Body =>
+            Disp_Identifier
+              (Get_Type_Declarator (Get_Protected_Type_Declaration (Decl)));
+         when others =>
+            Error_Kind ("disp_name_of", Decl);
+      end case;
+   end Disp_Name_Of;
+
+   procedure Disp_Name (Name: Iir) is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Selected_By_All_Name =>
+            Disp_Name (Get_Prefix (Name));
+            Put (".all");
+         when Iir_Kind_Dereference =>
+            Disp_Name (Get_Prefix (Name));
+            Put (".all");
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal =>
+            Put (Iirs_Utils.Image_Identifier (Name));
+         when Iir_Kind_Operator_Symbol =>
+            Disp_Function_Name (Name);
+         when Iir_Kind_Selected_Name =>
+            Disp_Name (Get_Prefix (Name));
+            Put (".");
+            Disp_Function_Name (Name);
+         when Iir_Kind_Parenthesis_Name =>
+            Disp_Name (Get_Prefix (Name));
+            Disp_Association_Chain (Get_Association_Chain (Name));
+         when Iir_Kind_Base_Attribute =>
+            Disp_Name (Get_Prefix (Name));
+            Put ("'base");
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kinds_Interface_Object_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Group_Template_Declaration =>
+            Disp_Name_Of (Name);
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            Disp_Range (Name);
+         when others =>
+            Error_Kind ("disp_name", Name);
+      end case;
+   end Disp_Name;
+
+   procedure Disp_Range (Rng : Iir) is
+   begin
+      case Get_Kind (Rng) is
+         when Iir_Kind_Range_Expression =>
+            declare
+               Origin : constant Iir := Get_Range_Origin (Rng);
+            begin
+               if Origin /= Null_Iir then
+                  Disp_Expression (Origin);
+               else
+                  Disp_Expression (Get_Left_Limit (Rng));
+                  if Get_Direction (Rng) = Iir_To then
+                     Put (" to ");
+                  else
+                     Put (" downto ");
+                  end if;
+                  Disp_Expression (Get_Right_Limit (Rng));
+               end if;
+            end;
+         when Iir_Kind_Range_Array_Attribute =>
+            Disp_Parametered_Attribute ("range", Rng);
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            Disp_Parametered_Attribute ("reverse_range", Rng);
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Disp_Name (Rng);
+         when others =>
+            Disp_Subtype_Indication (Rng);
+            --  Disp_Name_Of (Get_Type_Declarator (Decl));
+      end case;
+   end Disp_Range;
+
+   procedure Disp_After_End (Decl : Iir; Name : String) is
+   begin
+      if Get_End_Has_Reserved_Id (Decl) then
+         Put (' ');
+         Put (Name);
+      end if;
+      if Get_End_Has_Identifier (Decl) then
+         Put (' ');
+         Disp_Name_Of (Decl);
+      end if;
+      Put (';');
+      New_Line;
+   end Disp_After_End;
+
+   procedure Disp_End (Decl : Iir; Name : String) is
+   begin
+      Put ("end");
+      Disp_After_End (Decl, Name);
+   end Disp_End;
+
+   procedure Disp_End_Label (Stmt : Iir; Name : String) is
+   begin
+      Put ("end");
+      Put (' ');
+      Put (Name);
+      if Get_End_Has_Identifier (Stmt) then
+         Put (' ');
+         Disp_Ident (Get_Label (Stmt));
+      end if;
+      Put (';');
+      New_Line;
+   end Disp_End_Label;
+
+   procedure Disp_Use_Clause (Clause: Iir_Use_Clause)
+   is
+      Name : Iir;
+   begin
+      Put ("use ");
+      Name := Clause;
+      loop
+         Disp_Name (Get_Selected_Name (Name));
+         Name := Get_Use_Clause_Chain (Name);
+         exit when Name = Null_Iir;
+         Put (", ");
+      end loop;
+      Put_Line (";");
+   end Disp_Use_Clause;
+
+   -- Disp the resolution function (if any) of type definition DEF.
+   procedure Disp_Resolution_Indication (Subtype_Def: Iir)
+   is
+      procedure Inner (Ind : Iir) is
+      begin
+         case Get_Kind (Ind) is
+            when Iir_Kinds_Denoting_Name =>
+               Disp_Name (Ind);
+            when Iir_Kind_Array_Element_Resolution =>
+               Put ("(");
+               Inner (Get_Resolution_Indication (Ind));
+               Put (")");
+            when others =>
+               Error_Kind ("disp_resolution_indication", Ind);
+         end case;
+      end Inner;
+
+      Ind : Iir;
+   begin
+      case Get_Kind (Subtype_Def) is
+         when Iir_Kind_Access_Subtype_Definition =>
+            --  No resolution indication on access subtype.
+            return;
+         when others =>
+            Ind := Get_Resolution_Indication (Subtype_Def);
+            if Ind = Null_Iir then
+               --  No resolution indication.
+               return;
+            end if;
+      end case;
+
+      declare
+         Type_Mark : constant Iir := Get_Denoted_Type_Mark (Subtype_Def);
+      begin
+         if Get_Kind (Type_Mark) in Iir_Kinds_Subtype_Definition
+           and then Get_Resolution_Indication (Type_Mark) = Ind
+         then
+            --  Resolution indication was inherited from the type_mark.
+            return;
+         end if;
+      end;
+
+      Inner (Ind);
+      Put (" ");
+   end Disp_Resolution_Indication;
+
+   procedure Disp_Integer_Subtype_Definition
+     (Def: Iir_Integer_Subtype_Definition)
+   is
+      Base_Type: Iir_Integer_Type_Definition;
+      Decl: Iir;
+   begin
+      if Def /= Std_Package.Universal_Integer_Subtype_Definition then
+         Base_Type := Get_Base_Type (Def);
+         Decl := Get_Type_Declarator (Base_Type);
+         if Base_Type /= Std_Package.Universal_Integer_Subtype_Definition
+           and then Def /= Decl
+         then
+            Disp_Name_Of (Decl);
+            Put (" ");
+         end if;
+      end if;
+      Disp_Resolution_Indication (Def);
+      Put ("range ");
+      Disp_Expression (Get_Range_Constraint (Def));
+      Put (";");
+   end Disp_Integer_Subtype_Definition;
+
+   procedure Disp_Floating_Subtype_Definition
+     (Def: Iir_Floating_Subtype_Definition)
+   is
+      Base_Type: Iir_Floating_Type_Definition;
+      Decl: Iir;
+   begin
+      if Def /= Std_Package.Universal_Real_Subtype_Definition then
+         Base_Type := Get_Base_Type (Def);
+         Decl := Get_Type_Declarator (Base_Type);
+         if Base_Type /= Std_Package.Universal_Real_Subtype_Definition
+           and then Def /= Decl
+         then
+            Disp_Name_Of (Decl);
+            Put (" ");
+         end if;
+      end if;
+      Disp_Resolution_Indication (Def);
+      Put ("range ");
+      Disp_Expression (Get_Range_Constraint (Def));
+      Put (";");
+   end Disp_Floating_Subtype_Definition;
+
+   procedure Disp_Element_Constraint (Def : Iir; Type_Mark : Iir);
+
+   procedure Disp_Array_Element_Constraint (Def : Iir; Type_Mark : Iir)
+   is
+      Def_El : constant Iir := Get_Element_Subtype (Def);
+      Tm_El : constant Iir := Get_Element_Subtype (Type_Mark);
+      Has_Index : constant Boolean := Get_Index_Constraint_Flag (Def);
+      Has_Own_Element_Subtype : constant Boolean := Def_El /= Tm_El;
+      Index : Iir;
+   begin
+      if not Has_Index and not Has_Own_Element_Subtype then
+         return;
+      end if;
+
+      if Get_Constraint_State (Type_Mark) /= Fully_Constrained
+        and then Has_Index
+      then
+         Put (" (");
+         for I in Natural loop
+            Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I);
+            exit when Index = Null_Iir;
+            if I /= 0 then
+               Put (", ");
+            end if;
+            --Disp_Expression (Get_Range_Constraint (Index));
+            Disp_Range (Index);
+         end loop;
+         Put (")");
+      end if;
+
+      if Has_Own_Element_Subtype
+        and then Get_Kind (Def_El) in Iir_Kinds_Composite_Type_Definition
+      then
+         Disp_Element_Constraint (Def_El, Tm_El);
+      end if;
+   end Disp_Array_Element_Constraint;
+
+   procedure Disp_Record_Element_Constraint (Def : Iir)
+   is
+      El_List : constant Iir_List := Get_Elements_Declaration_List (Def);
+      El : Iir;
+      Has_El : Boolean := False;
+   begin
+      for I in Natural loop
+         El := Get_Nth_Element (El_List, I);
+         exit when El = Null_Iir;
+         if Get_Kind (El) = Iir_Kind_Record_Element_Constraint
+           and then Get_Parent (El) = Def
+         then
+            if Has_El then
+               Put (", ");
+            else
+               Put ("(");
+               Has_El := True;
+            end if;
+            Disp_Name_Of (El);
+            Disp_Element_Constraint (Get_Type (El),
+                                     Get_Base_Type (Get_Type (El)));
+         end if;
+      end loop;
+      if Has_El then
+         Put (")");
+      end if;
+   end Disp_Record_Element_Constraint;
+
+   procedure Disp_Element_Constraint (Def : Iir; Type_Mark : Iir) is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Record_Subtype_Definition =>
+            Disp_Record_Element_Constraint (Def);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Disp_Array_Element_Constraint (Def, Type_Mark);
+         when others =>
+            Error_Kind ("disp_element_constraint", Def);
+      end case;
+   end Disp_Element_Constraint;
+
+   procedure Disp_Tolerance_Opt (N : Iir) is
+      Tol : constant Iir := Get_Tolerance (N);
+   begin
+      if Tol /= Null_Iir then
+         Put ("tolerance ");
+         Disp_Expression (Tol);
+      end if;
+   end Disp_Tolerance_Opt;
+
+   procedure Disp_Subtype_Indication (Def : Iir; Full_Decl : Boolean := False)
+   is
+      Type_Mark : Iir;
+      Base_Type : Iir;
+      Decl : Iir;
+   begin
+      if Get_Kind (Def) in Iir_Kinds_Denoting_Name then
+         Disp_Name (Def);
+         return;
+      end if;
+
+      Decl := Get_Type_Declarator (Def);
+      if not Full_Decl and then Decl /= Null_Iir then
+         Disp_Name_Of (Decl);
+         return;
+      end if;
+
+      -- Resolution function name.
+      Disp_Resolution_Indication (Def);
+
+      -- type mark.
+      Type_Mark := Get_Subtype_Type_Mark (Def);
+      if Type_Mark /= Null_Iir then
+         Disp_Name (Type_Mark);
+         Type_Mark := Get_Type (Type_Mark);
+      end if;
+
+      Base_Type := Get_Base_Type (Def);
+      case Get_Kind (Base_Type) is
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            if Type_Mark = Null_Iir
+              or else Get_Range_Constraint (Def)
+              /= Get_Range_Constraint (Type_Mark)
+            then
+               if Type_Mark /= Null_Iir then
+                  Put (" range ");
+               end if;
+               Disp_Expression (Get_Range_Constraint (Def));
+            end if;
+            if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition then
+               Disp_Tolerance_Opt (Def);
+            end if;
+         when Iir_Kind_Access_Type_Definition =>
+            declare
+               Des_Ind : constant Iir :=
+                 Get_Designated_Subtype_Indication (Def);
+            begin
+               if Des_Ind /= Null_Iir then
+                  pragma Assert
+                    (Get_Kind (Des_Ind) = Iir_Kind_Array_Subtype_Definition);
+                  Disp_Array_Element_Constraint
+                    (Des_Ind, Get_Designated_Type (Base_Type));
+               end if;
+            end;
+         when Iir_Kind_Array_Type_Definition =>
+            if Type_Mark = Null_Iir then
+               Disp_Array_Element_Constraint (Def, Def);
+            else
+               Disp_Array_Element_Constraint (Def, Type_Mark);
+            end if;
+         when Iir_Kind_Record_Type_Definition =>
+            Disp_Record_Element_Constraint (Def);
+         when others =>
+            Error_Kind ("disp_subtype_indication", Base_Type);
+      end case;
+   end Disp_Subtype_Indication;
+
+   procedure Disp_Enumeration_Type_Definition
+     (Def: Iir_Enumeration_Type_Definition)
+   is
+      Len : Count;
+      Start_Col: Count;
+      Decl: Name_Id;
+      A_Lit: Iir; --Enumeration_Literal_Acc;
+   begin
+      for I in Natural loop
+         A_Lit := Get_Nth_Element (Get_Enumeration_Literal_List (Def), I);
+         exit when A_Lit = Null_Iir;
+         if I = Natural'first then
+            Put ("(");
+            Start_Col := Col;
+         else
+            Put (", ");
+         end if;
+         Decl := Get_Identifier (A_Lit);
+         if Name_Table.Is_Character (Decl) then
+            Len := 3;
+         else
+            Len := Count (Name_Table.Get_Name_Length (Decl));
+         end if;
+         if Col + Len + 2 > Line_Length then
+            New_Line;
+            Set_Col (Start_Col);
+         end if;
+         Disp_Name_Of (A_Lit);
+      end loop;
+      Put (");");
+   end Disp_Enumeration_Type_Definition;
+
+   procedure Disp_Enumeration_Subtype_Definition
+     (Def: Iir_Enumeration_Subtype_Definition)
+   is
+   begin
+      Disp_Resolution_Indication (Def);
+      Put ("range ");
+      Disp_Range (Def);
+      Put (";");
+   end Disp_Enumeration_Subtype_Definition;
+
+   procedure Disp_Discrete_Range (Iterator: Iir) is
+   begin
+      if Get_Kind (Iterator) in Iir_Kinds_Subtype_Definition then
+         Disp_Subtype_Indication (Iterator);
+      else
+         Disp_Range (Iterator);
+      end if;
+   end Disp_Discrete_Range;
+
+   procedure Disp_Array_Subtype_Definition (Def: Iir_Array_Subtype_Definition)
+   is
+      Index: Iir;
+   begin
+      Disp_Resolution_Indication (Def);
+
+      Put ("array (");
+      for I in Natural loop
+         Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I);
+         exit when Index = Null_Iir;
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Discrete_Range (Index);
+      end loop;
+      Put (") of ");
+      Disp_Subtype_Indication (Get_Element_Subtype (Def));
+   end Disp_Array_Subtype_Definition;
+
+   procedure Disp_Array_Type_Definition (Def: Iir_Array_Type_Definition) is
+      Index: Iir;
+   begin
+      Put ("array (");
+      for I in Natural loop
+         Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I);
+         exit when Index = Null_Iir;
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Name (Index);
+         Put (" range <>");
+      end loop;
+      Put (") of ");
+      Disp_Subtype_Indication (Get_Element_Subtype_Indication (Def));
+      Put (";");
+   end Disp_Array_Type_Definition;
+
+   procedure Disp_Physical_Literal (Lit: Iir) is
+   begin
+      case Get_Kind (Lit) is
+         when Iir_Kind_Physical_Int_Literal =>
+            Disp_Int64 (Get_Value (Lit));
+         when Iir_Kind_Physical_Fp_Literal =>
+            Disp_Fp64 (Get_Fp_Value (Lit));
+         when Iir_Kind_Unit_Declaration =>
+            Disp_Identifier (Lit);
+            return;
+         when others =>
+            Error_Kind ("disp_physical_literal", Lit);
+      end case;
+      Put (' ');
+      Disp_Name (Get_Unit_Name (Lit));
+   end Disp_Physical_Literal;
+
+   procedure Disp_Physical_Subtype_Definition
+     (Def: Iir_Physical_Subtype_Definition) is
+   begin
+      Disp_Resolution_Indication (Def);
+      Put ("range ");
+      Disp_Expression (Get_Range_Constraint (Def));
+   end Disp_Physical_Subtype_Definition;
+
+   procedure Disp_Record_Type_Definition
+     (Def: Iir_Record_Type_Definition; Indent: Count)
+   is
+      List : Iir_List;
+      El: Iir_Element_Declaration;
+      Reindent : Boolean;
+   begin
+      Put_Line ("record");
+      Set_Col (Indent);
+      List := Get_Elements_Declaration_List (Def);
+      Reindent := True;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if Reindent then
+            Set_Col (Indent + Indentation);
+         end if;
+         Disp_Identifier (El);
+         if Get_Has_Identifier_List (El) then
+            Put (", ");
+            Reindent := False;
+         else
+            Put (" : ");
+            Disp_Subtype_Indication (Get_Type (El));
+            Put_Line (";");
+            Reindent := True;
+         end if;
+      end loop;
+      Set_Col (Indent);
+      Disp_End (Def, "record");
+   end Disp_Record_Type_Definition;
+
+   procedure Disp_Designator_List (List: Iir_List) is
+      El: Iir;
+   begin
+      if List = Null_Iir_List then
+         return;
+      elsif List = Iir_List_All then
+         Put ("all");
+         return;
+      end if;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if I > 0 then
+            Put (", ");
+         end if;
+         Disp_Expression (El);
+         --Disp_Text_Literal (El);
+      end loop;
+   end Disp_Designator_List;
+
+   -- Display the full definition of a type, ie the sequence that can create
+   -- such a type.
+   procedure Disp_Type_Definition (Def: Iir; Indent: Count) is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Disp_Enumeration_Type_Definition (Def);
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            Disp_Enumeration_Subtype_Definition (Def);
+         when Iir_Kind_Integer_Subtype_Definition =>
+            Disp_Integer_Subtype_Definition (Def);
+         when Iir_Kind_Floating_Subtype_Definition =>
+            Disp_Floating_Subtype_Definition (Def);
+         when Iir_Kind_Array_Type_Definition =>
+            Disp_Array_Type_Definition (Def);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Disp_Array_Subtype_Definition (Def);
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Disp_Physical_Subtype_Definition (Def);
+         when Iir_Kind_Record_Type_Definition =>
+            Disp_Record_Type_Definition (Def, Indent);
+         when Iir_Kind_Access_Type_Definition =>
+            Put ("access ");
+            Disp_Subtype_Indication (Get_Designated_Subtype_Indication (Def));
+            Put (';');
+         when Iir_Kind_File_Type_Definition =>
+            Put ("file of ");
+            Disp_Subtype_Indication (Get_File_Type_Mark (Def));
+            Put (';');
+         when Iir_Kind_Protected_Type_Declaration =>
+            Put_Line ("protected");
+            Disp_Declaration_Chain (Def, Indent + Indentation);
+            Set_Col (Indent);
+            Disp_End (Def, "protected");
+         when Iir_Kind_Integer_Type_Definition =>
+            Put ("<integer base type>");
+         when Iir_Kind_Floating_Type_Definition =>
+            Put ("<floating base type>");
+         when Iir_Kind_Physical_Type_Definition =>
+            Put ("<physical base type>");
+         when others =>
+            Error_Kind ("disp_type_definition", Def);
+      end case;
+   end Disp_Type_Definition;
+
+   procedure Disp_Type_Declaration (Decl: Iir_Type_Declaration)
+   is
+      Indent: Count;
+      Def : Iir;
+   begin
+      Indent := Col;
+      Put ("type ");
+      Disp_Name_Of (Decl);
+      Def := Get_Type_Definition (Decl);
+      if Def = Null_Iir
+        or else Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition
+      then
+         Put_Line (";");
+      else
+         Put (" is ");
+         Disp_Type_Definition (Def, Indent);
+         New_Line;
+      end if;
+   end Disp_Type_Declaration;
+
+   procedure Disp_Anonymous_Type_Declaration
+     (Decl: Iir_Anonymous_Type_Declaration)
+   is
+      Def : constant Iir := Get_Type_Definition (Decl);
+      Indent: constant Count := Col;
+   begin
+      Put ("type ");
+      Disp_Identifier (Decl);
+      Put (" is ");
+      case Get_Kind (Def) is
+         when Iir_Kind_Array_Type_Definition =>
+            declare
+               St : constant Iir := Get_Subtype_Definition (Decl);
+               Indexes : constant Iir_List := Get_Index_Subtype_List (St);
+               Index : Iir;
+            begin
+               Put ("array (");
+               for I in Natural loop
+                  Index := Get_Nth_Element (Indexes, I);
+                  exit when Index = Null_Iir;
+                  if I /= 0 then
+                     Put (", ");
+                  end if;
+                  Disp_Discrete_Range (Index);
+               end loop;
+               Put (") of ");
+               Disp_Subtype_Indication (Get_Element_Subtype_Indication (Def));
+               Put (";");
+            end;
+         when Iir_Kind_Physical_Type_Definition =>
+            declare
+               St : constant Iir := Get_Subtype_Definition (Decl);
+               Unit : Iir_Unit_Declaration;
+            begin
+               Put ("range ");
+               Disp_Expression (Get_Range_Constraint (St));
+               Put_Line (" units");
+               Set_Col (Indent + Indentation);
+               Unit := Get_Unit_Chain (Def);
+               Disp_Identifier (Unit);
+               Put_Line (";");
+               Unit := Get_Chain (Unit);
+               while Unit /= Null_Iir loop
+                  Set_Col (Indent + Indentation);
+                  Disp_Identifier (Unit);
+                  Put (" = ");
+                  Disp_Expression (Get_Physical_Literal (Unit));
+                  Put_Line (";");
+                  Unit := Get_Chain (Unit);
+               end loop;
+               Set_Col (Indent);
+               Disp_End (Def, "units");
+            end;
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Integer_Type_Definition =>
+            declare
+               St : constant Iir := Get_Subtype_Definition (Decl);
+            begin
+               Put ("range ");
+               Disp_Expression (Get_Range_Constraint (St));
+               Put (";");
+            end;
+         when others =>
+            Disp_Type_Definition (Def, Indent);
+      end case;
+      New_Line;
+   end Disp_Anonymous_Type_Declaration;
+
+   procedure Disp_Subtype_Declaration (Decl: in Iir_Subtype_Declaration)
+   is
+      Def : constant Iir := Get_Type (Decl);
+      Bt_Decl : constant Iir := Get_Type_Declarator (Get_Base_Type (Def));
+   begin
+      if Get_Identifier (Decl) = Get_Identifier (Bt_Decl) then
+         Put ("-- ");
+      end if;
+      Put ("subtype ");
+      Disp_Name_Of (Decl);
+      Put (" is ");
+      Disp_Subtype_Indication (Def, True);
+      Put_Line (";");
+   end Disp_Subtype_Declaration;
+
+   procedure Disp_Type (A_Type: Iir)
+   is
+      Decl: Iir;
+   begin
+      Decl := Get_Type_Declarator (A_Type);
+      if Decl /= Null_Iir then
+         Disp_Name_Of (Decl);
+      else
+         case Get_Kind (A_Type) is
+            when Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Integer_Type_Definition =>
+               raise Program_Error;
+            when Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition
+              | Iir_Kind_Access_Subtype_Definition =>
+               Disp_Subtype_Indication (A_Type);
+            when Iir_Kind_Array_Subtype_Definition =>
+               Disp_Subtype_Indication (A_Type);
+            when others =>
+               Error_Kind ("disp_type", A_Type);
+         end case;
+      end if;
+   end Disp_Type;
+
+   procedure Disp_Nature_Definition (Def : Iir) is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Scalar_Nature_Definition =>
+            Disp_Subtype_Indication (Get_Across_Type (Def));
+            Put (" across ");
+            Disp_Subtype_Indication (Get_Through_Type (Def));
+            Put (" through ");
+            Disp_Name_Of (Get_Reference (Def));
+            Put (" reference");
+         when others =>
+            Error_Kind ("disp_nature_definition", Def);
+      end case;
+   end Disp_Nature_Definition;
+
+   procedure Disp_Nature_Declaration (Decl : Iir) is
+   begin
+      Put ("nature ");
+      Disp_Name_Of (Decl);
+      Put (" is ");
+      Disp_Nature_Definition (Get_Nature (Decl));
+      Put_Line (";");
+   end Disp_Nature_Declaration;
+
+   procedure Disp_Nature (Nature : Iir)
+   is
+      Decl: Iir;
+   begin
+      Decl := Get_Nature_Declarator (Nature);
+      if Decl /= Null_Iir then
+         Disp_Name_Of (Decl);
+      else
+         Error_Kind ("disp_nature", Nature);
+      end if;
+   end Disp_Nature;
+
+   procedure Disp_Mode (Mode: Iir_Mode) is
+   begin
+      case Mode is
+         when Iir_In_Mode =>
+            Put ("in ");
+         when Iir_Out_Mode =>
+            Put ("out ");
+         when Iir_Inout_Mode =>
+            Put ("inout ");
+         when Iir_Buffer_Mode =>
+            Put ("buffer ");
+         when Iir_Linkage_Mode =>
+            Put ("linkage ");
+         when Iir_Unknown_Mode =>
+            Put ("<unknown> ");
+      end case;
+   end Disp_Mode;
+
+   procedure Disp_Signal_Kind (Kind: Iir_Signal_Kind) is
+   begin
+      case Kind is
+         when Iir_No_Signal_Kind =>
+            null;
+         when Iir_Register_Kind =>
+            Put (" register");
+         when Iir_Bus_Kind =>
+            Put (" bus");
+      end case;
+   end Disp_Signal_Kind;
+
+   procedure Disp_Interface_Class (Inter: Iir) is
+   begin
+      if (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Class) /= 0 then
+         case Get_Kind (Inter) is
+            when Iir_Kind_Interface_Signal_Declaration =>
+               Put ("signal ");
+            when Iir_Kind_Interface_Variable_Declaration =>
+               Put ("variable ");
+            when Iir_Kind_Interface_Constant_Declaration =>
+               Put ("constant ");
+            when Iir_Kind_Interface_File_Declaration =>
+               Put ("file ");
+            when others =>
+               Error_Kind ("disp_interface_class", Inter);
+         end case;
+      end if;
+   end Disp_Interface_Class;
+
+   procedure Disp_Interface_Mode_And_Type (Inter: Iir)
+   is
+      Default: constant Iir := Get_Default_Value (Inter);
+      Ind : constant Iir := Get_Subtype_Indication (Inter);
+   begin
+      Put (": ");
+      if (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Mode) /= 0 then
+         Disp_Mode (Get_Mode (Inter));
+      end if;
+      if Ind = Null_Iir then
+         --  For implicit subprogram
+         Disp_Type (Get_Type (Inter));
+      else
+         Disp_Subtype_Indication (Get_Subtype_Indication (Inter));
+      end if;
+      if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
+         Disp_Signal_Kind (Get_Signal_Kind (Inter));
+      end if;
+      if Default /= Null_Iir then
+         Put (" := ");
+         Disp_Expression (Default);
+      end if;
+   end Disp_Interface_Mode_And_Type;
+
+   --  Disp interfaces, followed by END_STR (';' in general).
+   procedure Disp_Interface_Chain (Chain: Iir;
+                                   End_Str: String := "";
+                                   Comment_Col : Natural := 0)
+   is
+      Inter: Iir;
+      Next_Inter : Iir;
+      Start: Count;
+   begin
+      if Chain = Null_Iir then
+         return;
+      end if;
+      Put (" (");
+      Start := Col;
+      Inter := Chain;
+      loop
+         Next_Inter := Get_Chain (Inter);
+         Set_Col (Start);
+
+         case Get_Kind (Inter) is
+            when Iir_Kinds_Interface_Object_Declaration =>
+               Disp_Interface_Class (Inter);
+               Disp_Name_Of (Inter);
+               while (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Type) = 0
+               loop
+                  Put (", ");
+                  Inter := Next_Inter;
+                  Next_Inter := Get_Chain (Inter);
+                  Disp_Name_Of (Inter);
+               end loop;
+               Disp_Interface_Mode_And_Type (Inter);
+            when Iir_Kind_Interface_Package_Declaration =>
+               Put ("package ");
+               Disp_Identifier (Inter);
+               Put (" is new ");
+               Disp_Name (Get_Uninstantiated_Package_Name (Inter));
+               Put (" generic map ");
+               declare
+                  Assoc_Chain : constant Iir :=
+                    Get_Generic_Map_Aspect_Chain (Inter);
+               begin
+                  if Assoc_Chain = Null_Iir then
+                     Put ("(<>)");
+                  else
+                     Disp_Association_Chain (Assoc_Chain);
+                  end if;
+               end;
+            when others =>
+               Error_Kind ("disp_interface_chain", Inter);
+         end case;
+
+         if Next_Inter /= Null_Iir then
+            Put (";");
+            if Comment_Col /= 0 then
+               New_Line;
+               Set_Col (Comment_Col);
+               Put ("--");
+            end if;
+         else
+            Put (')');
+            Put (End_Str);
+            exit;
+         end if;
+
+         Inter := Next_Inter;
+         Next_Inter := Get_Chain (Inter);
+      end loop;
+   end Disp_Interface_Chain;
+
+   procedure Disp_Ports (Parent : Iir) is
+   begin
+      Put ("port");
+      Disp_Interface_Chain (Get_Port_Chain (Parent), ";");
+   end Disp_Ports;
+
+   procedure Disp_Generics (Parent : Iir) is
+   begin
+      Put ("generic");
+      Disp_Interface_Chain (Get_Generic_Chain (Parent), ";");
+   end Disp_Generics;
+
+   procedure Disp_Entity_Declaration (Decl: Iir_Entity_Declaration) is
+      Start: constant Count := Col;
+   begin
+      Put ("entity ");
+      Disp_Name_Of (Decl);
+      Put_Line (" is");
+      if Get_Generic_Chain (Decl) /= Null_Iir then
+         Set_Col (Start + Indentation);
+         Disp_Generics (Decl);
+      end if;
+      if Get_Port_Chain (Decl) /= Null_Iir then
+         Set_Col (Start + Indentation);
+         Disp_Ports (Decl);
+      end if;
+      Disp_Declaration_Chain (Decl, Start + Indentation);
+      if Get_Has_Begin (Decl) then
+         Set_Col (Start);
+         Put_Line ("begin");
+      end if;
+      if Get_Concurrent_Statement_Chain (Decl) /= Null_Iir then
+         Disp_Concurrent_Statement_Chain (Decl, Start + Indentation);
+      end if;
+      Set_Col (Start);
+      Disp_End (Decl, "entity");
+   end Disp_Entity_Declaration;
+
+   procedure Disp_Component_Declaration (Decl: Iir_Component_Declaration)
+   is
+      Indent: Count;
+   begin
+      Indent := Col;
+      Put ("component ");
+      Disp_Name_Of (Decl);
+      if Get_Has_Is (Decl) then
+         Put (" is");
+      end if;
+      if Get_Generic_Chain (Decl) /= Null_Iir then
+         Set_Col (Indent + Indentation);
+         Disp_Generics (Decl);
+      end if;
+      if Get_Port_Chain (Decl) /= Null_Iir then
+         Set_Col (Indent + Indentation);
+         Disp_Ports (Decl);
+      end if;
+      Set_Col (Indent);
+      Disp_End (Decl, "component");
+   end Disp_Component_Declaration;
+
+   procedure Disp_Concurrent_Statement_Chain (Parent : Iir; Indent : Count)
+   is
+      El: Iir;
+   begin
+      El := Get_Concurrent_Statement_Chain (Parent);
+      while El /= Null_Iir loop
+         Set_Col (Indent);
+         Disp_Concurrent_Statement (El);
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Concurrent_Statement_Chain;
+
+   procedure Disp_Architecture_Body (Arch: Iir_Architecture_Body)
+   is
+      Start: Count;
+   begin
+      Start := Col;
+      Put ("architecture ");
+      Disp_Name_Of (Arch);
+      Put (" of ");
+      Disp_Name (Get_Entity_Name (Arch));
+      Put_Line (" is");
+      Disp_Declaration_Chain (Arch, Start + Indentation);
+      Set_Col (Start);
+      Put_Line ("begin");
+      Disp_Concurrent_Statement_Chain (Arch, Start + Indentation);
+      Set_Col (Start);
+      Disp_End (Arch, "architecture");
+   end Disp_Architecture_Body;
+
+   procedure Disp_Signature (Sig : Iir)
+   is
+      List : Iir_List;
+      El : Iir;
+   begin
+      Disp_Name (Get_Signature_Prefix (Sig));
+      Put (" [");
+      List := Get_Type_Marks_List (Sig);
+      if List /= Null_Iir_List then
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if I /= 0 then
+               Put (", ");
+            end if;
+            Disp_Name (El);
+         end loop;
+      end if;
+      El := Get_Return_Type_Mark (Sig);
+      if El /= Null_Iir then
+         Put (" return ");
+         Disp_Name (El);
+      end if;
+      Put ("]");
+   end Disp_Signature;
+
+   procedure Disp_Object_Alias_Declaration (Decl: Iir_Object_Alias_Declaration)
+   is
+   begin
+      Put ("alias ");
+      Disp_Name_Of (Decl);
+      Put (": ");
+      Disp_Type (Get_Type (Decl));
+      Put (" is ");
+      Disp_Expression (Get_Name (Decl));
+      Put_Line (";");
+   end Disp_Object_Alias_Declaration;
+
+   procedure Disp_Non_Object_Alias_Declaration
+     (Decl: Iir_Non_Object_Alias_Declaration)
+   is
+      Sig : constant Iir := Get_Alias_Signature (Decl);
+   begin
+      if Get_Implicit_Alias_Flag (Decl) then
+         Put ("-- ");
+      end if;
+
+      Put ("alias ");
+      Disp_Function_Name (Decl);
+      Put (" is ");
+      if Sig /= Null_Iir then
+         Disp_Signature (Sig);
+      else
+         Disp_Name (Get_Name (Decl));
+      end if;
+      Put_Line (";");
+   end Disp_Non_Object_Alias_Declaration;
+
+   procedure Disp_File_Declaration (Decl: Iir_File_Declaration)
+   is
+      Next_Decl : Iir;
+      Expr: Iir;
+   begin
+      Put ("file ");
+      Disp_Name_Of (Decl);
+      Next_Decl := Decl;
+      while Get_Has_Identifier_List (Next_Decl) loop
+         Next_Decl := Get_Chain (Next_Decl);
+         Put (", ");
+         Disp_Name_Of (Next_Decl);
+      end loop;
+      Put (": ");
+      Disp_Type (Get_Type (Decl));
+      if Vhdl_Std = Vhdl_87 then
+         Put (" is ");
+         if Get_Has_Mode (Decl) then
+            Disp_Mode (Get_Mode (Decl));
+         end if;
+         Disp_Expression (Get_File_Logical_Name (Decl));
+      else
+         Expr := Get_File_Open_Kind (Decl);
+         if Expr /= Null_Iir then
+            Put (" open ");
+            Disp_Expression (Expr);
+         end if;
+         Expr := Get_File_Logical_Name (Decl);
+         if Expr /= Null_Iir then
+            Put (" is ");
+            Disp_Expression (Expr);
+         end if;
+      end if;
+      Put (';');
+   end Disp_File_Declaration;
+
+   procedure Disp_Quantity_Declaration (Decl: Iir)
+   is
+      Expr : Iir;
+      Term : Iir;
+   begin
+      Put ("quantity ");
+      Disp_Name_Of (Decl);
+
+      case Get_Kind (Decl) is
+         when Iir_Kinds_Branch_Quantity_Declaration =>
+            Disp_Tolerance_Opt (Decl);
+            Expr := Get_Default_Value (Decl);
+            if Expr /= Null_Iir then
+               Put (":= ");
+               Disp_Expression (Expr);
+            end if;
+            if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then
+               Put (" across ");
+            else
+               Put (" through ");
+            end if;
+            Disp_Name_Of (Get_Plus_Terminal (Decl));
+            Term := Get_Minus_Terminal (Decl);
+            if Term /= Null_Iir then
+               Put (" to ");
+               Disp_Name_Of (Term);
+            end if;
+         when Iir_Kind_Free_Quantity_Declaration =>
+            Put (": ");
+            Disp_Type (Get_Type (Decl));
+            Expr := Get_Default_Value (Decl);
+            if Expr /= Null_Iir then
+               Put (":= ");
+               Disp_Expression (Expr);
+            end if;
+         when others =>
+            raise Program_Error;
+      end case;
+      Put (';');
+   end Disp_Quantity_Declaration;
+
+   procedure Disp_Terminal_Declaration (Decl: Iir) is
+   begin
+      Put ("terminal ");
+      Disp_Name_Of (Decl);
+      Put (": ");
+      Disp_Nature (Get_Nature (Decl));
+      Put (';');
+   end Disp_Terminal_Declaration;
+
+   procedure Disp_Object_Declaration (Decl: Iir)
+   is
+      Next_Decl : Iir;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Variable_Declaration =>
+            if Get_Shared_Flag (Decl) then
+               Put ("shared ");
+            end if;
+            Put ("variable ");
+         when Iir_Kind_Constant_Declaration =>
+            Put ("constant ");
+         when Iir_Kind_Signal_Declaration =>
+            Put ("signal ");
+         when Iir_Kind_File_Declaration =>
+            Disp_File_Declaration (Decl);
+            return;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Disp_Name_Of (Decl);
+      Next_Decl := Decl;
+      while Get_Has_Identifier_List (Next_Decl) loop
+         Next_Decl := Get_Chain (Next_Decl);
+         Put (", ");
+         Disp_Name_Of (Next_Decl);
+      end loop;
+      Put (": ");
+      Disp_Subtype_Indication (Get_Subtype_Indication (Decl));
+      if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then
+         Disp_Signal_Kind (Get_Signal_Kind (Decl));
+      end if;
+
+      if Get_Default_Value (Decl) /= Null_Iir then
+         Put (" := ");
+         Disp_Expression (Get_Default_Value (Decl));
+      end if;
+      Put_Line (";");
+   end Disp_Object_Declaration;
+
+   procedure Disp_Pure (Subprg : Iir) is
+   begin
+      if Get_Pure_Flag (Subprg) then
+         Put ("pure");
+      else
+         Put ("impure");
+      end if;
+   end Disp_Pure;
+
+   procedure Disp_Subprogram_Declaration (Subprg: Iir)
+   is
+      Start : constant Count := Col;
+      Implicit : constant Boolean :=
+        Get_Kind (Subprg) in Iir_Kinds_Implicit_Subprogram_Declaration;
+      Inter : Iir;
+   begin
+      if Implicit
+        and then
+        Get_Implicit_Definition (Subprg) /= Iir_Predefined_Now_Function
+      then
+         Put ("-- ");
+      end if;
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            if Get_Has_Pure (Subprg) then
+               Disp_Pure (Subprg);
+               Put (' ');
+            end if;
+            Put ("function");
+         when Iir_Kind_Implicit_Function_Declaration =>
+            Put ("function");
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            Put ("procedure");
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Put (' ');
+      Disp_Function_Name (Subprg);
+
+      Inter := Get_Interface_Declaration_Chain (Subprg);
+      if Implicit then
+         Disp_Interface_Chain (Inter, "", Start);
+      else
+         Disp_Interface_Chain (Inter, "", 0);
+      end if;
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            Put (" return ");
+            if Implicit then
+               Disp_Type (Get_Return_Type (Subprg));
+            else
+               Disp_Name (Get_Return_Type_Mark (Subprg));
+            end if;
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Disp_Subprogram_Declaration;
+
+   procedure Disp_Subprogram_Body (Subprg : Iir)
+   is
+      Indent : constant Count := Col;
+   begin
+      Disp_Declaration_Chain (Subprg, Indent + Indentation);
+      Set_Col (Indent);
+      Put_Line ("begin");
+      Set_Col (Indent + Indentation);
+      Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Subprg));
+      Set_Col (Indent);
+      if Get_Kind (Subprg) = Iir_Kind_Function_Body then
+         Disp_End (Subprg, "function");
+      else
+         Disp_End (Subprg, "procedure");
+      end if;
+   end Disp_Subprogram_Body;
+
+   procedure Disp_Instantiation_List (Insts: Iir_List) is
+      El : Iir;
+   begin
+      if Insts = Iir_List_All then
+         Put ("all");
+      elsif Insts = Iir_List_Others then
+         Put ("others");
+      else
+         for I in Natural loop
+            El := Get_Nth_Element (Insts, I);
+            exit when El = Null_Iir;
+            if I /= Natural'First then
+               Put (", ");
+            end if;
+            Disp_Name_Of (El);
+         end loop;
+      end if;
+   end Disp_Instantiation_List;
+
+   procedure Disp_Configuration_Specification
+     (Spec : Iir_Configuration_Specification)
+   is
+      Indent : Count;
+   begin
+      Indent := Col;
+      Put ("for ");
+      Disp_Instantiation_List (Get_Instantiation_List (Spec));
+      Put (": ");
+      Disp_Name (Get_Component_Name (Spec));
+      New_Line;
+      Disp_Binding_Indication (Get_Binding_Indication (Spec),
+                               Indent + Indentation);
+      Put_Line (";");
+   end Disp_Configuration_Specification;
+
+   procedure Disp_Disconnection_Specification
+     (Dis : Iir_Disconnection_Specification)
+   is
+   begin
+      Put ("disconnect ");
+      Disp_Instantiation_List (Get_Signal_List (Dis));
+      Put (": ");
+      Disp_Name (Get_Type_Mark (Dis));
+      Put (" after ");
+      Disp_Expression (Get_Expression (Dis));
+      Put_Line (";");
+   end Disp_Disconnection_Specification;
+
+   procedure Disp_Attribute_Declaration (Attr : Iir_Attribute_Declaration)
+   is
+   begin
+      Put ("attribute ");
+      Disp_Identifier (Attr);
+      Put (": ");
+      Disp_Name (Get_Type_Mark (Attr));
+      Put_Line (";");
+   end Disp_Attribute_Declaration;
+
+   procedure Disp_Attribute_Value (Attr : Iir) is
+   begin
+      Disp_Name_Of (Get_Designated_Entity (Attr));
+      Put ("'");
+      Disp_Identifier
+        (Get_Attribute_Designator (Get_Attribute_Specification (Attr)));
+   end Disp_Attribute_Value;
+
+   procedure Disp_Attribute_Name (Attr : Iir)
+   is
+      Sig : constant Iir := Get_Attribute_Signature (Attr);
+   begin
+      if Sig /= Null_Iir then
+         Disp_Signature (Sig);
+      else
+         Disp_Name (Get_Prefix (Attr));
+      end if;
+      Put ("'");
+      Disp_Ident (Get_Identifier (Attr));
+   end Disp_Attribute_Name;
+
+   procedure Disp_Entity_Kind (Tok : Tokens.Token_Type) is
+   begin
+      Put (Tokens.Image (Tok));
+   end Disp_Entity_Kind;
+
+   procedure Disp_Entity_Name_List (List : Iir_List)
+   is
+      El : Iir;
+   begin
+      if List = Iir_List_All then
+         Put ("all");
+      elsif List = Iir_List_Others then
+         Put ("others");
+      else
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if I /= 0 then
+               Put (", ");
+            end if;
+            if Get_Kind (El) = Iir_Kind_Signature then
+               Disp_Signature (El);
+            else
+               Disp_Name (El);
+            end if;
+         end loop;
+      end if;
+   end Disp_Entity_Name_List;
+
+   procedure Disp_Attribute_Specification (Attr : Iir_Attribute_Specification)
+   is
+   begin
+      Put ("attribute ");
+      Disp_Identifier (Get_Attribute_Designator (Attr));
+      Put (" of ");
+      Disp_Entity_Name_List (Get_Entity_Name_List (Attr));
+      Put (": ");
+      Disp_Entity_Kind (Get_Entity_Class (Attr));
+      Put (" is ");
+      Disp_Expression (Get_Expression (Attr));
+      Put_Line (";");
+   end Disp_Attribute_Specification;
+
+   procedure Disp_Protected_Type_Body
+     (Bod : Iir_Protected_Type_Body; Indent : Count)
+   is
+   begin
+      Put ("type ");
+      Disp_Identifier (Bod);
+      Put (" is protected body");
+      New_Line;
+      Disp_Declaration_Chain (Bod, Indent + Indentation);
+      Set_Col (Indent);
+      Disp_End (Bod, "protected body");
+   end Disp_Protected_Type_Body;
+
+   procedure Disp_Group_Template_Declaration (Decl : Iir)
+   is
+      use Tokens;
+      Ent : Iir;
+   begin
+      Put ("group ");
+      Disp_Identifier (Decl);
+      Put (" is (");
+      Ent := Get_Entity_Class_Entry_Chain (Decl);
+      loop
+         Disp_Entity_Kind (Get_Entity_Class (Ent));
+         Ent := Get_Chain (Ent);
+         exit when Ent = Null_Iir;
+         if Get_Entity_Class (Ent) = Tok_Box then
+            Put (" <>");
+            exit;
+         else
+            Put (", ");
+         end if;
+      end loop;
+      Put_Line (");");
+   end Disp_Group_Template_Declaration;
+
+   procedure Disp_Group_Declaration (Decl : Iir)
+   is
+      List : Iir_List;
+      El : Iir;
+   begin
+      Put ("group ");
+      Disp_Identifier (Decl);
+      Put (" : ");
+      Disp_Name (Get_Group_Template_Name (Decl));
+      Put (" (");
+      List := Get_Group_Constituent_List (Decl);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Name_Of (El);
+      end loop;
+      Put_Line (");");
+   end Disp_Group_Declaration;
+
+   procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count)
+   is
+      Decl: Iir;
+   begin
+      Decl := Get_Declaration_Chain (Parent);
+      while Decl /= Null_Iir loop
+         Set_Col (Indent);
+         case Get_Kind (Decl) is
+            when Iir_Kind_Type_Declaration =>
+               Disp_Type_Declaration (Decl);
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Disp_Anonymous_Type_Declaration (Decl);
+            when Iir_Kind_Subtype_Declaration =>
+               Disp_Subtype_Declaration (Decl);
+            when Iir_Kind_Use_Clause =>
+               Disp_Use_Clause (Decl);
+            when Iir_Kind_Component_Declaration =>
+               Disp_Component_Declaration (Decl);
+            when Iir_Kind_File_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Variable_Declaration =>
+               Disp_Object_Declaration (Decl);
+               while Get_Has_Identifier_List (Decl) loop
+                  Decl := Get_Chain (Decl);
+               end loop;
+            when Iir_Kind_Object_Alias_Declaration =>
+               Disp_Object_Alias_Declaration (Decl);
+            when Iir_Kind_Terminal_Declaration =>
+               Disp_Terminal_Declaration (Decl);
+            when Iir_Kinds_Quantity_Declaration =>
+               Disp_Quantity_Declaration (Decl);
+            when Iir_Kind_Nature_Declaration =>
+               Disp_Nature_Declaration (Decl);
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               Disp_Non_Object_Alias_Declaration (Decl);
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Disp_Subprogram_Declaration (Decl);
+               Put_Line (";");
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Disp_Subprogram_Declaration (Decl);
+               if not Get_Has_Body (Decl) then
+                  Put_Line (";");
+               end if;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               --  The declaration was just displayed.
+               Put_Line (" is");
+               Set_Col (Indent);
+               Disp_Subprogram_Body (Decl);
+            when Iir_Kind_Protected_Type_Body =>
+               Disp_Protected_Type_Body (Decl, Indent);
+            when Iir_Kind_Configuration_Specification =>
+               Disp_Configuration_Specification (Decl);
+            when Iir_Kind_Disconnection_Specification =>
+               Disp_Disconnection_Specification (Decl);
+            when Iir_Kind_Attribute_Declaration =>
+               Disp_Attribute_Declaration (Decl);
+            when Iir_Kind_Attribute_Specification =>
+               Disp_Attribute_Specification (Decl);
+            when Iir_Kinds_Signal_Attribute =>
+               null;
+            when Iir_Kind_Group_Template_Declaration =>
+               Disp_Group_Template_Declaration (Decl);
+            when Iir_Kind_Group_Declaration =>
+               Disp_Group_Declaration (Decl);
+            when others =>
+               Error_Kind ("disp_declaration_chain", Decl);
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Disp_Declaration_Chain;
+
+   procedure Disp_Waveform (Chain : Iir_Waveform_Element)
+   is
+      We: Iir_Waveform_Element;
+      Val : Iir;
+   begin
+      if Chain = Null_Iir then
+         Put ("null after {disconnection_time}");
+         return;
+      end if;
+      We := Chain;
+      while We /= Null_Iir loop
+         if We /= Chain then
+            Put (", ");
+         end if;
+         Val := Get_We_Value (We);
+         Disp_Expression (Val);
+         if Get_Time (We) /= Null_Iir then
+            Put (" after ");
+            Disp_Expression (Get_Time (We));
+         end if;
+         We := Get_Chain (We);
+      end loop;
+   end Disp_Waveform;
+
+   procedure Disp_Delay_Mechanism (Stmt: Iir) is
+      Expr: Iir;
+   begin
+      case Get_Delay_Mechanism (Stmt) is
+         when Iir_Transport_Delay =>
+            Put ("transport ");
+         when Iir_Inertial_Delay =>
+            Expr := Get_Reject_Time_Expression (Stmt);
+            if Expr /= Null_Iir then
+               Put ("reject ");
+               Disp_Expression (Expr);
+               Put (" inertial ");
+            end if;
+      end case;
+   end Disp_Delay_Mechanism;
+
+   procedure Disp_Signal_Assignment (Stmt: Iir) is
+   begin
+      Disp_Expression (Get_Target (Stmt));
+      Put (" <= ");
+      Disp_Delay_Mechanism (Stmt);
+      Disp_Waveform (Get_Waveform_Chain (Stmt));
+      Put_Line (";");
+   end Disp_Signal_Assignment;
+
+   procedure Disp_Variable_Assignment (Stmt: Iir) is
+   begin
+      Disp_Expression (Get_Target (Stmt));
+      Put (" := ");
+      Disp_Expression (Get_Expression (Stmt));
+      Put_Line (";");
+   end Disp_Variable_Assignment;
+
+   procedure Disp_Label (Stmt : Iir)
+   is
+      Label: constant Name_Id := Get_Label (Stmt);
+   begin
+      if Label /= Null_Identifier then
+         Disp_Ident (Label);
+         Put (": ");
+      end if;
+   end Disp_Label;
+
+   procedure Disp_Postponed (Stmt : Iir) is
+   begin
+      if Get_Postponed_Flag (Stmt) then
+         Put ("postponed ");
+      end if;
+   end Disp_Postponed;
+
+   procedure Disp_Concurrent_Selected_Signal_Assignment (Stmt: Iir)
+   is
+      Indent: constant Count := Col;
+      Assoc: Iir;
+      Assoc_Chain : Iir;
+   begin
+      Set_Col (Indent);
+      Disp_Label (Stmt);
+      Disp_Postponed (Stmt);
+      Put ("with ");
+      Disp_Expression (Get_Expression (Stmt));
+      Put (" select ");
+      Disp_Expression (Get_Target (Stmt));
+      Put (" <= ");
+      if Get_Guard (Stmt) /= Null_Iir then
+         Put ("guarded ");
+      end if;
+      Disp_Delay_Mechanism (Stmt);
+      Assoc_Chain := Get_Selected_Waveform_Chain (Stmt);
+      Assoc := Assoc_Chain;
+      while Assoc /= Null_Iir loop
+         if Assoc /= Assoc_Chain then
+            Put_Line (",");
+         end if;
+         Set_Col (Indent + Indentation);
+         Disp_Waveform (Get_Associated_Chain (Assoc));
+         Put (" when ");
+         Disp_Choice (Assoc);
+      end loop;
+      Put_Line (";");
+   end Disp_Concurrent_Selected_Signal_Assignment;
+
+   procedure Disp_Concurrent_Conditional_Signal_Assignment (Stmt: Iir)
+   is
+      Indent: Count;
+      Cond_Wf : Iir_Conditional_Waveform;
+      Expr : Iir;
+   begin
+      Disp_Label (Stmt);
+      Disp_Postponed (Stmt);
+      Disp_Expression (Get_Target (Stmt));
+      Put (" <= ");
+      if Get_Guard (Stmt) /= Null_Iir then
+         Put ("guarded ");
+      end if;
+      Disp_Delay_Mechanism (Stmt);
+      Indent := Col;
+      Set_Col (Indent);
+      Cond_Wf := Get_Conditional_Waveform_Chain (Stmt);
+      while Cond_Wf /= Null_Iir loop
+         Disp_Waveform (Get_Waveform_Chain (Cond_Wf));
+         Expr := Get_Condition (Cond_Wf);
+         if Expr /= Null_Iir then
+            Put (" when ");
+            Disp_Expression (Expr);
+            Put_Line (" else");
+            Set_Col (Indent);
+         end if;
+         Cond_Wf := Get_Chain (Cond_Wf);
+      end loop;
+
+      Put_Line (";");
+   end Disp_Concurrent_Conditional_Signal_Assignment;
+
+   procedure Disp_Assertion_Statement (Stmt: Iir)
+   is
+      Start: constant Count := Col;
+      Expr: Iir;
+   begin
+      if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then
+         Disp_Label (Stmt);
+         Disp_Postponed (Stmt);
+      end if;
+      Put ("assert ");
+      Disp_Expression (Get_Assertion_Condition (Stmt));
+      Expr := Get_Report_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Set_Col (Start + Indentation);
+         Put ("report ");
+         Disp_Expression (Expr);
+      end if;
+      Expr := Get_Severity_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Set_Col (Start + Indentation);
+         Put ("severity ");
+         Disp_Expression (Expr);
+      end if;
+      Put_Line (";");
+   end Disp_Assertion_Statement;
+
+   procedure Disp_Report_Statement (Stmt: Iir)
+   is
+      Start: Count;
+      Expr: Iir;
+   begin
+      Start := Col;
+      Put ("report ");
+      Expr := Get_Report_Expression (Stmt);
+      Disp_Expression (Expr);
+      Expr := Get_Severity_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Set_Col (Start + Indentation);
+         Put ("severity ");
+         Disp_Expression (Expr);
+      end if;
+      Put_Line (";");
+   end Disp_Report_Statement;
+
+   procedure Disp_Dyadic_Operator (Expr: Iir) is
+   begin
+      if Flag_Parenthesis then
+         Put ("(");
+      end if;
+      Disp_Expression (Get_Left (Expr));
+      Put (' ' & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & ' ');
+      Disp_Expression (Get_Right (Expr));
+      if Flag_Parenthesis then
+         Put (")");
+      end if;
+   end Disp_Dyadic_Operator;
+
+   procedure Disp_Monadic_Operator (Expr: Iir) is
+   begin
+      Put (Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)));
+      Put (' ');
+      if Flag_Parenthesis then
+         Put ('(');
+      end if;
+      Disp_Expression (Get_Operand (Expr));
+      if Flag_Parenthesis then
+         Put (')');
+      end if;
+   end Disp_Monadic_Operator;
+
+   procedure Disp_Case_Statement (Stmt: Iir_Case_Statement)
+   is
+      Indent: Count;
+      Assoc: Iir;
+      Sel_Stmt : Iir;
+   begin
+      Indent := Col;
+      Put ("case ");
+      Disp_Expression (Get_Expression (Stmt));
+      Put_Line (" is");
+      Assoc := Get_Case_Statement_Alternative_Chain (Stmt);
+      while Assoc /= Null_Iir loop
+         Set_Col (Indent + Indentation);
+         Put ("when ");
+         Sel_Stmt := Get_Associated_Chain (Assoc);
+         Disp_Choice (Assoc);
+         Put_Line (" =>");
+         Set_Col (Indent + 2 * Indentation);
+         Disp_Sequential_Statements (Sel_Stmt);
+      end loop;
+      Set_Col (Indent);
+      Disp_End_Label (Stmt, "case");
+   end Disp_Case_Statement;
+
+   procedure Disp_Wait_Statement (Stmt: Iir_Wait_Statement) is
+      List: Iir_List;
+      Expr: Iir;
+   begin
+      Put ("wait");
+      List := Get_Sensitivity_List (Stmt);
+      if List /= Null_Iir_List then
+         Put (" on ");
+         Disp_Designator_List (List);
+      end if;
+      Expr := Get_Condition_Clause (Stmt);
+      if Expr /= Null_Iir then
+         Put (" until ");
+         Disp_Expression (Expr);
+      end if;
+      Expr := Get_Timeout_Clause (Stmt);
+      if Expr /= Null_Iir then
+         Put (" for ");
+         Disp_Expression (Expr);
+      end if;
+      Put_Line (";");
+   end Disp_Wait_Statement;
+
+   procedure Disp_If_Statement (Stmt: Iir_If_Statement) is
+      Clause: Iir;
+      Expr: Iir;
+      Start: Count;
+   begin
+      Start := Col;
+      Put ("if ");
+      Clause := Stmt;
+      Disp_Expression (Get_Condition (Clause));
+      Put_Line (" then");
+      while Clause /= Null_Iir loop
+         Set_Col (Start + Indentation);
+         Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Clause));
+         Clause := Get_Else_Clause (Clause);
+         exit when Clause = Null_Iir;
+         Expr := Get_Condition (Clause);
+         Set_Col (Start);
+         if Expr /= Null_Iir then
+            Put ("elsif ");
+            Disp_Expression (Expr);
+            Put_Line (" then");
+         else
+            Put_Line ("else");
+         end if;
+      end loop;
+      Set_Col (Start);
+      Disp_End_Label (Stmt, "if");
+   end Disp_If_Statement;
+
+   procedure Disp_Parameter_Specification
+     (Iterator : Iir_Iterator_Declaration) is
+   begin
+      Disp_Identifier (Iterator);
+      Put (" in ");
+      Disp_Discrete_Range (Get_Discrete_Range (Iterator));
+   end Disp_Parameter_Specification;
+
+   procedure Disp_Method_Object (Call : Iir)
+   is
+      Obj : Iir;
+   begin
+      Obj := Get_Method_Object (Call);
+      if Obj /= Null_Iir then
+         Disp_Name (Obj);
+         Put ('.');
+      end if;
+   end Disp_Method_Object;
+
+   procedure Disp_Procedure_Call (Call : Iir) is
+   begin
+      if True then
+         Disp_Name (Get_Prefix (Call));
+      else
+         Disp_Method_Object (Call);
+         Disp_Identifier (Get_Implementation (Call));
+         Put (' ');
+      end if;
+      Disp_Association_Chain (Get_Parameter_Association_Chain (Call));
+      Put_Line (";");
+   end Disp_Procedure_Call;
+
+   procedure Disp_Sequential_Statements (First : Iir)
+   is
+      Stmt: Iir;
+      Start: constant Count := Col;
+   begin
+      Stmt := First;
+      while Stmt /= Null_Iir loop
+         Set_Col (Start);
+         Disp_Label (Stmt);
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Null_Statement =>
+               Put_Line ("null;");
+            when Iir_Kind_If_Statement =>
+               Disp_If_Statement (Stmt);
+            when Iir_Kind_For_Loop_Statement =>
+               Put ("for ");
+               Disp_Parameter_Specification
+                 (Get_Parameter_Specification (Stmt));
+               Put_Line (" loop");
+               Set_Col (Start + Indentation);
+               Disp_Sequential_Statements
+                 (Get_Sequential_Statement_Chain (Stmt));
+               Set_Col (Start);
+               Disp_End_Label (Stmt, "loop");
+            when Iir_Kind_While_Loop_Statement =>
+               if Get_Condition (Stmt) /= Null_Iir then
+                  Put ("while ");
+                  Disp_Expression (Get_Condition (Stmt));
+                  Put (" ");
+               end if;
+               Put_Line ("loop");
+               Set_Col (Start + Indentation);
+               Disp_Sequential_Statements
+                 (Get_Sequential_Statement_Chain (Stmt));
+               Set_Col (Start);
+               Disp_End_Label (Stmt, "loop");
+            when Iir_Kind_Signal_Assignment_Statement =>
+               Disp_Signal_Assignment (Stmt);
+            when Iir_Kind_Variable_Assignment_Statement =>
+               Disp_Variable_Assignment (Stmt);
+            when Iir_Kind_Assertion_Statement =>
+               Disp_Assertion_Statement (Stmt);
+            when Iir_Kind_Report_Statement =>
+               Disp_Report_Statement (Stmt);
+            when Iir_Kind_Return_Statement =>
+               if Get_Expression (Stmt) /= Null_Iir then
+                  Put ("return ");
+                  Disp_Expression (Get_Expression (Stmt));
+                  Put_Line (";");
+               else
+                  Put_Line ("return;");
+               end if;
+            when Iir_Kind_Case_Statement =>
+               Disp_Case_Statement (Stmt);
+            when Iir_Kind_Wait_Statement =>
+               Disp_Wait_Statement (Stmt);
+            when Iir_Kind_Procedure_Call_Statement =>
+               Disp_Procedure_Call (Get_Procedure_Call (Stmt));
+            when Iir_Kind_Exit_Statement
+              | Iir_Kind_Next_Statement =>
+               declare
+                  Label : constant Iir := Get_Loop_Label (Stmt);
+                  Cond : constant Iir := Get_Condition (Stmt);
+               begin
+                  if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then
+                     Put ("exit");
+                  else
+                     Put ("next");
+                  end if;
+                  if Label /= Null_Iir then
+                     Put (" ");
+                     Disp_Name (Label);
+                  end if;
+                  if Cond /= Null_Iir then
+                     Put (" when ");
+                     Disp_Expression (Cond);
+                  end if;
+                  Put_Line (";");
+               end;
+
+            when others =>
+               Error_Kind ("disp_sequential_statements", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Disp_Sequential_Statements;
+
+   procedure Disp_Process_Statement (Process: Iir)
+   is
+      Start: constant Count := Col;
+   begin
+      Disp_Label (Process);
+      Disp_Postponed (Process);
+
+      Put ("process ");
+      if Get_Kind (Process) = Iir_Kind_Sensitized_Process_Statement then
+         Put ("(");
+         Disp_Designator_List (Get_Sensitivity_List (Process));
+         Put (")");
+      end if;
+      if Get_Has_Is (Process) then
+         Put (" is");
+      end if;
+      New_Line;
+      Disp_Declaration_Chain (Process, Start + Indentation);
+      Set_Col (Start);
+      Put_Line ("begin");
+      Set_Col (Start + Indentation);
+      Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Process));
+      Set_Col (Start);
+      Put ("end");
+      if Get_End_Has_Postponed (Process) then
+         Put (" postponed");
+      end if;
+      Disp_After_End (Process, "process");
+   end Disp_Process_Statement;
+
+   procedure Disp_Conversion (Conv : Iir) is
+   begin
+      case Get_Kind (Conv) is
+         when Iir_Kind_Function_Call =>
+            Disp_Function_Name (Get_Implementation (Conv));
+         when Iir_Kind_Type_Conversion =>
+            Disp_Name_Of (Get_Type_Mark (Conv));
+         when others =>
+            Error_Kind ("disp_conversion", Conv);
+      end case;
+   end Disp_Conversion;
+
+   procedure Disp_Association_Chain (Chain : Iir)
+   is
+      El: Iir;
+      Formal: Iir;
+      Need_Comma : Boolean;
+      Conv : Iir;
+   begin
+      if Chain = Null_Iir then
+         return;
+      end if;
+      Put ("(");
+      Need_Comma := False;
+
+      El := Chain;
+      while El /= Null_Iir loop
+         if Get_Kind (El) /= Iir_Kind_Association_Element_By_Individual then
+            if Need_Comma then
+               Put (", ");
+            end if;
+
+            --  Formal part.
+            if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then
+               Conv := Get_Out_Conversion (El);
+               if Conv /= Null_Iir then
+                  Disp_Conversion (Conv);
+                  Put (" (");
+               end if;
+            else
+               Conv := Null_Iir;
+            end if;
+            Formal := Get_Formal (El);
+            if Formal /= Null_Iir then
+               Disp_Expression (Formal);
+               if Conv /= Null_Iir then
+                  Put (")");
+               end if;
+               Put (" => ");
+            end if;
+
+            case Get_Kind (El) is
+               when Iir_Kind_Association_Element_Open =>
+                  Put ("open");
+               when Iir_Kind_Association_Element_Package =>
+                  Disp_Name (Get_Actual (El));
+               when others =>
+                  Conv := Get_In_Conversion (El);
+                  if Conv /= Null_Iir then
+                     Disp_Conversion (Conv);
+                     Put (" (");
+                  end if;
+                  Disp_Expression (Get_Actual (El));
+                  if Conv /= Null_Iir then
+                     Put (")");
+                  end if;
+            end case;
+            Need_Comma := True;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+      Put (")");
+   end Disp_Association_Chain;
+
+   procedure Disp_Generic_Map_Aspect (Parent : Iir) is
+   begin
+      Put ("generic map ");
+      Disp_Association_Chain (Get_Generic_Map_Aspect_Chain (Parent));
+   end Disp_Generic_Map_Aspect;
+
+   procedure Disp_Port_Map_Aspect (Parent : Iir) is
+   begin
+      Put ("port map ");
+      Disp_Association_Chain (Get_Port_Map_Aspect_Chain (Parent));
+   end Disp_Port_Map_Aspect;
+
+   procedure Disp_Entity_Aspect (Aspect : Iir) is
+      Arch : Iir;
+   begin
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            Put ("entity ");
+            Disp_Name (Get_Entity_Name (Aspect));
+            Arch := Get_Architecture (Aspect);
+            if Arch /= Null_Iir then
+               Put (" (");
+               Disp_Name_Of (Arch);
+               Put (")");
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Put ("configuration ");
+            Disp_Name (Get_Configuration_Name (Aspect));
+         when Iir_Kind_Entity_Aspect_Open =>
+            Put ("open");
+         when others =>
+            Error_Kind ("disp_entity_aspect", Aspect);
+      end case;
+   end Disp_Entity_Aspect;
+
+   procedure Disp_Component_Instantiation_Statement
+     (Stmt: Iir_Component_Instantiation_Statement)
+   is
+      Component: constant Iir := Get_Instantiated_Unit (Stmt);
+      Alist: Iir;
+   begin
+      Disp_Label (Stmt);
+      if Get_Kind (Component) in Iir_Kinds_Denoting_Name then
+         Disp_Name (Component);
+      else
+         Disp_Entity_Aspect (Component);
+      end if;
+      Alist := Get_Generic_Map_Aspect_Chain (Stmt);
+      if Alist /= Null_Iir then
+         Put (" ");
+         Disp_Generic_Map_Aspect (Stmt);
+      end if;
+      Alist := Get_Port_Map_Aspect_Chain (Stmt);
+      if Alist /= Null_Iir then
+         Put (" ");
+         Disp_Port_Map_Aspect (Stmt);
+      end if;
+      Put (";");
+   end Disp_Component_Instantiation_Statement;
+
+   procedure Disp_Function_Call (Expr: Iir_Function_Call) is
+   begin
+      if True then
+         Disp_Name (Get_Prefix (Expr));
+      else
+         Disp_Method_Object (Expr);
+         Disp_Function_Name (Get_Implementation (Expr));
+      end if;
+      Disp_Association_Chain (Get_Parameter_Association_Chain (Expr));
+   end Disp_Function_Call;
+
+   procedure Disp_Indexed_Name (Indexed: Iir)
+   is
+      List : Iir_List;
+      El: Iir;
+   begin
+      Disp_Expression (Get_Prefix (Indexed));
+      Put (" (");
+      List := Get_Index_List (Indexed);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Expression (El);
+      end loop;
+      Put (")");
+   end Disp_Indexed_Name;
+
+   procedure Disp_Choice (Choice: in out Iir) is
+   begin
+      loop
+         case Get_Kind (Choice) is
+            when Iir_Kind_Choice_By_Others =>
+               Put ("others");
+            when Iir_Kind_Choice_By_None =>
+               null;
+            when Iir_Kind_Choice_By_Expression =>
+               Disp_Expression (Get_Choice_Expression (Choice));
+            when Iir_Kind_Choice_By_Range =>
+               Disp_Range (Get_Choice_Range (Choice));
+            when Iir_Kind_Choice_By_Name =>
+               Disp_Name_Of (Get_Choice_Name (Choice));
+            when others =>
+               Error_Kind ("disp_choice", Choice);
+         end case;
+         Choice := Get_Chain (Choice);
+         exit when Choice = Null_Iir;
+         exit when Get_Same_Alternative_Flag (Choice) = False;
+         --exit when Choice = Null_Iir;
+         Put (" | ");
+      end loop;
+   end Disp_Choice;
+
+   procedure Disp_Aggregate (Aggr: Iir_Aggregate)
+   is
+      Indent: Count;
+      Assoc: Iir;
+      Expr : Iir;
+   begin
+      Indent := Col;
+      if Indent > Line_Length - 10 then
+         Indent := 2 * Indentation;
+      end if;
+      Put ("(");
+      Assoc := Get_Association_Choices_Chain (Aggr);
+      loop
+         Expr := Get_Associated_Expr (Assoc);
+         if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then
+            Disp_Choice (Assoc);
+            Put (" => ");
+         else
+            Assoc := Get_Chain (Assoc);
+         end if;
+         if Get_Kind (Expr) = Iir_Kind_Aggregate
+           or else Get_Kind (Expr) = Iir_Kind_String_Literal then
+            Set_Col (Indent);
+         end if;
+         Disp_Expression (Expr);
+         exit when Assoc = Null_Iir;
+         Put (", ");
+      end loop;
+      Put (")");
+   end Disp_Aggregate;
+
+   procedure Disp_Simple_Aggregate (Aggr: Iir_Simple_Aggregate)
+   is
+      List : Iir_List;
+      El : Iir;
+      First : Boolean := True;
+   begin
+      Put ("(");
+      List := Get_Simple_Aggregate_List (Aggr);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if First then
+            First := False;
+         else
+            Put (", ");
+         end if;
+         Disp_Expression (El);
+      end loop;
+      Put (")");
+   end Disp_Simple_Aggregate;
+
+   procedure Disp_Parametered_Attribute (Name : String; Expr : Iir)
+   is
+      Param : Iir;
+      Pfx : Iir;
+   begin
+      Pfx := Get_Prefix (Expr);
+      case Get_Kind (Pfx) is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            Disp_Name_Of (Pfx);
+         when others =>
+            Disp_Expression (Pfx);
+      end case;
+      Put ("'");
+      Put (Name);
+      Param := Get_Parameter (Expr);
+      if Param /= Null_Iir
+        and then Param /= Std_Package.Universal_Integer_One
+      then
+         Put (" (");
+         Disp_Expression (Param);
+         Put (")");
+      end if;
+   end Disp_Parametered_Attribute;
+
+   procedure Disp_Parametered_Type_Attribute (Name : String; Expr : Iir) is
+   begin
+      Disp_Name (Get_Prefix (Expr));
+      Put ("'");
+      Put (Name);
+      Put (" (");
+      Disp_Expression (Get_Parameter (Expr));
+      Put (")");
+   end Disp_Parametered_Type_Attribute;
+
+   procedure Disp_String_Literal (Str : Iir)
+   is
+      Ptr : constant String_Fat_Acc := Get_String_Fat_Acc (Str);
+      Len : constant Int32 := Get_String_Length (Str);
+   begin
+      for I in 1 .. Len loop
+         if Ptr (I) = '"' then
+            Put ('"');
+         end if;
+         Put (Ptr (I));
+      end loop;
+   end Disp_String_Literal;
+
+   procedure Disp_Expression (Expr: Iir)
+   is
+      Orig : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Integer_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Disp_Int64 (Get_Value (Expr));
+            end if;
+         when Iir_Kind_Floating_Point_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Disp_Fp64 (Get_Fp_Value (Expr));
+            end if;
+         when Iir_Kind_String_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Put ("""");
+               Disp_String_Literal (Expr);
+               Put ("""");
+               if Disp_String_Literal_Type or Flags.List_Verbose then
+                  Put ("[type: ");
+                  Disp_Type (Get_Type (Expr));
+                  Put ("]");
+               end if;
+            end if;
+         when Iir_Kind_Bit_String_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               if False then
+                  case Get_Bit_String_Base (Expr) is
+                     when Base_2 =>
+                        Put ('B');
+                     when Base_8 =>
+                        Put ('O');
+                     when Base_16 =>
+                        Put ('X');
+                  end case;
+               end if;
+               Put ("B""");
+               Disp_String_Literal (Expr);
+               Put ("""");
+            end if;
+         when Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Physical_Int_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Disp_Physical_Literal (Expr);
+            end if;
+         when Iir_Kind_Unit_Declaration =>
+            Disp_Name_Of (Expr);
+         when Iir_Kind_Character_Literal =>
+            Disp_Identifier (Expr);
+         when Iir_Kind_Enumeration_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Disp_Name_Of (Expr);
+            end if;
+         when Iir_Kind_Overflow_Literal =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Put ("*OVERFLOW*");
+            end if;
+
+         when Iir_Kind_Object_Alias_Declaration =>
+            Disp_Name_Of (Expr);
+         when Iir_Kind_Aggregate =>
+            Disp_Aggregate (Expr);
+         when Iir_Kind_Null_Literal =>
+            Put ("null");
+         when Iir_Kind_Simple_Aggregate =>
+            Orig := Get_Literal_Origin (Expr);
+            if Orig /= Null_Iir then
+               Disp_Expression (Orig);
+            else
+               Disp_Simple_Aggregate (Expr);
+            end if;
+
+         when Iir_Kind_Attribute_Value =>
+            Disp_Attribute_Value (Expr);
+         when Iir_Kind_Attribute_Name =>
+            Disp_Attribute_Name (Expr);
+
+         when Iir_Kind_Element_Declaration =>
+            Disp_Name_Of (Expr);
+
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Iterator_Declaration =>
+            Disp_Name_Of (Expr);
+            return;
+
+         when Iir_Kinds_Dyadic_Operator =>
+            Disp_Dyadic_Operator (Expr);
+         when Iir_Kinds_Monadic_Operator =>
+            Disp_Monadic_Operator (Expr);
+         when Iir_Kind_Function_Call =>
+            Disp_Function_Call (Expr);
+         when Iir_Kind_Parenthesis_Expression =>
+            Put ("(");
+            Disp_Expression (Get_Expression (Expr));
+            Put (")");
+         when Iir_Kind_Type_Conversion =>
+            Disp_Name (Get_Type_Mark (Expr));
+            Put (" (");
+            Disp_Expression (Get_Expression (Expr));
+            Put (")");
+         when Iir_Kind_Qualified_Expression =>
+            declare
+               Qexpr : constant Iir := Get_Expression (Expr);
+               Has_Paren : constant Boolean :=
+                 Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression
+                 or else Get_Kind (Qexpr) = Iir_Kind_Aggregate;
+            begin
+               Disp_Name (Get_Type_Mark (Expr));
+               Put ("'");
+               if not Has_Paren then
+                  Put ("(");
+               end if;
+               Disp_Expression (Qexpr);
+               if not Has_Paren then
+                  Put (")");
+               end if;
+            end;
+         when Iir_Kind_Allocator_By_Expression =>
+            Put ("new ");
+            Disp_Expression (Get_Expression (Expr));
+         when Iir_Kind_Allocator_By_Subtype =>
+            Put ("new ");
+            Disp_Subtype_Indication (Get_Subtype_Indication (Expr));
+
+         when Iir_Kind_Indexed_Name =>
+            Disp_Indexed_Name (Expr);
+         when Iir_Kind_Slice_Name =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put (" (");
+            Disp_Range (Get_Suffix (Expr));
+            Put (")");
+         when Iir_Kind_Selected_Element =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put (".");
+            Disp_Name_Of (Get_Selected_Element (Expr));
+         when Iir_Kind_Implicit_Dereference =>
+            Disp_Expression (Get_Prefix (Expr));
+         when Iir_Kind_Dereference =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put (".all");
+
+         when Iir_Kind_Left_Type_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'left");
+         when Iir_Kind_Right_Type_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'right");
+         when Iir_Kind_High_Type_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'high");
+         when Iir_Kind_Low_Type_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'low");
+         when Iir_Kind_Ascending_Type_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'ascending");
+
+         when Iir_Kind_Stable_Attribute =>
+            Disp_Parametered_Attribute ("stable", Expr);
+         when Iir_Kind_Quiet_Attribute =>
+            Disp_Parametered_Attribute ("quiet", Expr);
+         when Iir_Kind_Delayed_Attribute =>
+            Disp_Parametered_Attribute ("delayed", Expr);
+         when Iir_Kind_Transaction_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'transaction");
+         when Iir_Kind_Event_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'event");
+         when Iir_Kind_Active_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'active");
+         when Iir_Kind_Driving_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'driving");
+         when Iir_Kind_Driving_Value_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'driving_value");
+         when Iir_Kind_Last_Value_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'last_value");
+         when Iir_Kind_Last_Active_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'last_active");
+         when Iir_Kind_Last_Event_Attribute =>
+            Disp_Expression (Get_Prefix (Expr));
+            Put ("'last_event");
+
+         when Iir_Kind_Pos_Attribute =>
+            Disp_Parametered_Type_Attribute ("pos", Expr);
+         when Iir_Kind_Val_Attribute =>
+            Disp_Parametered_Type_Attribute ("val", Expr);
+         when Iir_Kind_Succ_Attribute =>
+            Disp_Parametered_Type_Attribute ("succ", Expr);
+         when Iir_Kind_Pred_Attribute =>
+            Disp_Parametered_Type_Attribute ("pred", Expr);
+         when Iir_Kind_Leftof_Attribute =>
+            Disp_Parametered_Type_Attribute ("leftof", Expr);
+         when Iir_Kind_Rightof_Attribute =>
+            Disp_Parametered_Type_Attribute ("rightof", Expr);
+
+         when Iir_Kind_Length_Array_Attribute =>
+            Disp_Parametered_Attribute ("length", Expr);
+         when Iir_Kind_Range_Array_Attribute =>
+            Disp_Parametered_Attribute ("range", Expr);
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            Disp_Parametered_Attribute ("reverse_range", Expr);
+         when Iir_Kind_Left_Array_Attribute =>
+            Disp_Parametered_Attribute ("left", Expr);
+         when Iir_Kind_Right_Array_Attribute =>
+            Disp_Parametered_Attribute ("right", Expr);
+         when Iir_Kind_Low_Array_Attribute =>
+            Disp_Parametered_Attribute ("low", Expr);
+         when Iir_Kind_High_Array_Attribute =>
+            Disp_Parametered_Attribute ("high", Expr);
+         when Iir_Kind_Ascending_Array_Attribute =>
+            Disp_Parametered_Attribute ("ascending", Expr);
+
+         when Iir_Kind_Image_Attribute =>
+            Disp_Parametered_Attribute ("image", Expr);
+         when Iir_Kind_Value_Attribute =>
+            Disp_Parametered_Attribute ("value", Expr);
+         when Iir_Kind_Simple_Name_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'simple_name");
+         when Iir_Kind_Instance_Name_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'instance_name");
+         when Iir_Kind_Path_Name_Attribute =>
+            Disp_Name (Get_Prefix (Expr));
+            Put ("'path_name");
+
+         when Iir_Kind_Selected_By_All_Name =>
+            Disp_Expression (Get_Prefix (Expr));
+         when Iir_Kind_Selected_Name =>
+            Disp_Name (Expr);
+         when Iir_Kind_Simple_Name =>
+            Disp_Name (Expr);
+
+         when Iir_Kinds_Type_And_Subtype_Definition =>
+            Disp_Type (Expr);
+
+         when Iir_Kind_Range_Expression =>
+            Disp_Range (Expr);
+         when Iir_Kind_Subtype_Declaration =>
+            Disp_Name_Of (Expr);
+
+         when others =>
+            Error_Kind ("disp_expression", Expr);
+      end case;
+   end Disp_Expression;
+
+   procedure Disp_PSL_HDL_Expr (N : PSL.Nodes.HDL_Node) is
+   begin
+      Disp_Expression (Iir (N));
+   end Disp_PSL_HDL_Expr;
+
+   procedure Disp_Psl_Expression (Expr : PSL_Node) is
+   begin
+      PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access;
+      PSL.Prints.Print_Property (Expr);
+   end Disp_Psl_Expression;
+
+   procedure Disp_Block_Header (Header : Iir_Block_Header; Indent: Count)
+   is
+      Chain : Iir;
+   begin
+      if Header = Null_Iir then
+         return;
+      end if;
+      Chain := Get_Generic_Chain (Header);
+      if Chain /= Null_Iir then
+         Set_Col (Indent + Indentation);
+         Disp_Generics (Header);
+         Chain := Get_Generic_Map_Aspect_Chain (Header);
+         if Chain /= Null_Iir then
+            Set_Col (Indent + Indentation);
+            Disp_Generic_Map_Aspect (Header);
+            Put_Line (";");
+         end if;
+      end if;
+      Chain := Get_Port_Chain (Header);
+      if Chain /= Null_Iir then
+         Set_Col (Indent + Indentation);
+         Disp_Ports (Header);
+         Chain := Get_Port_Map_Aspect_Chain (Header);
+         if Chain /= Null_Iir then
+            Set_Col (Indent + Indentation);
+            Disp_Port_Map_Aspect (Header);
+            Put_Line (";");
+         end if;
+      end if;
+   end Disp_Block_Header;
+
+   procedure Disp_Block_Statement (Block: Iir_Block_Statement)
+   is
+      Indent: Count;
+      Sensitivity: Iir_List;
+      Guard : Iir_Guard_Signal_Declaration;
+   begin
+      Indent := Col;
+      Disp_Label (Block);
+      Put ("block");
+      Guard := Get_Guard_Decl (Block);
+      if Guard /= Null_Iir then
+         Put (" (");
+         Disp_Expression (Get_Guard_Expression (Guard));
+         Put_Line (")");
+         Sensitivity := Get_Guard_Sensitivity_List (Guard);
+         if Sensitivity /= Null_Iir_List then
+            Set_Col (Indent + Indentation);
+            Put ("-- guard sensitivity list ");
+            Disp_Designator_List (Sensitivity);
+         end if;
+      else
+         New_Line;
+      end if;
+      Disp_Block_Header (Get_Block_Header (Block),
+                         Indent + Indentation);
+      Disp_Declaration_Chain (Block, Indent + Indentation);
+      Set_Col (Indent);
+      Put_Line ("begin");
+      Disp_Concurrent_Statement_Chain (Block, Indent + Indentation);
+      Set_Col (Indent);
+      Disp_End (Block, "block");
+   end Disp_Block_Statement;
+
+   procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement)
+   is
+      Indent : Count;
+      Scheme : Iir;
+   begin
+      Indent := Col;
+      Disp_Label (Stmt);
+      Scheme := Get_Generation_Scheme (Stmt);
+      case Get_Kind (Scheme) is
+         when Iir_Kind_Iterator_Declaration =>
+            Put ("for ");
+            Disp_Parameter_Specification (Scheme);
+         when others =>
+            Put ("if ");
+            Disp_Expression (Scheme);
+      end case;
+      Put_Line (" generate");
+      Disp_Declaration_Chain (Stmt, Indent);
+      if Get_Has_Begin (Stmt) then
+         Set_Col (Indent);
+         Put_Line ("begin");
+      end if;
+      Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation);
+      Set_Col (Indent);
+      Disp_End (Stmt, "generate");
+   end Disp_Generate_Statement;
+
+   procedure Disp_Psl_Default_Clock (Stmt : Iir) is
+   begin
+      Put ("--psl default clock is ");
+      Disp_Psl_Expression (Get_Psl_Boolean (Stmt));
+      Put_Line (";");
+   end Disp_Psl_Default_Clock;
+
+   procedure Disp_PSL_NFA (N : PSL.Nodes.NFA)
+   is
+      use PSL.NFAs;
+      use PSL.Nodes;
+
+      procedure Disp_State (S : NFA_State) is
+         Str : constant String := Int32'Image (Get_State_Label (S));
+      begin
+         Put (Str (2 .. Str'Last));
+      end Disp_State;
+
+      S : NFA_State;
+      E : NFA_Edge;
+   begin
+      if N /= No_NFA then
+         S := Get_First_State (N);
+         while S /= No_State loop
+            E := Get_First_Src_Edge (S);
+            while E /= No_Edge loop
+               Put ("-- ");
+               Disp_State (S);
+               Put (" -> ");
+               Disp_State (Get_Edge_Dest (E));
+               Put (": ");
+               Disp_Psl_Expression (Get_Edge_Expr (E));
+               New_Line;
+               E := Get_Next_Src_Edge (E);
+            end loop;
+            S := Get_Next_State (S);
+         end loop;
+      end if;
+   end Disp_PSL_NFA;
+
+   procedure Disp_Psl_Assert_Statement (Stmt : Iir) is
+   begin
+      Put ("--psl assert ");
+      Disp_Psl_Expression (Get_Psl_Property (Stmt));
+      Put_Line (";");
+      Disp_PSL_NFA (Get_PSL_NFA (Stmt));
+   end Disp_Psl_Assert_Statement;
+
+   procedure Disp_Psl_Cover_Statement (Stmt : Iir) is
+   begin
+      Put ("--psl cover ");
+      Disp_Psl_Expression (Get_Psl_Property (Stmt));
+      Put_Line (";");
+      Disp_PSL_NFA (Get_PSL_NFA (Stmt));
+   end Disp_Psl_Cover_Statement;
+
+   procedure Disp_Simple_Simultaneous_Statement (Stmt : Iir)
+   is
+   begin
+      Disp_Label (Stmt);
+      Disp_Expression (Get_Simultaneous_Left (Stmt));
+      Put (" == ");
+      Disp_Expression (Get_Simultaneous_Right (Stmt));
+      Put_Line (";");
+   end Disp_Simple_Simultaneous_Statement;
+
+   procedure Disp_Concurrent_Statement (Stmt: Iir) is
+   begin
+      case Get_Kind (Stmt) is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            Disp_Concurrent_Conditional_Signal_Assignment (Stmt);
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            Disp_Concurrent_Selected_Signal_Assignment (Stmt);
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            Disp_Process_Statement (Stmt);
+         when Iir_Kind_Concurrent_Assertion_Statement =>
+            Disp_Assertion_Statement (Stmt);
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Disp_Component_Instantiation_Statement (Stmt);
+         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            Disp_Label (Stmt);
+            Disp_Postponed (Stmt);
+            Disp_Procedure_Call (Get_Procedure_Call (Stmt));
+         when Iir_Kind_Block_Statement =>
+            Disp_Block_Statement (Stmt);
+         when Iir_Kind_Generate_Statement =>
+            Disp_Generate_Statement (Stmt);
+         when Iir_Kind_Psl_Default_Clock =>
+            Disp_Psl_Default_Clock (Stmt);
+         when Iir_Kind_Psl_Assert_Statement =>
+            Disp_Psl_Assert_Statement (Stmt);
+         when Iir_Kind_Psl_Cover_Statement =>
+            Disp_Psl_Cover_Statement (Stmt);
+         when Iir_Kind_Simple_Simultaneous_Statement =>
+            Disp_Simple_Simultaneous_Statement (Stmt);
+         when others =>
+            Error_Kind ("disp_concurrent_statement", Stmt);
+      end case;
+   end Disp_Concurrent_Statement;
+
+   procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration)
+   is
+      Header : constant Iir := Get_Package_Header (Decl);
+   begin
+      Put ("package ");
+      Disp_Identifier (Decl);
+      Put_Line (" is");
+      if Header /= Null_Iir then
+         Disp_Generics (Header);
+         New_Line;
+      end if;
+      Disp_Declaration_Chain (Decl, Col + Indentation);
+      Disp_End (Decl, "package");
+   end Disp_Package_Declaration;
+
+   procedure Disp_Package_Body (Decl: Iir)
+   is
+   begin
+      Put ("package body ");
+      Disp_Identifier (Decl);
+      Put_Line (" is");
+      Disp_Declaration_Chain (Decl, Col + Indentation);
+      Disp_End (Decl, "package body");
+   end Disp_Package_Body;
+
+   procedure Disp_Package_Instantiation_Declaration (Decl: Iir) is
+   begin
+      Put ("package ");
+      Disp_Identifier (Decl);
+      Put_Line (" is new ");
+      Disp_Name (Get_Uninstantiated_Package_Name (Decl));
+      Put (" ");
+      Disp_Generic_Map_Aspect (Decl);
+      Put_Line (";");
+   end Disp_Package_Instantiation_Declaration;
+
+   procedure Disp_Binding_Indication (Bind : Iir; Indent : Count)
+   is
+      El : Iir;
+   begin
+      El := Get_Entity_Aspect (Bind);
+      if El /= Null_Iir then
+         Set_Col (Indent);
+         Put ("use ");
+         Disp_Entity_Aspect (El);
+      end if;
+      El := Get_Generic_Map_Aspect_Chain (Bind);
+      if El /= Null_Iir then
+         Set_Col (Indent);
+         Disp_Generic_Map_Aspect (Bind);
+      end if;
+      El := Get_Port_Map_Aspect_Chain (Bind);
+      if El /= Null_Iir then
+         Set_Col (Indent);
+         Disp_Port_Map_Aspect (Bind);
+      end if;
+   end Disp_Binding_Indication;
+
+   procedure Disp_Component_Configuration
+     (Conf : Iir_Component_Configuration; Indent : Count)
+   is
+      Block : Iir_Block_Configuration;
+      Binding : Iir;
+   begin
+      Set_Col (Indent);
+      Put ("for ");
+      Disp_Instantiation_List (Get_Instantiation_List (Conf));
+      Put (" : ");
+      Disp_Name_Of (Get_Component_Name (Conf));
+      New_Line;
+      Binding := Get_Binding_Indication (Conf);
+      if Binding /= Null_Iir then
+         Disp_Binding_Indication (Binding, Indent + Indentation);
+         Put (";");
+      end if;
+      Block := Get_Block_Configuration (Conf);
+      if Block /= Null_Iir then
+         Disp_Block_Configuration (Block, Indent + Indentation);
+      end if;
+      Set_Col (Indent);
+      Put_Line ("end for;");
+   end Disp_Component_Configuration;
+
+   procedure Disp_Configuration_Items
+     (Conf : Iir_Block_Configuration; Indent : Count)
+   is
+      El : Iir;
+   begin
+      El := Get_Configuration_Item_Chain (Conf);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Block_Configuration =>
+               Disp_Block_Configuration (El, Indent);
+            when Iir_Kind_Component_Configuration =>
+               Disp_Component_Configuration (El, Indent);
+            when Iir_Kind_Configuration_Specification =>
+               --  This may be created by canon.
+               Set_Col (Indent);
+               Disp_Configuration_Specification (El);
+               Set_Col (Indent);
+               Put_Line ("end for;");
+            when others =>
+               Error_Kind ("disp_configuration_item_list", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Configuration_Items;
+
+   procedure Disp_Block_Configuration
+     (Block: Iir_Block_Configuration; Indent: Count)
+   is
+      Spec : Iir;
+   begin
+      Set_Col (Indent);
+      Put ("for ");
+      Spec := Get_Block_Specification (Block);
+      case Get_Kind (Spec) is
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Architecture_Body =>
+            Disp_Name_Of (Spec);
+         when Iir_Kind_Indexed_Name =>
+            declare
+               Index_List : constant Iir_List := Get_Index_List (Spec);
+            begin
+               Disp_Name_Of (Get_Prefix (Spec));
+               Put (" (");
+               if Index_List = Iir_List_Others then
+                  Put ("others");
+               else
+                  Disp_Expression (Get_First_Element (Index_List));
+               end if;
+               Put (")");
+            end;
+         when Iir_Kind_Slice_Name =>
+            Disp_Name_Of (Get_Prefix (Spec));
+            Put (" (");
+            Disp_Range (Get_Suffix (Spec));
+            Put (")");
+         when Iir_Kind_Simple_Name =>
+            Disp_Name (Spec);
+         when others =>
+            Error_Kind ("disp_block_configuration", Spec);
+      end case;
+      New_Line;
+      Disp_Declaration_Chain (Block, Indent + Indentation);
+      Disp_Configuration_Items (Block, Indent + Indentation);
+      Set_Col (Indent);
+      Put_Line ("end for;");
+   end Disp_Block_Configuration;
+
+   procedure Disp_Configuration_Declaration
+     (Decl: Iir_Configuration_Declaration)
+   is
+   begin
+      Put ("configuration ");
+      Disp_Name_Of (Decl);
+      Put (" of ");
+      Disp_Name (Get_Entity_Name (Decl));
+      Put_Line (" is");
+      Disp_Declaration_Chain (Decl, Col);
+      Disp_Block_Configuration (Get_Block_Configuration (Decl),
+                                Col + Indentation);
+      Disp_End (Decl, "configuration");
+   end Disp_Configuration_Declaration;
+
+   procedure Disp_Design_Unit (Unit: Iir_Design_Unit)
+   is
+      Indent: constant Count := Col;
+      Decl: Iir;
+      Next_Decl : Iir;
+   begin
+      Decl := Get_Context_Items (Unit);
+      while Decl /= Null_Iir loop
+         Next_Decl := Get_Chain (Decl);
+
+         Set_Col (Indent);
+         case Get_Kind (Decl) is
+            when Iir_Kind_Use_Clause =>
+               Disp_Use_Clause (Decl);
+            when Iir_Kind_Library_Clause =>
+               Put ("library ");
+               Disp_Identifier (Decl);
+               while Get_Has_Identifier_List (Decl) loop
+                  Decl := Next_Decl;
+                  Next_Decl := Get_Chain (Decl);
+                  Put (", ");
+                  Disp_Identifier (Decl);
+               end loop;
+               Put_Line (";");
+            when others =>
+               Error_Kind ("disp_design_unit1", Decl);
+         end case;
+         Decl := Next_Decl;
+      end loop;
+
+      Decl := Get_Library_Unit (Unit);
+      Set_Col (Indent);
+      case Get_Kind (Decl) is
+         when Iir_Kind_Entity_Declaration =>
+            Disp_Entity_Declaration (Decl);
+         when Iir_Kind_Architecture_Body =>
+            Disp_Architecture_Body (Decl);
+         when Iir_Kind_Package_Declaration =>
+            Disp_Package_Declaration (Decl);
+         when Iir_Kind_Package_Body =>
+            Disp_Package_Body (Decl);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Disp_Package_Instantiation_Declaration (Decl);
+         when Iir_Kind_Configuration_Declaration =>
+            Disp_Configuration_Declaration (Decl);
+         when others =>
+            Error_Kind ("disp_design_unit2", Decl);
+      end case;
+      New_Line;
+      New_Line;
+   end Disp_Design_Unit;
+
+   procedure Disp_Vhdl (An_Iir: Iir) is
+   begin
+      -- Put (Count'Image (Line_Length));
+      case Get_Kind (An_Iir) is
+         when Iir_Kind_Design_Unit =>
+            Disp_Design_Unit (An_Iir);
+         when Iir_Kind_Character_Literal =>
+            Disp_Character_Literal (An_Iir);
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Disp_Enumeration_Type_Definition (An_Iir);
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            Disp_Enumeration_Subtype_Definition (An_Iir);
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            Disp_Concurrent_Conditional_Signal_Assignment (An_Iir);
+         when Iir_Kinds_Dyadic_Operator =>
+            Disp_Dyadic_Operator (An_Iir);
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            Disp_Name_Of (An_Iir);
+         when Iir_Kind_Enumeration_Literal =>
+            Disp_Identifier (An_Iir);
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Disp_Component_Instantiation_Statement (An_Iir);
+         when Iir_Kind_Integer_Subtype_Definition =>
+            Disp_Integer_Subtype_Definition (An_Iir);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Disp_Array_Subtype_Definition (An_Iir);
+         when Iir_Kind_Array_Type_Definition =>
+            Disp_Array_Type_Definition (An_Iir);
+         when Iir_Kind_Package_Declaration =>
+            Disp_Package_Declaration (An_Iir);
+         when Iir_Kind_Wait_Statement =>
+            Disp_Wait_Statement (An_Iir);
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name =>
+            Disp_Expression (An_Iir);
+         when others =>
+            Error_Kind ("disp", An_Iir);
+      end case;
+   end Disp_Vhdl;
+
+   procedure Disp_Int64 (Val: Iir_Int64)
+   is
+      Str: constant String := Iir_Int64'Image (Val);
+   begin
+      if Str(Str'First) = ' ' then
+         Put (Str (Str'First + 1 .. Str'Last));
+      else
+         Put (Str);
+      end if;
+   end Disp_Int64;
+
+   procedure Disp_Int32 (Val: Iir_Int32)
+   is
+      Str: constant String := Iir_Int32'Image (Val);
+   begin
+      if Str(Str'First) = ' ' then
+         Put (Str (Str'First + 1 .. Str'Last));
+      else
+         Put (Str);
+      end if;
+   end Disp_Int32;
+
+   procedure Disp_Fp64 (Val: Iir_Fp64)
+   is
+      Str: constant String := Iir_Fp64'Image (Val);
+   begin
+      if Str(Str'First) = ' ' then
+         Put (Str (Str'First + 1 .. Str'Last));
+      else
+         Put (Str);
+      end if;
+   end Disp_Fp64;
+end Disp_Vhdl;
diff --git a/src/disp_vhdl.ads b/src/disp_vhdl.ads
new file mode 100644
index 000000000..880290efd
--- /dev/null
+++ b/src/disp_vhdl.ads
@@ -0,0 +1,38 @@
+--  VHDL regeneration from internal nodes.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Disp_Vhdl is
+   -- General procedure to display a node.
+   -- Mainly used to dispatch to other functions according to the kind of
+   -- the node.
+   procedure Disp_Vhdl (An_Iir: Iir);
+
+   procedure Disp_Expression (Expr: Iir);
+   --  Display an expression.
+
+   -- Disp an iir_int64, without the leading blank.
+   procedure Disp_Int64 (Val: Iir_Int64);
+
+   -- Disp an iir_int32, without the leading blank.
+   procedure Disp_Int32 (Val: Iir_Int32);
+
+   -- Disp an iir_Fp64, without the leading blank.
+   procedure Disp_Fp64 (Val: Iir_Fp64);
+end Disp_Vhdl;
diff --git a/src/errorout.adb b/src/errorout.adb
new file mode 100644
index 000000000..1652bb43e
--- /dev/null
+++ b/src/errorout.adb
@@ -0,0 +1,1113 @@
+--  Error message handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with Ada.Command_Line;
+with Scanner;
+with Tokens; use Tokens;
+with Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Files_Map; use Files_Map;
+with Ada.Strings.Unbounded;
+with Std_Names;
+with Flags;
+with PSL.Nodes;
+
+package body Errorout is
+   procedure Put (Str : String)
+   is
+      use Ada.Text_IO;
+   begin
+      Put (Standard_Error, Str);
+   end Put;
+
+   procedure Put (C : Character)
+   is
+      use Ada.Text_IO;
+   begin
+      Put (Standard_Error, C);
+   end Put;
+
+   procedure Put_Line (Str : String)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line (Standard_Error, Str);
+   end Put_Line;
+
+   procedure Disp_Natural (Val: Natural)
+   is
+      Str: constant String := Natural'Image (Val);
+   begin
+      Put (Str(Str'First + 1 .. Str'Last));
+   end Disp_Natural;
+
+   procedure Error_Msg (Msg: String) is
+   begin
+      Put (Ada.Command_Line.Command_Name);
+      Put (": ");
+      Put_Line (Msg);
+   end Error_Msg;
+
+   procedure Error_Kind (Msg : String; An_Iir : Iir) is
+   begin
+      Put_Line (Msg & ": cannot handle "
+                & Iir_Kind'Image (Get_Kind (An_Iir))
+                & " (" & Disp_Location (An_Iir) & ')');
+      raise Internal_Error;
+   end Error_Kind;
+
+   procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is
+   begin
+      Put_Line (Msg & ": cannot handle "
+                & Iir_Predefined_Functions'Image (Def));
+      raise Internal_Error;
+   end Error_Kind;
+
+   procedure Error_Kind (Msg : String; N : PSL_Node) is
+   begin
+      Put (Msg);
+      Put (": cannot handle ");
+      Put_Line (PSL.Nodes.Nkind'Image (PSL.Nodes.Get_Kind (N)));
+      raise Internal_Error;
+   end Error_Kind;
+
+   procedure Error_Msg_Option_NR (Msg: String) is
+   begin
+      Put (Ada.Command_Line.Command_Name);
+      Put (": ");
+      Put_Line (Msg);
+   end Error_Msg_Option_NR;
+
+   procedure Error_Msg_Option (Msg: String) is
+   begin
+      Error_Msg_Option_NR (Msg);
+      raise Option_Error;
+   end Error_Msg_Option;
+
+   procedure Disp_Location
+     (File: Name_Id; Line: Natural; Col: Natural) is
+   begin
+      Put (Name_Table.Image (File));
+      Put (':');
+      Disp_Natural (Line);
+      Put (':');
+      Disp_Natural (Col);
+      Put (':');
+   end Disp_Location;
+
+   procedure Disp_Current_Location is
+   begin
+      Disp_Location (Scanner.Get_Current_File,
+                     Scanner.Get_Current_Line,
+                     Scanner.Get_Current_Column);
+   end Disp_Current_Location;
+
+   procedure Disp_Token_Location is
+   begin
+      Disp_Location (Scanner.Get_Current_File,
+                     Scanner.Get_Current_Line,
+                     Scanner.Get_Token_Column);
+   end Disp_Token_Location;
+
+   procedure Disp_Location (Loc : Location_Type)
+   is
+      Name : Name_Id;
+      Line : Natural;
+      Col : Natural;
+   begin
+      if Loc = Location_Nil then
+         --  Avoid a crash, but should not happen.
+         Put ("??:??:??:");
+      else
+         Location_To_Position (Loc, Name, Line, Col);
+         Disp_Location (Name, Line, Col);
+      end if;
+   end Disp_Location;
+
+   function Get_Location_Safe (N : Iir) return Location_Type is
+   begin
+      if N = Null_Iir then
+         return Location_Nil;
+      else
+         return Get_Location (N);
+      end if;
+   end Get_Location_Safe;
+
+   procedure Disp_Iir_Location (An_Iir: Iir) is
+   begin
+      Disp_Location (Get_Location_Safe (An_Iir));
+   end Disp_Iir_Location;
+
+   procedure Disp_PSL_Location (N : PSL_Node) is
+   begin
+      Disp_Location (PSL.Nodes.Get_Location (N));
+   end Disp_PSL_Location;
+
+   procedure Warning_Msg (Msg: String) is
+   begin
+      Put ("warning: ");
+      Put_Line (Msg);
+   end Warning_Msg;
+
+   procedure Warning_Msg_Parse (Msg: String) is
+   begin
+      if Flags.Flag_Only_Elab_Warnings then
+         return;
+      end if;
+      Disp_Token_Location;
+      if Flags.Warn_Error then
+         Nbr_Errors := Nbr_Errors + 1;
+         Put (" ");
+      else
+         Put ("warning: ");
+      end if;
+      Put_Line (Msg);
+   end Warning_Msg_Parse;
+
+   procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is
+   begin
+      if Flags.Flag_Only_Elab_Warnings then
+         return;
+      end if;
+      Disp_Location (Loc);
+      if Flags.Warn_Error then
+         Nbr_Errors := Nbr_Errors + 1;
+         Put (" ");
+      else
+         Put ("warning: ");
+      end if;
+      Put_Line (Msg);
+   end Warning_Msg_Sem;
+
+   procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is
+   begin
+      Warning_Msg_Sem (Msg, Get_Location_Safe (Loc));
+   end Warning_Msg_Sem;
+
+   procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is
+   begin
+      Disp_Location (Loc);
+      if Flags.Warn_Error then
+         Nbr_Errors := Nbr_Errors + 1;
+         Put (" ");
+      else
+         Put ("warning: ");
+      end if;
+      Put_Line (Msg);
+   end Warning_Msg_Elab;
+
+   procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is
+   begin
+      Warning_Msg_Elab (Msg, Get_Location_Safe (Loc));
+   end Warning_Msg_Elab;
+
+   procedure Disp_Current_Token;
+   pragma Unreferenced (Disp_Current_Token);
+
+   procedure Disp_Current_Token is
+   begin
+      case Scanner.Current_Token is
+         when Tok_Identifier =>
+            Put ("identifier """
+                 & Name_Table.Image (Scanner.Current_Identifier) & """");
+         when others =>
+            Put (Token_Type'Image (Scanner.Current_Token));
+      end case;
+   end Disp_Current_Token;
+
+   -- Disp a message during scan.
+   procedure Error_Msg_Scan (Msg: String) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Current_Location;
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Scan;
+
+   procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Scan;
+
+   -- Disp a message during scan.
+   procedure Warning_Msg_Scan (Msg: String) is
+   begin
+      Disp_Current_Location;
+      Put ("warning: ");
+      Put_Line (Msg);
+   end Warning_Msg_Scan;
+
+   -- Disp a message during scan.
+   procedure Error_Msg_Parse (Msg: String) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Token_Location;
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Parse;
+
+   procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Iir_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Parse;
+
+   procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Parse;
+
+   -- Disp a message during semantic analysis.
+   -- LOC is used for location and current token.
+   procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      if Loc /= Null_Iir then
+         Disp_Iir_Location (Loc);
+         Put (' ');
+      end if;
+      Put_Line (Msg);
+   end Error_Msg_Sem;
+
+   procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node) is
+      use PSL.Nodes;
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      if Loc /= Null_Node then
+         Disp_PSL_Location (Loc);
+         Put (' ');
+      end if;
+      Put_Line (Msg);
+   end Error_Msg_Sem;
+
+   procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Sem;
+
+   -- Disp a message during elaboration.
+   procedure Error_Msg_Elab (Msg: String) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Put ("error: ");
+      Put_Line (Msg);
+   end Error_Msg_Elab;
+
+   procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
+   begin
+      Nbr_Errors := Nbr_Errors + 1;
+      Disp_Iir_Location (Loc);
+      Put (' ');
+      Put_Line (Msg);
+   end Error_Msg_Elab;
+
+   -- Disp a bug message.
+   procedure Error_Internal (Expr: in Iir; Msg: String := "")
+   is
+      pragma Unreferenced (Expr);
+   begin
+      Put ("internal error: ");
+      Put_Line (Msg);
+      raise Internal_Error;
+   end Error_Internal;
+
+   function Disp_Label (Node : Iir; Str : String) return String
+   is
+      Id : Name_Id;
+   begin
+      Id := Get_Label (Node);
+      if Id = Null_Identifier then
+         return "(unlabeled) " & Str;
+      else
+         return Str & " labeled """ & Name_Table.Image (Id) & """";
+      end if;
+   end Disp_Label;
+
+   -- Disp a node.
+   -- Used for output of message.
+   function Disp_Node (Node: Iir) return String is
+      function Disp_Identifier (Node : Iir; Str : String) return String
+      is
+         Id : Name_Id;
+      begin
+         Id := Get_Identifier (Node);
+         return Str & " """ & Name_Table.Image (Id) & """";
+      end Disp_Identifier;
+
+      function Disp_Type (Node : Iir; Str : String) return String
+      is
+         Decl: Iir;
+      begin
+         Decl := Get_Type_Declarator (Node);
+         if Decl = Null_Iir then
+            return "the anonymous " & Str
+              & " defined at " & Disp_Location (Node);
+         else
+            return Disp_Identifier (Decl, Str);
+         end if;
+      end Disp_Type;
+
+   begin
+      case Get_Kind (Node) is
+         when Iir_Kind_String_Literal =>
+            return "string literal """
+              & Image_String_Lit (Node) & """";
+         when Iir_Kind_Bit_String_Literal =>
+            return "bit string literal """
+              & Image_String_Lit (Node) & """";
+         when Iir_Kind_Character_Literal =>
+            return "character literal " & Image_Identifier (Node);
+         when Iir_Kind_Integer_Literal =>
+            return "integer literal";
+         when Iir_Kind_Floating_Point_Literal =>
+            return "floating point literal";
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            return "physical literal";
+         when Iir_Kind_Enumeration_Literal =>
+            return "enumeration literal " & Image_Identifier (Node);
+         when Iir_Kind_Element_Declaration =>
+            return Disp_Identifier (Node, "element");
+         when Iir_Kind_Record_Element_Constraint =>
+            return "record element constraint";
+         when Iir_Kind_Array_Element_Resolution =>
+            return "array element resolution";
+         when Iir_Kind_Record_Resolution =>
+            return "record resolution";
+         when Iir_Kind_Record_Element_Resolution =>
+            return "record element resolution";
+         when Iir_Kind_Null_Literal =>
+            return "null literal";
+         when Iir_Kind_Overflow_Literal =>
+            return Disp_Node (Get_Literal_Origin (Node));
+         when Iir_Kind_Aggregate =>
+            return "aggregate";
+         when Iir_Kind_Unit_Declaration =>
+            return Disp_Identifier (Node, "physical unit");
+         when Iir_Kind_Simple_Aggregate =>
+            return "locally static array literal";
+
+         when Iir_Kind_Operator_Symbol =>
+            return "operator name";
+         when Iir_Kind_Aggregate_Info =>
+            return "aggregate info";
+         when Iir_Kind_Signature =>
+            return "signature";
+         when Iir_Kind_Waveform_Element =>
+            return "waveform element";
+         when Iir_Kind_Conditional_Waveform =>
+            return "conditional waveform";
+         when Iir_Kind_Association_Element_Open =>
+            return "open association element";
+         when Iir_Kind_Association_Element_By_Individual =>
+            return "individual association element";
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_Package =>
+            return "association element";
+         when Iir_Kind_Overload_List =>
+            return "overloaded name or expression";
+
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            return Image_Identifier (Get_Type_Declarator (Node));
+         when Iir_Kind_Array_Type_Definition =>
+            return Disp_Type (Node, "array type");
+         when Iir_Kind_Array_Subtype_Definition =>
+            return Disp_Type (Node, "array subtype");
+         when Iir_Kind_Record_Type_Definition =>
+            return Disp_Type (Node, "record type");
+         when Iir_Kind_Record_Subtype_Definition =>
+            return Disp_Type (Node, "record subtype");
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            return Disp_Type (Node, "enumeration subtype");
+         when Iir_Kind_Integer_Subtype_Definition =>
+            return Disp_Type (Node, "integer subtype");
+         when Iir_Kind_Physical_Type_Definition =>
+            return Disp_Type (Node, "physical type");
+         when Iir_Kind_Physical_Subtype_Definition =>
+            return Disp_Type (Node, "physical subtype");
+         when Iir_Kind_File_Type_Definition =>
+            return Disp_Type (Node, "file type");
+         when Iir_Kind_Access_Type_Definition =>
+            return Disp_Type (Node, "access type");
+         when Iir_Kind_Access_Subtype_Definition =>
+            return Disp_Type (Node, "access subtype");
+         when Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Floating_Type_Definition =>
+            return Disp_Type (Node, "floating type");
+         when Iir_Kind_Incomplete_Type_Definition =>
+            return Disp_Type (Node, "incomplete type");
+         when Iir_Kind_Protected_Type_Declaration =>
+            return Disp_Type (Node, "protected type");
+         when Iir_Kind_Protected_Type_Body =>
+            return Disp_Type (Node, "protected type body");
+         when Iir_Kind_Subtype_Definition =>
+            return "subtype definition";
+
+         when Iir_Kind_Scalar_Nature_Definition =>
+            return Image_Identifier (Get_Nature_Declarator (Node));
+
+         when Iir_Kind_Choice_By_Expression =>
+            return "choice by expression";
+         when Iir_Kind_Choice_By_Range =>
+            return "choice by range";
+         when Iir_Kind_Choice_By_Name =>
+            return "choice by name";
+         when Iir_Kind_Choice_By_Others =>
+            return "others choice";
+         when Iir_Kind_Choice_By_None =>
+            return "positionnal choice";
+
+         when Iir_Kind_Function_Call =>
+            return "function call";
+         when Iir_Kind_Procedure_Call_Statement =>
+            return "procedure call statement";
+         when Iir_Kind_Procedure_Call =>
+            return "procedure call";
+         when Iir_Kind_Selected_Name =>
+            Name_Table.Image (Get_Identifier (Node));
+            return '''
+              & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)
+              & ''';
+         when Iir_Kind_Simple_Name =>
+            Name_Table.Image (Get_Identifier (Node));
+            return '''
+              & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)
+              & ''';
+         when Iir_Kind_Entity_Aspect_Entity =>
+            return "aspect " & Disp_Node (Get_Entity (Node))
+              & '(' & Image_Identifier (Get_Architecture (Node)) & ')';
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            return "configuration entity aspect";
+         when Iir_Kind_Entity_Aspect_Open =>
+            return "open entity aspect";
+
+         when Iir_Kinds_Monadic_Operator
+           | Iir_Kinds_Dyadic_Operator =>
+            return "operator """
+              & Name_Table.Image (Get_Operator_Name (Node)) & """";
+         when Iir_Kind_Parenthesis_Expression =>
+            return "expression";
+         when Iir_Kind_Qualified_Expression =>
+            return "qualified expression";
+         when Iir_Kind_Type_Conversion =>
+            return "type conversion";
+         when Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Allocator_By_Expression =>
+            return "allocator";
+         when Iir_Kind_Indexed_Name =>
+            return "indexed name";
+         when Iir_Kind_Range_Expression =>
+            return "range expression";
+         when Iir_Kind_Implicit_Dereference =>
+            return "implicit access dereference";
+         when Iir_Kind_Dereference =>
+            return "access dereference";
+         when Iir_Kind_Selected_Element =>
+            return "selected element";
+         when Iir_Kind_Selected_By_All_Name =>
+            return ".all name";
+         when Iir_Kind_Psl_Expression =>
+            return "PSL instantiation";
+
+         when Iir_Kind_Interface_Constant_Declaration =>
+            if Get_Parent (Node) = Null_Iir then
+               --  For constant interface of predefined operator.
+               return "anonymous interface";
+            end if;
+            case Get_Kind (Get_Parent (Node)) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Block_Statement
+                 | Iir_Kind_Block_Header =>
+                  return Disp_Identifier (Node, "generic");
+               when others =>
+                  return Disp_Identifier (Node, "constant interface");
+            end case;
+         when Iir_Kind_Interface_Signal_Declaration =>
+            case Get_Kind (Get_Parent (Node)) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Block_Statement
+                 | Iir_Kind_Block_Header =>
+                  return Disp_Identifier (Node, "port");
+               when others =>
+                  return Disp_Identifier (Node, "signal interface");
+            end case;
+         when Iir_Kind_Interface_Variable_Declaration =>
+            return Disp_Identifier (Node, "variable interface");
+         when Iir_Kind_Interface_File_Declaration =>
+            return Disp_Identifier (Node, "file interface");
+         when Iir_Kind_Interface_Package_Declaration =>
+            return Disp_Identifier (Node, "package interface");
+         when Iir_Kind_Signal_Declaration =>
+            return Disp_Identifier (Node, "signal");
+         when Iir_Kind_Variable_Declaration =>
+            return Disp_Identifier (Node, "variable");
+         when Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Constant_Declaration =>
+            return Disp_Identifier (Node, "constant");
+         when Iir_Kind_File_Declaration =>
+            return Disp_Identifier (Node, "file");
+         when Iir_Kind_Object_Alias_Declaration =>
+            return Disp_Identifier (Node, "alias");
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            return Disp_Identifier (Node, "non-object alias");
+         when Iir_Kind_Guard_Signal_Declaration =>
+            return "GUARD signal";
+         when Iir_Kind_Group_Template_Declaration =>
+            return Disp_Identifier (Node, "group template");
+         when Iir_Kind_Group_Declaration =>
+            return Disp_Identifier (Node, "group");
+
+         when Iir_Kind_Library_Declaration
+           | Iir_Kind_Library_Clause =>
+            return Disp_Identifier (Node, "library");
+         when Iir_Kind_Design_File =>
+            return "design file";
+
+         when Iir_Kind_Procedure_Declaration =>
+            return Disp_Identifier (Node, "procedure");
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            return "subprogram body";
+         when Iir_Kind_Function_Declaration =>
+            return Disp_Identifier (Node, "function");
+
+         when Iir_Kind_Package_Declaration =>
+            return Disp_Identifier (Node, "package");
+         when Iir_Kind_Package_Body =>
+            return Disp_Identifier (Node, "package body");
+         when Iir_Kind_Entity_Declaration =>
+            return Disp_Identifier (Node, "entity");
+         when Iir_Kind_Architecture_Body =>
+            return Disp_Identifier (Node, "architecture") &
+              " of" & Disp_Identifier (Get_Entity_Name (Node), "");
+         when Iir_Kind_Configuration_Declaration =>
+            declare
+               Id : Name_Id;
+               Ent : Iir;
+               Arch : Iir;
+            begin
+               Id := Get_Identifier (Node);
+               if Id /= Null_Identifier then
+                  return Disp_Identifier (Node, "configuration");
+               else
+                  Ent := Get_Entity (Node);
+                  Arch := Get_Block_Specification
+                    (Get_Block_Configuration (Node));
+                  return "default configuration of "
+                    & Image_Identifier (Ent)
+                    & '(' & Image_Identifier (Arch) & ')';
+               end if;
+            end;
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            return Disp_Identifier (Node, "instantiation package");
+
+         when Iir_Kind_Package_Header =>
+            return "package header";
+
+         when Iir_Kind_Component_Declaration =>
+            return Disp_Identifier (Node, "component");
+
+         when Iir_Kind_Design_Unit =>
+            return Disp_Node (Get_Library_Unit (Node));
+         when Iir_Kind_Use_Clause =>
+            return "use clause";
+         when Iir_Kind_Disconnection_Specification =>
+            return "disconnection specification";
+
+         when Iir_Kind_Slice_Name =>
+            return "slice";
+         when Iir_Kind_Parenthesis_Name =>
+            return "function call, slice or indexed name";
+         when Iir_Kind_Type_Declaration =>
+            return Disp_Identifier (Node, "type");
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            return Disp_Identifier (Node, "type");
+         when Iir_Kind_Subtype_Declaration =>
+            return Disp_Identifier (Node, "subtype");
+
+         when Iir_Kind_Nature_Declaration =>
+            return Disp_Identifier (Node, "nature");
+         when Iir_Kind_Subnature_Declaration =>
+            return Disp_Identifier (Node, "subnature");
+
+         when Iir_Kind_Component_Instantiation_Statement =>
+            return Disp_Identifier (Node, "component instance");
+         when Iir_Kind_Configuration_Specification =>
+            return "configuration specification";
+         when Iir_Kind_Component_Configuration =>
+            return "component configuration";
+         when Iir_Kind_Implicit_Function_Declaration =>
+            return Disp_Identifier (Node, "implicit function")
+              & Disp_Identifier (Get_Type_Reference (Node), " of type");
+--             return "implicit function "
+--               & Get_Predefined_Function_Name
+--                (Get_Implicit_Definition (Node));
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            return "implicit procedure "
+              & Get_Predefined_Function_Name (Get_Implicit_Definition (Node));
+
+         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            return "concurrent procedure call";
+         when Iir_Kind_Generate_Statement =>
+            return "generate statement";
+
+         when Iir_Kind_Simple_Simultaneous_Statement =>
+            return "simple simultaneous statement";
+
+         when Iir_Kind_Psl_Declaration =>
+            return Disp_Identifier (Node, "PSL declaration");
+
+         when Iir_Kind_Terminal_Declaration =>
+            return Disp_Identifier (Node, "terminal declaration");
+         when Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration =>
+            return Disp_Identifier (Node, "quantity declaration");
+
+         when Iir_Kind_Attribute_Declaration =>
+            return Disp_Identifier (Node, "attribute");
+         when Iir_Kind_Attribute_Specification =>
+            return "attribute specification";
+         when Iir_Kind_Entity_Class =>
+            return "entity class";
+         when Iir_Kind_Attribute_Value =>
+            return "attribute value";
+         when Iir_Kind_Attribute_Name =>
+            return "attribute";
+         when Iir_Kind_Base_Attribute =>
+            return "'base attribute";
+         when Iir_Kind_Length_Array_Attribute =>
+            return "'length attribute";
+         when Iir_Kind_Range_Array_Attribute =>
+            return "'range attribute";
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            return "'reverse_range attribute";
+         when Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Ascending_Array_Attribute =>
+            return "'ascending attribute";
+         when Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Left_Array_Attribute =>
+            return "'left attribute";
+         when Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_Right_Array_Attribute =>
+            return "'right attribute";
+         when Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Low_Array_Attribute =>
+            return "'low attribute";
+         when Iir_Kind_Leftof_Attribute =>
+            return "'leftof attribute";
+         when Iir_Kind_Rightof_Attribute =>
+            return "'rightof attribute";
+         when Iir_Kind_Pred_Attribute =>
+            return "'pred attribute";
+         when Iir_Kind_Succ_Attribute =>
+            return "'succ attribute";
+         when Iir_Kind_Pos_Attribute =>
+            return "'pos attribute";
+         when Iir_Kind_Val_Attribute =>
+            return "'val attribute";
+         when Iir_Kind_Image_Attribute =>
+            return "'image attribute";
+         when Iir_Kind_Value_Attribute =>
+            return "'value attribute";
+         when Iir_Kind_High_Type_Attribute
+           | Iir_Kind_High_Array_Attribute =>
+            return "'high attribute";
+         when Iir_Kind_Transaction_Attribute =>
+            return "'transaction attribute";
+         when Iir_Kind_Stable_Attribute =>
+            return "'stable attribute";
+         when Iir_Kind_Quiet_Attribute =>
+            return "'quiet attribute";
+         when Iir_Kind_Delayed_Attribute =>
+            return "'delayed attribute";
+         when Iir_Kind_Driving_Attribute =>
+            return "'driving attribute";
+         when Iir_Kind_Driving_Value_Attribute =>
+            return "'driving_value attribute";
+         when Iir_Kind_Event_Attribute =>
+            return "'event attribute";
+         when Iir_Kind_Active_Attribute =>
+            return "'active attribute";
+         when Iir_Kind_Last_Event_Attribute =>
+            return "'last_event attribute";
+         when Iir_Kind_Last_Active_Attribute =>
+            return "'last_active attribute";
+         when Iir_Kind_Last_Value_Attribute =>
+            return "'last_value attribute";
+         when Iir_Kind_Behavior_Attribute =>
+            return "'behavior attribute";
+         when Iir_Kind_Structure_Attribute =>
+            return "'structure attribute";
+
+         when Iir_Kind_Path_Name_Attribute =>
+            return "'path_name attribute";
+         when Iir_Kind_Instance_Name_Attribute =>
+            return "'instance_name attribute";
+         when Iir_Kind_Simple_Name_Attribute =>
+            return "'simple_name attribute";
+
+         when Iir_Kind_For_Loop_Statement =>
+            return Disp_Label (Node, "for loop statement");
+         when Iir_Kind_While_Loop_Statement =>
+            return Disp_Label (Node, "loop statement");
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement =>
+            return Disp_Label (Node, "process");
+         when Iir_Kind_Block_Statement =>
+            return Disp_Label (Node, "block statement");
+         when Iir_Kind_Block_Header =>
+            return "block header";
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            return Disp_Label
+              (Node, "concurrent conditional signal assignment");
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            return Disp_Label
+              (Node, "concurrent selected signal assignment");
+         when Iir_Kind_Concurrent_Assertion_Statement =>
+            return Disp_Label (Node, "concurrent assertion");
+         when Iir_Kind_Psl_Assert_Statement =>
+            return Disp_Label (Node, "PSL assertion");
+         when Iir_Kind_Psl_Cover_Statement =>
+            return Disp_Label (Node, "PSL cover");
+         when Iir_Kind_Psl_Default_Clock =>
+            return "PSL default clock";
+
+         when Iir_Kind_If_Statement =>
+            return Disp_Label (Node, "if statement");
+         when Iir_Kind_Elsif =>
+            return Disp_Label (Node, "else/elsif statement");
+         when Iir_Kind_Next_Statement =>
+            return Disp_Label (Node, "next statement");
+         when Iir_Kind_Exit_Statement =>
+            return Disp_Label (Node, "exit statement");
+         when Iir_Kind_Case_Statement =>
+            return Disp_Label (Node, "case statement");
+         when Iir_Kind_Return_Statement =>
+            return Disp_Label (Node, "return statement");
+         when Iir_Kind_Signal_Assignment_Statement =>
+            return Disp_Label (Node, "signal assignment statement");
+         when Iir_Kind_Variable_Assignment_Statement =>
+            return Disp_Label (Node, "variable assignment statement");
+         when Iir_Kind_Null_Statement =>
+            return Disp_Label (Node, "null statement");
+         when Iir_Kind_Wait_Statement =>
+            return Disp_Label (Node, "wait statement");
+         when Iir_Kind_Assertion_Statement =>
+            return Disp_Label (Node, "assertion statement");
+         when Iir_Kind_Report_Statement =>
+            return Disp_Label (Node, "report statement");
+
+         when Iir_Kind_Block_Configuration =>
+            return "block configuration";
+         when Iir_Kind_Binding_Indication =>
+            return "binding indication";
+
+         when Iir_Kind_Error =>
+            return "error";
+         when Iir_Kind_Unused =>
+            return "*unused*";
+      end case;
+   end Disp_Node;
+
+   -- Disp a node location.
+   -- Used for output of message.
+
+   function Get_Location_Str
+     (Name : Name_Id; Line, Col : Natural; Filename : Boolean)
+     return String
+   is
+      Line_Str : constant String := Natural'Image (Line);
+      Col_Str : constant String := Natural'Image (Col);
+   begin
+      if Filename then
+         return Name_Table.Image (Name)
+           & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last)
+           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
+      else
+         return Line_Str (Line_Str'First + 1 .. Line_Str'Last)
+           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
+      end if;
+   end Get_Location_Str;
+
+   function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True)
+     return string
+   is
+      Line, Col : Natural;
+      Name : Name_Id;
+   begin
+      if Loc = Location_Nil then
+         --  Avoid a crash.
+         return "??:??:??";
+      else
+         Location_To_Position (Loc, Name, Line, Col);
+         return Get_Location_Str (Name, Line, Col, Filename);
+      end if;
+   end Get_Location_Str;
+
+   function Disp_Location (Node: Iir) return String is
+   begin
+      return Get_Location_Str (Get_Location (Node));
+   end Disp_Location;
+
+   function Disp_Name (Kind : Iir_Kind) return String is
+   begin
+      case Kind is
+         when Iir_Kind_Constant_Declaration =>
+            return "constant declaration";
+         when Iir_Kind_Signal_Declaration =>
+            return "signal declaration";
+         when Iir_Kind_Variable_Declaration =>
+            return "variable declaration";
+         when Iir_Kind_File_Declaration =>
+            return "file declaration";
+         when others =>
+            return "???" & Iir_Kind'Image (Kind);
+      end case;
+   end Disp_Name;
+
+   function Image (N : Iir_Int64) return String
+   is
+      Res : constant String := Iir_Int64'Image (N);
+   begin
+      if Res (1) = ' ' then
+         return Res (2 .. Res'Last);
+      else
+         return Res;
+      end if;
+   end Image;
+
+   function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is
+   begin
+      case Get_Kind (Dtype) is
+         when Iir_Kind_Integer_Type_Definition =>
+            return Image (Pos);
+         when Iir_Kind_Enumeration_Type_Definition =>
+            return Name_Table.Image
+              (Get_Identifier (Get_Nth_Element
+                               (Get_Enumeration_Literal_List (Dtype),
+                                Natural (Pos))));
+         when others =>
+            Error_Kind ("disp_discrete", Dtype);
+      end case;
+   end Disp_Discrete;
+
+   function Disp_Subprg (Subprg : Iir) return String
+   is
+      use Ada.Strings.Unbounded;
+      Res : Unbounded_String;
+
+      procedure Append_Type (Def : Iir)
+      is
+         use Name_Table;
+         Decl : Iir := Get_Type_Declarator (Def);
+      begin
+         if Decl = Null_Iir then
+            Decl := Get_Type_Declarator (Get_Base_Type (Def));
+         end if;
+         Image (Get_Identifier (Decl));
+         Append (Res, Name_Buffer (1 .. Name_Length));
+      end Append_Type;
+
+   begin
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Enumeration_Literal =>
+            Append (Res, "enumeration literal ");
+         when Iir_Kind_Implicit_Function_Declaration =>
+            Append (Res, "implicit function ");
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            Append (Res, "implicit procedure ");
+         when Iir_Kind_Function_Declaration =>
+            Append (Res, "function ");
+         when Iir_Kind_Procedure_Declaration =>
+            Append (Res, "procedure ");
+         when others =>
+            Error_Kind ("disp_subprg", Subprg);
+      end case;
+
+      declare
+         use Name_Table;
+
+         Id : constant Name_Id := Get_Identifier (Subprg);
+      begin
+         Image (Id);
+         case Id is
+            when Std_Names.Name_Id_Operators
+              | Std_Names.Name_Word_Operators
+              | Std_Names.Name_Xnor
+              | Std_Names.Name_Shift_Operators =>
+               Append (Res, """");
+               Append (Res, Name_Buffer (1 .. Name_Length));
+               Append (Res, """");
+            when others =>
+               Append (Res, Name_Buffer (1 .. Name_Length));
+         end case;
+      end;
+
+      Append (Res, " [");
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            declare
+               El : Iir;
+            begin
+               El := Get_Interface_Declaration_Chain (Subprg);
+               while El /= Null_Iir loop
+                  Append_Type (Get_Type (El));
+                  El := Get_Chain (El);
+                  exit when El = Null_Iir;
+                  Append (Res, ", ");
+               end loop;
+            end;
+         when others =>
+            null;
+      end case;
+
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Enumeration_Literal =>
+            Append (Res, " return ");
+            Append_Type (Get_Return_Type (Subprg));
+         when others =>
+            null;
+      end case;
+
+      Append (Res, "]");
+
+      return To_String (Res);
+   end Disp_Subprg;
+
+   --  DEF must be any type definition.
+   --  Return the type name of DEF, handle anonymous subtypes.
+   function Disp_Type_Name (Def : Iir) return String
+   is
+      Decl : Iir;
+   begin
+      Decl := Get_Type_Declarator (Def);
+      if Decl /= Null_Iir then
+         return Image_Identifier (Decl);
+      end if;
+      Decl := Get_Type_Declarator (Get_Base_Type (Def));
+      if Decl /= Null_Iir then
+         return "a subtype of " & Image_Identifier (Decl);
+      else
+         return "an unknown type";
+      end if;
+   end Disp_Type_Name;
+
+   function Disp_Type_Of (Node : Iir) return String
+   is
+      A_Type : Iir;
+   begin
+      A_Type := Get_Type (Node);
+      if A_Type = Null_Iir then
+         return "unknown";
+      elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then
+         declare
+            use Ada.Strings.Unbounded;
+            Res : Unbounded_String;
+            List : Iir_List;
+            El : Iir;
+            Nbr : Natural;
+         begin
+            List := Get_Overload_List (A_Type);
+            Nbr := Get_Nbr_Elements (List);
+            if Nbr = 0 then
+               return "unknown";
+            elsif Nbr = 1 then
+               return Disp_Type_Name (Get_First_Element (List));
+            else
+               Append (Res, "one of ");
+               for I in 0 .. Nbr - 1 loop
+                  El := Get_Nth_Element (List, I);
+                  Append (Res, Disp_Type_Name (El));
+                  if I < Nbr - 2 then
+                     Append (Res, ", ");
+                  elsif I = Nbr - 2 then
+                     Append (Res, " or ");
+                  end if;
+               end loop;
+               return To_String (Res);
+            end if;
+         end;
+      else
+         return Disp_Type_Name (A_Type);
+      end if;
+   end Disp_Type_Of;
+
+   procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir)
+   is
+      L : Location_Type;
+   begin
+      if Loc = Null_Iir then
+         L := Get_Location (Caller);
+      else
+         L := Get_Location (Loc);
+      end if;
+      Error_Msg_Sem
+        ("pure " & Disp_Node (Caller) & " cannot call (impure) "
+         & Disp_Node (Callee), L);
+      Error_Msg_Sem
+        ("(" & Disp_Node (Callee) & " is defined here)", Callee);
+   end Error_Pure;
+
+   procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir)
+   is
+   begin
+      Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type "
+                     & Disp_Node (A_Type), Loc);
+      if Loc /= Expr then
+         Error_Msg_Sem ("(location of " & Disp_Node (Expr) & ")", Expr);
+      end if;
+   end Error_Not_Match;
+
+   function Get_Mode_Name (Mode : Iir_Mode) return String is
+   begin
+      case Mode is
+         when Iir_Unknown_Mode =>
+            raise Internal_Error;
+         when Iir_Linkage_Mode =>
+            return "linkage";
+         when Iir_Buffer_Mode =>
+            return "buffer";
+         when Iir_Out_Mode =>
+            return "out";
+         when Iir_Inout_Mode =>
+            return "inout";
+         when Iir_In_Mode =>
+            return "in";
+      end case;
+   end Get_Mode_Name;
+
+end Errorout;
diff --git a/src/errorout.ads b/src/errorout.ads
new file mode 100644
index 000000000..ce694fe37
--- /dev/null
+++ b/src/errorout.ads
@@ -0,0 +1,128 @@
+--  Error message handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Errorout is
+   Option_Error: exception;
+   Parse_Error: exception;
+   Compilation_Error: exception;
+
+   -- This kind can't be handled.
+   --procedure Error_Kind (Msg: String; Kind: Iir_Kind);
+   procedure Error_Kind (Msg: String; An_Iir: in Iir);
+   procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions);
+   procedure Error_Kind (Msg : String; N : PSL_Node);
+   pragma No_Return (Error_Kind);
+
+   -- The number of errors (ie, number of calls to error_msg*).
+   Nbr_Errors: Natural := 0;
+
+   -- Disp an error, prepended with program name.
+   procedure Error_Msg (Msg: String);
+
+   -- Disp an error, prepended with program name, and raise option_error.
+   -- This is used for errors before initialisation, such as bad option or
+   -- bad filename.
+   procedure Error_Msg_Option (Msg: String);
+   pragma No_Return (Error_Msg_Option);
+
+   --  Same as Error_Msg_Option but do not raise Option_Error.
+   procedure Error_Msg_Option_NR (Msg: String);
+
+   -- Disp an error location (using AN_IIR location) using the standard
+   -- format `file:line:col: '.
+   procedure Disp_Iir_Location (An_Iir: Iir);
+
+   -- Disp a warning.
+   procedure Warning_Msg (Msg: String);
+   procedure Warning_Msg_Parse (Msg: String);
+   procedure Warning_Msg_Sem (Msg: String; Loc : Iir);
+   procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type);
+
+   -- Disp a message during scan.
+   -- The current location is automatically displayed before the message.
+   procedure Error_Msg_Scan (Msg: String);
+   procedure Error_Msg_Scan (Msg: String; Loc : Location_Type);
+   procedure Warning_Msg_Scan (Msg: String);
+
+   -- Disp a message during parse
+   -- The location of the current token is automatically displayed before
+   -- the message.
+   procedure Error_Msg_Parse (Msg: String);
+   procedure Error_Msg_Parse (Msg: String; Loc : Iir);
+   procedure Error_Msg_Parse (Msg: String; Loc : Location_Type);
+
+   -- Disp a message during semantic analysis.
+   -- an_iir is used for location and current token.
+   procedure Error_Msg_Sem (Msg: String; Loc: Iir);
+   procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node);
+   procedure Error_Msg_Sem (Msg: String; Loc: Location_Type);
+
+   -- Disp a message during elaboration (or configuration).
+   procedure Error_Msg_Elab (Msg: String);
+   procedure Error_Msg_Elab (Msg: String; Loc: Iir);
+
+   --  Disp a warning durig elaboration (or configuration).
+   procedure Warning_Msg_Elab (Msg: String; Loc : Iir);
+
+   -- Disp a bug message.
+   procedure Error_Internal (Expr: Iir; Msg: String := "");
+   pragma No_Return (Error_Internal);
+
+   -- Disp a node.
+   -- Used for output of message.
+   function Disp_Node (Node: Iir) return String;
+
+   -- Disp a node location.
+   -- Used for output of message.
+   function Disp_Location (Node: Iir) return String;
+   function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True)
+     return String;
+
+   -- Disp non-terminal name from KIND.
+   function Disp_Name (Kind : Iir_Kind) return String;
+
+   --  SUBPRG must be a subprogram declaration or an enumeration literal
+   --  declaration.
+   --  Returns:
+   --   "enumeration literal XX [ return TYPE ]"
+   --   "function XXX [ TYPE1, TYPE2 return TYPE ]"
+   --   "procedure XXX [ TYPE1, TYPE2 ]"
+   --   "implicit function XXX [ TYPE1, TYPE2 return TYPE ]"
+   --   "implicit procedure XXX [ TYPE1, TYPE2 ]"
+   function Disp_Subprg (Subprg : Iir) return String;
+
+   --  Print element POS of discrete type DTYPE.
+   function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String;
+
+   --  Disp the name of the type of NODE if known.
+   --  Disp "unknown" if it is not known.
+   --  Disp all possible types if it is an overload list.
+   function Disp_Type_Of (Node : Iir) return String;
+
+   --  Disp an error message when a pure function CALLER calls impure CALLEE.
+   procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir);
+
+   --  Report an error message as type of EXPR does not match A_TYPE.
+   --  Location is LOC.
+   procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir);
+
+   --  Disp interface mode MODE.
+   function Get_Mode_Name (Mode : Iir_Mode) return String;
+end Errorout;
diff --git a/src/evaluation.adb b/src/evaluation.adb
new file mode 100644
index 000000000..8279e140c
--- /dev/null
+++ b/src/evaluation.adb
@@ -0,0 +1,3047 @@
+--  Evaluation of static expressions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+with Errorout; use Errorout;
+with Name_Table; use Name_Table;
+with Str_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package; use Std_Package;
+with Flags; use Flags;
+with Std_Names;
+with Ada.Characters.Handling;
+
+package body Evaluation is
+   function Get_Physical_Value (Expr : Iir) return Iir_Int64
+   is
+      pragma Unsuppress (Overflow_Check);
+      Kind : constant Iir_Kind := Get_Kind (Expr);
+      Unit : Iir;
+   begin
+      case Kind is
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            --  Extract Unit.
+            Unit := Get_Physical_Unit_Value
+              (Get_Named_Entity (Get_Unit_Name (Expr)));
+            case Kind is
+               when Iir_Kind_Physical_Int_Literal =>
+                  return Get_Value (Expr) * Get_Value (Unit);
+               when Iir_Kind_Physical_Fp_Literal =>
+                  return Iir_Int64
+                    (Get_Fp_Value (Expr) * Iir_Fp64 (Get_Value (Unit)));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when Iir_Kind_Unit_Declaration =>
+            return Get_Value (Get_Physical_Unit_Value (Expr));
+         when others =>
+            Error_Kind ("get_physical_value", Expr);
+      end case;
+   exception
+      when Constraint_Error =>
+         Error_Msg_Sem ("arithmetic overflow in physical expression", Expr);
+         return Get_Value (Expr);
+   end Get_Physical_Value;
+
+   function Build_Integer (Val : Iir_Int64; Origin : Iir)
+     return Iir_Integer_Literal
+   is
+      Res : Iir_Integer_Literal;
+   begin
+      Res := Create_Iir (Iir_Kind_Integer_Literal);
+      Location_Copy (Res, Origin);
+      Set_Value (Res, Val);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Integer;
+
+   function Build_Floating (Val : Iir_Fp64; Origin : Iir)
+     return Iir_Floating_Point_Literal
+   is
+      Res : Iir_Floating_Point_Literal;
+   begin
+      Res := Create_Iir (Iir_Kind_Floating_Point_Literal);
+      Location_Copy (Res, Origin);
+      Set_Fp_Value (Res, Val);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Floating;
+
+   function Build_Enumeration_Constant (Val : Iir_Index32; Origin : Iir)
+     return Iir_Enumeration_Literal
+   is
+      Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin));
+      Enum_List : constant Iir_List :=
+        Get_Enumeration_Literal_List (Enum_Type);
+      Lit : constant Iir_Enumeration_Literal :=
+        Get_Nth_Element (Enum_List, Integer (Val));
+      Res : Iir_Enumeration_Literal;
+   begin
+      Res := Copy_Enumeration_Literal (Lit);
+      Location_Copy (Res, Origin);
+      Set_Literal_Origin (Res, Origin);
+      return Res;
+   end Build_Enumeration_Constant;
+
+   function Build_Physical (Val : Iir_Int64; Origin : Iir)
+     return Iir_Physical_Int_Literal
+   is
+      Res : Iir_Physical_Int_Literal;
+      Unit_Name : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+      Location_Copy (Res, Origin);
+      Unit_Name := Get_Primary_Unit_Name (Get_Base_Type (Get_Type (Origin)));
+      Set_Unit_Name (Res, Unit_Name);
+      Set_Value (Res, Val);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Physical;
+
+   function Build_Discrete (Val : Iir_Int64; Origin : Iir) return Iir is
+   begin
+      case Get_Kind (Get_Type (Origin)) is
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            return Build_Enumeration_Constant (Iir_Index32 (Val), Origin);
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            return Build_Integer (Val, Origin);
+         when others =>
+            Error_Kind ("build_discrete", Get_Type (Origin));
+      end case;
+   end Build_Discrete;
+
+   function Build_String (Val : String_Id; Len : Nat32; Origin : Iir)
+     return Iir_String_Literal
+   is
+      Res : Iir_String_Literal;
+   begin
+      Res := Create_Iir (Iir_Kind_String_Literal);
+      Location_Copy (Res, Origin);
+      Set_String_Id (Res, Val);
+      Set_String_Length (Res, Len);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_String;
+
+   function Build_Simple_Aggregate
+     (El_List : Iir_List; Origin : Iir; Stype : Iir)
+     return Iir_Simple_Aggregate
+   is
+      Res : Iir_Simple_Aggregate;
+   begin
+      Res := Create_Iir (Iir_Kind_Simple_Aggregate);
+      Location_Copy (Res, Origin);
+      Set_Simple_Aggregate_List (Res, El_List);
+      Set_Type (Res, Stype);
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      Set_Literal_Subtype (Res, Stype);
+      return Res;
+   end Build_Simple_Aggregate;
+
+   function Build_Overflow (Origin : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Overflow_Literal);
+      Location_Copy (Res, Origin);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Overflow;
+
+   function Build_Constant (Val : Iir; Origin : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      --  Note: this must work for any literals, because it may be used to
+      --  replace a locally static constant by its initial value.
+      case Get_Kind (Val) is
+         when Iir_Kind_Integer_Literal =>
+            Res := Create_Iir (Iir_Kind_Integer_Literal);
+            Set_Value (Res, Get_Value (Val));
+
+         when Iir_Kind_Floating_Point_Literal =>
+            Res := Create_Iir (Iir_Kind_Floating_Point_Literal);
+            Set_Fp_Value (Res, Get_Fp_Value (Val));
+
+         when Iir_Kind_Enumeration_Literal =>
+            return Build_Enumeration_Constant
+              (Iir_Index32 (Get_Enum_Pos (Val)), Origin);
+
+         when Iir_Kind_Physical_Int_Literal =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Set_Unit_Name (Res, Get_Primary_Unit_Name
+                             (Get_Base_Type (Get_Type (Origin))));
+            Set_Value (Res, Get_Physical_Value (Val));
+
+         when Iir_Kind_Unit_Declaration =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Set_Value (Res, Get_Physical_Value (Val));
+            Set_Unit_Name (Res, Get_Primary_Unit_Name (Get_Type (Val)));
+
+         when Iir_Kind_String_Literal =>
+            Res := Create_Iir (Iir_Kind_String_Literal);
+            Set_String_Id (Res, Get_String_Id (Val));
+            Set_String_Length (Res, Get_String_Length (Val));
+
+         when Iir_Kind_Bit_String_Literal =>
+            Res := Create_Iir (Iir_Kind_Bit_String_Literal);
+            Set_String_Id (Res, Get_String_Id (Val));
+            Set_String_Length (Res, Get_String_Length (Val));
+            Set_Bit_String_Base (Res, Get_Bit_String_Base (Val));
+            Set_Bit_String_0 (Res, Get_Bit_String_0 (Val));
+            Set_Bit_String_1 (Res, Get_Bit_String_1 (Val));
+
+         when Iir_Kind_Simple_Aggregate =>
+            Res := Create_Iir (Iir_Kind_Simple_Aggregate);
+            Set_Simple_Aggregate_List (Res, Get_Simple_Aggregate_List (Val));
+            Set_Literal_Subtype (Res, Get_Type (Origin));
+
+         when Iir_Kind_Overflow_Literal =>
+            Res := Create_Iir (Iir_Kind_Overflow_Literal);
+
+         when others =>
+            Error_Kind ("build_constant", Val);
+      end case;
+      Location_Copy (Res, Origin);
+      Set_Type (Res, Get_Type (Origin));
+      Set_Literal_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Constant;
+
+   function Build_Boolean (Cond : Boolean) return Iir is
+   begin
+      if Cond then
+         return Boolean_True;
+      else
+         return Boolean_False;
+      end if;
+   end Build_Boolean;
+
+   function Build_Enumeration (Val : Iir_Index32; Origin : Iir)
+                              return Iir_Enumeration_Literal
+   is
+      Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin));
+      Enum_List : constant Iir_List :=
+        Get_Enumeration_Literal_List (Enum_Type);
+   begin
+      return Get_Nth_Element (Enum_List, Integer (Val));
+   end Build_Enumeration;
+
+   function Build_Enumeration (Val : Boolean; Origin : Iir)
+                              return Iir_Enumeration_Literal
+   is
+      Enum_Type : constant Iir := Get_Base_Type (Get_Type (Origin));
+      Enum_List : constant Iir_List :=
+        Get_Enumeration_Literal_List (Enum_Type);
+   begin
+      return Get_Nth_Element (Enum_List, Boolean'Pos (Val));
+   end Build_Enumeration;
+
+   function Build_Constant_Range (Range_Expr : Iir; Origin : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Range_Expression);
+      Location_Copy (Res, Origin);
+      Set_Type (Res, Get_Type (Range_Expr));
+      Set_Left_Limit (Res, Get_Left_Limit (Range_Expr));
+      Set_Right_Limit (Res, Get_Right_Limit (Range_Expr));
+      Set_Direction (Res, Get_Direction (Range_Expr));
+      Set_Range_Origin (Res, Origin);
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Build_Constant_Range;
+
+   function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir
+   is
+      Orig_Type : constant Iir := Get_Base_Type (Get_Type (Origin));
+   begin
+      case Get_Kind (Orig_Type) is
+         when Iir_Kind_Integer_Type_Definition =>
+            if Is_Pos then
+               return Build_Integer (Iir_Int64'Last, Origin);
+            else
+               return Build_Integer (Iir_Int64'First, Origin);
+            end if;
+         when others =>
+            Error_Kind ("build_extreme_value", Orig_Type);
+      end case;
+   end Build_Extreme_Value;
+
+   --  A_RANGE is a range expression, whose type, location, expr_staticness,
+   --  left_limit and direction are set.
+   --  Type of A_RANGE must have a range_constraint.
+   --  Set the right limit of A_RANGE from LEN.
+   procedure Set_Right_Limit_By_Length (A_Range : Iir; Len : Iir_Int64)
+   is
+      Left, Right : Iir;
+      Pos : Iir_Int64;
+      A_Type : Iir;
+   begin
+      if Get_Expr_Staticness (A_Range) /= Locally then
+         raise Internal_Error;
+      end if;
+      A_Type := Get_Type (A_Range);
+
+      Left := Get_Left_Limit (A_Range);
+
+      Pos := Eval_Pos (Left);
+      case Get_Direction (A_Range) is
+         when Iir_To =>
+            Pos := Pos + Len -1;
+         when Iir_Downto =>
+            Pos := Pos - Len + 1;
+      end case;
+      if Len > 0
+        and then not Eval_Int_In_Range (Pos, Get_Range_Constraint (A_Type))
+      then
+         Error_Msg_Sem ("range length is beyond subtype length", A_Range);
+         Right := Left;
+      else
+         -- FIXME: what about nul range?
+         Right := Build_Discrete (Pos, A_Range);
+         Set_Literal_Origin (Right, Null_Iir);
+      end if;
+      Set_Right_Limit (A_Range, Right);
+   end Set_Right_Limit_By_Length;
+
+   --  Create a range of type A_TYPE whose length is LEN.
+   --  Note: only two nodes are created:
+   --  * the range_expression (node returned)
+   --  * the right bound
+   --  The left bound *IS NOT* created, but points to the left bound of A_TYPE.
+   function Create_Range_By_Length
+     (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type)
+     return Iir
+   is
+      Index_Constraint : Iir;
+      Constraint : Iir;
+   begin
+      --  The left limit must be locally static in order to compute the right
+      --  limit.
+      pragma Assert (Get_Type_Staticness (A_Type) = Locally);
+
+      Index_Constraint := Get_Range_Constraint (A_Type);
+      Constraint := Create_Iir (Iir_Kind_Range_Expression);
+      Set_Location (Constraint, Loc);
+      Set_Expr_Staticness (Constraint, Locally);
+      Set_Type (Constraint, A_Type);
+      Set_Left_Limit (Constraint, Get_Left_Limit (Index_Constraint));
+      Set_Direction (Constraint, Get_Direction (Index_Constraint));
+      Set_Right_Limit_By_Length (Constraint, Len);
+      return Constraint;
+   end Create_Range_By_Length;
+
+   function Create_Range_Subtype_From_Type (A_Type : Iir; Loc : Location_Type)
+                                          return Iir
+   is
+      Res : Iir;
+   begin
+      pragma Assert (Get_Type_Staticness (A_Type) = Locally);
+
+      case Get_Kind (A_Type) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            Res := Create_Iir (Get_Kind (A_Type));
+         when others =>
+            Error_Kind ("create_range_subtype_by_length", A_Type);
+      end case;
+      Set_Location (Res, Loc);
+      Set_Base_Type (Res, Get_Base_Type (A_Type));
+      Set_Type_Staticness (Res, Locally);
+
+      return Res;
+   end Create_Range_Subtype_From_Type;
+
+   --  Create a subtype of A_TYPE whose length is LEN.
+   --  This is used to create subtypes for strings or aggregates.
+   function Create_Range_Subtype_By_Length
+     (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type)
+     return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Range_Subtype_From_Type (A_Type, Loc);
+
+      Set_Range_Constraint (Res, Create_Range_By_Length (A_Type, Len, Loc));
+      return Res;
+   end Create_Range_Subtype_By_Length;
+
+   function Create_Unidim_Array_From_Index
+     (Base_Type : Iir; Index_Type : Iir; Loc : Iir)
+     return Iir_Array_Subtype_Definition
+   is
+      Res : Iir_Array_Subtype_Definition;
+   begin
+      Res := Create_Array_Subtype (Base_Type, Get_Location (Loc));
+      Append_Element (Get_Index_Subtype_List (Res), Index_Type);
+      Set_Type_Staticness (Res, Min (Get_Type_Staticness (Res),
+                                     Get_Type_Staticness (Index_Type)));
+      Set_Constraint_State (Res, Fully_Constrained);
+      Set_Index_Constraint_Flag (Res, True);
+      return Res;
+   end Create_Unidim_Array_From_Index;
+
+   function Create_Unidim_Array_By_Length
+     (Base_Type : Iir; Len : Iir_Int64; Loc : Iir)
+     return Iir_Array_Subtype_Definition
+   is
+      Index_Type : constant Iir := Get_Index_Type (Base_Type, 0);
+      N_Index_Type : Iir;
+   begin
+      N_Index_Type := Create_Range_Subtype_By_Length
+        (Index_Type, Len, Get_Location (Loc));
+      return Create_Unidim_Array_From_Index (Base_Type, N_Index_Type, Loc);
+   end Create_Unidim_Array_By_Length;
+
+   procedure Free_Eval_Static_Expr (Res : Iir; Orig : Iir) is
+   begin
+      if Res /= Orig and then Get_Literal_Origin (Res) = Orig then
+         Free_Iir (Res);
+      end if;
+   end Free_Eval_Static_Expr;
+
+   --  Free the result RES of Eval_String_Literal called with ORIG, if created.
+   procedure Free_Eval_String_Literal (Res : Iir; Orig : Iir)
+   is
+      L : Iir_List;
+   begin
+      if Res /= Orig then
+         L := Get_Simple_Aggregate_List (Res);
+         Destroy_Iir_List (L);
+         Free_Iir (Res);
+      end if;
+   end Free_Eval_String_Literal;
+
+   function Eval_String_Literal (Str : Iir) return Iir
+   is
+      Ptr : String_Fat_Acc;
+      Len : Nat32;
+   begin
+      case Get_Kind (Str) is
+         when Iir_Kind_String_Literal =>
+            declare
+               Element_Type : Iir;
+               Literal_List : Iir_List;
+               Lit : Iir;
+
+               List : Iir_List;
+            begin
+               Element_Type := Get_Base_Type
+                 (Get_Element_Subtype (Get_Base_Type (Get_Type (Str))));
+               Literal_List := Get_Enumeration_Literal_List (Element_Type);
+               List := Create_Iir_List;
+
+               Ptr := Get_String_Fat_Acc (Str);
+               Len := Get_String_Length (Str);
+
+               for I in 1 .. Len loop
+                  Lit := Find_Name_In_List
+                    (Literal_List,
+                     Name_Table.Get_Identifier (Ptr (I)));
+                  Append_Element (List, Lit);
+               end loop;
+               return Build_Simple_Aggregate (List, Str, Get_Type (Str));
+            end;
+
+         when Iir_Kind_Bit_String_Literal =>
+            declare
+               Str_Type : constant Iir := Get_Type (Str);
+               List : Iir_List;
+               Lit_0 : constant Iir := Get_Bit_String_0 (Str);
+               Lit_1 : constant Iir := Get_Bit_String_1 (Str);
+            begin
+               List := Create_Iir_List;
+
+               Ptr := Get_String_Fat_Acc (Str);
+               Len := Get_String_Length (Str);
+
+               for I in 1 .. Len loop
+                  case Ptr (I) is
+                     when '0' =>
+                        Append_Element (List, Lit_0);
+                     when '1' =>
+                        Append_Element (List, Lit_1);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+               return Build_Simple_Aggregate (List, Str, Str_Type);
+            end;
+
+         when Iir_Kind_Simple_Aggregate =>
+            return Str;
+
+         when others =>
+            Error_Kind ("eval_string_literal", Str);
+      end case;
+   end Eval_String_Literal;
+
+   function Eval_Monadic_Operator (Orig : Iir; Operand : Iir) return Iir
+   is
+      pragma Unsuppress (Overflow_Check);
+
+      Func : Iir_Predefined_Functions;
+   begin
+      if Get_Kind (Operand) = Iir_Kind_Overflow_Literal then
+         --  Propagate overflow.
+         return Build_Overflow (Orig);
+      end if;
+
+      Func := Get_Implicit_Definition (Get_Implementation (Orig));
+      case Func is
+         when Iir_Predefined_Integer_Negation =>
+            return Build_Integer (-Get_Value (Operand), Orig);
+         when Iir_Predefined_Integer_Identity =>
+            return Build_Integer (Get_Value (Operand), Orig);
+         when Iir_Predefined_Integer_Absolute =>
+            return Build_Integer (abs Get_Value (Operand), Orig);
+
+         when Iir_Predefined_Floating_Negation =>
+            return Build_Floating (-Get_Fp_Value (Operand), Orig);
+         when Iir_Predefined_Floating_Identity =>
+            return Build_Floating (Get_Fp_Value (Operand), Orig);
+         when Iir_Predefined_Floating_Absolute =>
+            return Build_Floating (abs Get_Fp_Value (Operand), Orig);
+
+         when Iir_Predefined_Physical_Negation =>
+            return Build_Physical (-Get_Physical_Value (Operand), Orig);
+         when Iir_Predefined_Physical_Identity =>
+            return Build_Physical (Get_Physical_Value (Operand), Orig);
+         when Iir_Predefined_Physical_Absolute =>
+            return Build_Physical (abs Get_Physical_Value (Operand), Orig);
+
+         when Iir_Predefined_Boolean_Not
+           | Iir_Predefined_Bit_Not =>
+            return Build_Enumeration (Get_Enum_Pos (Operand) = 0, Orig);
+
+         when Iir_Predefined_TF_Array_Not =>
+            declare
+               O_List : Iir_List;
+               R_List : Iir_List;
+               El : Iir;
+               Lit : Iir;
+            begin
+               O_List := Get_Simple_Aggregate_List
+                 (Eval_String_Literal (Operand));
+               R_List := Create_Iir_List;
+
+               for I in Natural loop
+                  El := Get_Nth_Element (O_List, I);
+                  exit when El = Null_Iir;
+                  case Get_Enum_Pos (El) is
+                     when 0 =>
+                        Lit := Bit_1;
+                     when 1 =>
+                        Lit := Bit_0;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+                  Append_Element (R_List, Lit);
+               end loop;
+               return Build_Simple_Aggregate
+                 (R_List, Orig, Get_Type (Operand));
+            end;
+         when others =>
+            Error_Internal (Orig, "eval_monadic_operator: " &
+                            Iir_Predefined_Functions'Image (Func));
+      end case;
+   exception
+      when Constraint_Error =>
+         --  Can happen for absolute.
+         Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         return Build_Overflow (Orig);
+   end Eval_Monadic_Operator;
+
+   function Eval_Dyadic_Bit_Array_Operator
+     (Expr : Iir;
+      Left, Right : Iir;
+      Func : Iir_Predefined_Dyadic_TF_Array_Functions)
+     return Iir
+   is
+      use Str_Table;
+      L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Left);
+      R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (Right);
+      Len : Nat32;
+      Id : String_Id;
+      Res : Iir;
+   begin
+      Len := Get_String_Length (Left);
+      if Len /= Get_String_Length (Right) then
+         Warning_Msg_Sem ("length of left and right operands mismatch", Expr);
+         return Build_Overflow (Expr);
+      else
+         Id := Start;
+         case Func is
+            when Iir_Predefined_TF_Array_And =>
+               for I in 1 .. Len loop
+                  case L_Str (I) is
+                     when '0' =>
+                        Append ('0');
+                     when '1' =>
+                        Append (R_Str (I));
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            when Iir_Predefined_TF_Array_Nand =>
+               for I in 1 .. Len loop
+                  case L_Str (I) is
+                     when '0' =>
+                        Append ('1');
+                     when '1' =>
+                        case R_Str (I) is
+                           when '0' =>
+                              Append ('1');
+                           when '1' =>
+                              Append ('0');
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            when Iir_Predefined_TF_Array_Or =>
+               for I in 1 .. Len loop
+                  case L_Str (I) is
+                     when '1' =>
+                        Append ('1');
+                     when '0' =>
+                        Append (R_Str (I));
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            when Iir_Predefined_TF_Array_Nor =>
+               for I in 1 .. Len loop
+                  case L_Str (I) is
+                     when '1' =>
+                        Append ('0');
+                     when '0' =>
+                        case R_Str (I) is
+                           when '0' =>
+                              Append ('1');
+                           when '1' =>
+                              Append ('0');
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            when Iir_Predefined_TF_Array_Xor =>
+               for I in 1 .. Len loop
+                  case L_Str (I) is
+                     when '1' =>
+                        case R_Str (I) is
+                           when '0' =>
+                              Append ('1');
+                           when '1' =>
+                              Append ('0');
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                     when '0' =>
+                        case R_Str (I) is
+                           when '0' =>
+                              Append ('0');
+                           when '1' =>
+                              Append ('1');
+                           when others =>
+                              raise Internal_Error;
+                        end case;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            when others =>
+               Error_Internal (Expr, "eval_dyadic_bit_array_functions: " &
+                               Iir_Predefined_Functions'Image (Func));
+         end case;
+         Finish;
+         Res := Build_String (Id, Len, Expr);
+
+         --  The unconstrained type is replaced by the constrained one.
+         Set_Type (Res, Get_Type (Left));
+         return Res;
+      end if;
+   end Eval_Dyadic_Bit_Array_Operator;
+
+   --  Return TRUE if VAL /= 0.
+   function Check_Integer_Division_By_Zero (Expr : Iir; Val : Iir)
+                                           return Boolean
+   is
+   begin
+      if Get_Value (Val) = 0 then
+         Warning_Msg_Sem ("division by 0", Expr);
+         return False;
+      else
+         return True;
+      end if;
+   end Check_Integer_Division_By_Zero;
+
+   function Eval_Shift_Operator
+     (Left, Right : Iir; Origin : Iir; Func : Iir_Predefined_Shift_Functions)
+     return Iir
+   is
+      Count : Iir_Int64;
+      Cnt : Natural;
+      Len : Natural;
+      Arr_List : Iir_List;
+      Res_List : Iir_List;
+      Dir_Left : Boolean;
+      E : Iir;
+   begin
+      Count := Get_Value (Right);
+      Arr_List := Get_Simple_Aggregate_List (Left);
+      Len := Get_Nbr_Elements (Arr_List);
+      --  LRM93 7.2.3
+      --  That is, if R is 0 or if L is a null array, the return value is L.
+      if Count = 0 or Len = 0 then
+         return Build_Simple_Aggregate (Arr_List, Origin, Get_Type (Left));
+      end if;
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Rol =>
+            Dir_Left := True;
+         when Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sra
+           | Iir_Predefined_Array_Ror =>
+            Dir_Left := False;
+      end case;
+      if Count < 0 then
+         Cnt := Natural (-Count);
+         Dir_Left := not Dir_Left;
+      else
+         Cnt := Natural (Count);
+      end if;
+
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl =>
+            declare
+               Enum_List : Iir_List;
+            begin
+               Enum_List := Get_Enumeration_Literal_List
+                 (Get_Base_Type (Get_Element_Subtype (Get_Type (Left))));
+               E := Get_Nth_Element (Enum_List, 0);
+            end;
+         when Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               E := Get_Nth_Element (Arr_List, Len - 1);
+            else
+               E := Get_Nth_Element (Arr_List, 0);
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            Cnt := Cnt mod Len;
+            if not Dir_Left then
+               Cnt := (Len - Cnt) mod Len;
+            end if;
+      end case;
+
+      Res_List := Create_Iir_List;
+
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               if Cnt < Len then
+                  for I in Cnt .. Len - 1 loop
+                     Append_Element
+                       (Res_List, Get_Nth_Element (Arr_List, I));
+                  end loop;
+               else
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Append_Element (Res_List, E);
+               end loop;
+            else
+               if Cnt > Len then
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Append_Element (Res_List, E);
+               end loop;
+               for I in Cnt .. Len - 1 loop
+                  Append_Element
+                    (Res_List, Get_Nth_Element (Arr_List, I - Cnt));
+               end loop;
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            for I in 1 .. Len loop
+               Append_Element
+                 (Res_List, Get_Nth_Element (Arr_List, Cnt));
+               Cnt := Cnt + 1;
+               if Cnt = Len then
+                  Cnt := 0;
+               end if;
+            end loop;
+      end case;
+      return Build_Simple_Aggregate (Res_List, Origin, Get_Type (Left));
+   end Eval_Shift_Operator;
+
+   --  Note: operands must be locally static.
+   function Eval_Concatenation
+     (Left, Right : Iir; Orig : Iir; Func : Iir_Predefined_Concat_Functions)
+     return Iir
+   is
+      Res_List : Iir_List;
+      L : Natural;
+      Res_Type : Iir;
+      Origin_Type : Iir;
+      Left_Aggr, Right_Aggr : Iir;
+      Left_List, Right_List : Iir_List;
+      Left_Len : Natural;
+   begin
+      Res_List := Create_Iir_List;
+      --  Do the concatenation.
+      --  Left:
+      case Func is
+         when Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            Append_Element (Res_List, Left);
+            Left_Len := 1;
+         when Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Array_Array_Concat =>
+            Left_Aggr := Eval_String_Literal (Left);
+            Left_List := Get_Simple_Aggregate_List (Left_Aggr);
+            Left_Len := Get_Nbr_Elements (Left_List);
+            for I in 0 .. Left_Len - 1 loop
+               Append_Element (Res_List, Get_Nth_Element (Left_List, I));
+            end loop;
+            Free_Eval_String_Literal (Left_Aggr, Left);
+      end case;
+      --  Right:
+      case Func is
+         when Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            Append_Element (Res_List, Right);
+         when Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Array_Array_Concat =>
+            Right_Aggr := Eval_String_Literal (Right);
+            Right_List := Get_Simple_Aggregate_List (Right_Aggr);
+            L := Get_Nbr_Elements (Right_List);
+            for I in 0 .. L - 1 loop
+               Append_Element (Res_List, Get_Nth_Element (Right_List, I));
+            end loop;
+            Free_Eval_String_Literal (Right_Aggr, Right);
+      end case;
+      L := Get_Nbr_Elements (Res_List);
+
+      --  Compute subtype...
+      Origin_Type := Get_Type (Orig);
+      Res_Type := Null_Iir;
+      if Func = Iir_Predefined_Array_Array_Concat
+        and then Left_Len = 0
+      then
+         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.
+            Res_Type := Get_Type (Right);
+         else
+            --  LRM93 7.2.4
+            --  If both operands are null arrays, then the result of the
+            --  concatenation is the right operand.
+            if Get_Nbr_Elements (Right_List) = 0 then
+               Res_Type := Get_Type (Right);
+            end if;
+         end if;
+      end if;
+      if Res_Type = Null_Iir then
+         if Flags.Vhdl_Std = Vhdl_87
+           and then (Func = Iir_Predefined_Array_Array_Concat
+                     or Func = Iir_Predefined_Array_Element_Concat)
+         then
+            --  LRM87 7.2.4
+            --  The left bound of the result is the left operand, [...]
+            --
+            --  LRM87 7.2.4
+            --  The direction of the result is the direction of the left
+            --  operand, [...]
+            declare
+               Left_Index : constant Iir :=
+                 Get_Index_Type (Get_Type (Left), 0);
+               Left_Range : constant Iir :=
+                 Get_Range_Constraint (Left_Index);
+               Ret_Type : constant Iir :=
+                 Get_Return_Type (Get_Implementation (Orig));
+               A_Range : Iir;
+               Index_Type : Iir;
+            begin
+               A_Range := Create_Iir (Iir_Kind_Range_Expression);
+               Set_Type (A_Range, Get_Index_Type (Ret_Type, 0));
+               Set_Expr_Staticness (A_Range, Locally);
+               Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range));
+               Set_Direction (A_Range, Get_Direction (Left_Range));
+               Location_Copy (A_Range, Orig);
+               Set_Right_Limit_By_Length (A_Range, Iir_Int64 (L));
+               Index_Type := Create_Range_Subtype_From_Type
+                 (Left_Index, Get_Location (Orig));
+               Set_Range_Constraint (Index_Type, A_Range);
+               Res_Type := Create_Unidim_Array_From_Index
+                 (Origin_Type, Index_Type, Orig);
+            end;
+         else
+            --  LRM93 7.2.4
+            --  Otherwise, 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.
+            Res_Type := Create_Unidim_Array_By_Length
+              (Origin_Type, Iir_Int64 (L), Orig);
+         end if;
+      end if;
+      --  FIXME: this is not necessarily a string, it may be an aggregate if
+      --  element type is not a character type.
+      return Build_Simple_Aggregate (Res_List, Orig, Res_Type);
+   end Eval_Concatenation;
+
+   function Eval_Array_Equality (Left, Right : Iir) return Boolean
+   is
+      Left_Val, Right_Val : Iir;
+      L_List : Iir_List;
+      R_List : Iir_List;
+      N : Natural;
+      Res : Boolean;
+   begin
+      Left_Val := Eval_String_Literal (Left);
+      Right_Val := Eval_String_Literal (Right);
+
+      L_List := Get_Simple_Aggregate_List (Left_Val);
+      R_List := Get_Simple_Aggregate_List (Right_Val);
+      N := Get_Nbr_Elements (L_List);
+      if N /= Get_Nbr_Elements (R_List) then
+         --  Cannot be equal if not the same length.
+         Res := False;
+      else
+         Res := True;
+         for I in 0 .. N - 1 loop
+            --  FIXME: this is wrong: (eg: evaluated lit)
+            if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then
+               Res := False;
+               exit;
+            end if;
+         end loop;
+      end if;
+
+      Free_Eval_Static_Expr (Left_Val, Left);
+      Free_Eval_Static_Expr (Right_Val, Right);
+
+      return Res;
+   end Eval_Array_Equality;
+
+   --  ORIG is either a dyadic operator or a function call.
+   function Eval_Dyadic_Operator (Orig : Iir; Imp : Iir; Left, Right : Iir)
+     return Iir
+   is
+      pragma Unsuppress (Overflow_Check);
+      Func : constant Iir_Predefined_Functions :=
+        Get_Implicit_Definition (Imp);
+   begin
+      if Get_Kind (Left) = Iir_Kind_Overflow_Literal
+        or else Get_Kind (Right) = Iir_Kind_Overflow_Literal
+      then
+         return Build_Overflow (Orig);
+      end if;
+
+      case Func is
+         when Iir_Predefined_Integer_Plus =>
+            return Build_Integer (Get_Value (Left) + Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Minus =>
+            return Build_Integer (Get_Value (Left) - Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Mul =>
+            return Build_Integer (Get_Value (Left) * Get_Value (Right), Orig);
+         when Iir_Predefined_Integer_Div =>
+            if Check_Integer_Division_By_Zero (Orig, Right) then
+               return Build_Integer
+                 (Get_Value (Left) / Get_Value (Right), Orig);
+            else
+               return Build_Overflow (Orig);
+            end if;
+         when Iir_Predefined_Integer_Mod =>
+            if Check_Integer_Division_By_Zero (Orig, Right) then
+               return Build_Integer
+                 (Get_Value (Left) mod Get_Value (Right), Orig);
+            else
+               return Build_Overflow (Orig);
+            end if;
+         when Iir_Predefined_Integer_Rem =>
+            if Check_Integer_Division_By_Zero (Orig, Right) then
+               return Build_Integer
+                 (Get_Value (Left) rem Get_Value (Right), Orig);
+            else
+               return Build_Overflow (Orig);
+            end if;
+         when Iir_Predefined_Integer_Exp =>
+            return Build_Integer
+              (Get_Value (Left) ** Integer (Get_Value (Right)), Orig);
+
+         when Iir_Predefined_Integer_Equality =>
+            return Build_Boolean (Get_Value (Left) = Get_Value (Right));
+         when Iir_Predefined_Integer_Inequality =>
+            return Build_Boolean (Get_Value (Left) /= Get_Value (Right));
+         when Iir_Predefined_Integer_Greater_Equal =>
+            return Build_Boolean (Get_Value (Left) >= Get_Value (Right));
+         when Iir_Predefined_Integer_Greater =>
+            return Build_Boolean (Get_Value (Left) > Get_Value (Right));
+         when Iir_Predefined_Integer_Less_Equal =>
+            return Build_Boolean (Get_Value (Left) <= Get_Value (Right));
+         when Iir_Predefined_Integer_Less =>
+            return Build_Boolean (Get_Value (Left) < Get_Value (Right));
+
+         when Iir_Predefined_Integer_Minimum =>
+            if Get_Value (Left) < Get_Value (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+         when Iir_Predefined_Integer_Maximum =>
+            if Get_Value (Left) > Get_Value (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+
+         when Iir_Predefined_Floating_Equality =>
+            return Build_Boolean (Get_Fp_Value (Left) = Get_Fp_Value (Right));
+         when Iir_Predefined_Floating_Inequality =>
+            return Build_Boolean (Get_Fp_Value (Left) /= Get_Fp_Value (Right));
+         when Iir_Predefined_Floating_Greater =>
+            return Build_Boolean (Get_Fp_Value (Left) > Get_Fp_Value (Right));
+         when Iir_Predefined_Floating_Greater_Equal =>
+            return Build_Boolean (Get_Fp_Value (Left) >= Get_Fp_Value (Right));
+         when Iir_Predefined_Floating_Less =>
+            return Build_Boolean (Get_Fp_Value (Left) < Get_Fp_Value (Right));
+         when Iir_Predefined_Floating_Less_Equal =>
+            return Build_Boolean (Get_Fp_Value (Left) <= Get_Fp_Value (Right));
+
+         when Iir_Predefined_Floating_Minus =>
+            return Build_Floating
+              (Get_Fp_Value (Left) - Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Plus =>
+            return Build_Floating
+              (Get_Fp_Value (Left) + Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Mul =>
+            return Build_Floating
+              (Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Floating_Div =>
+            if Get_Fp_Value (Right) = 0.0 then
+               Warning_Msg_Sem ("right operand of division is 0", Orig);
+               return Build_Overflow (Orig);
+            else
+               return Build_Floating
+                 (Get_Fp_Value (Left) / Get_Fp_Value (Right), Orig);
+            end if;
+         when Iir_Predefined_Floating_Exp =>
+            declare
+               Exp : Iir_Int64;
+               Res : Iir_Fp64;
+               Val : Iir_Fp64;
+            begin
+               Res := 1.0;
+               Val := Get_Fp_Value (Left);
+               Exp := abs Get_Value (Right);
+               while Exp /= 0 loop
+                  if Exp mod 2 = 1 then
+                     Res := Res * Val;
+                  end if;
+                  Exp := Exp / 2;
+                  Val := Val * Val;
+               end loop;
+               if Get_Value (Right) < 0 then
+                  Res := 1.0 / Res;
+               end if;
+               return Build_Floating (Res, Orig);
+            end;
+
+         when Iir_Predefined_Floating_Minimum =>
+            if Get_Fp_Value (Left) < Get_Fp_Value (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+         when Iir_Predefined_Floating_Maximum =>
+            if Get_Fp_Value (Left) > Get_Fp_Value (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+
+         when Iir_Predefined_Physical_Equality =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) = Get_Physical_Value (Right));
+         when Iir_Predefined_Physical_Inequality =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) /= Get_Physical_Value (Right));
+         when Iir_Predefined_Physical_Greater_Equal =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) >= Get_Physical_Value (Right));
+         when Iir_Predefined_Physical_Greater =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) > Get_Physical_Value (Right));
+         when Iir_Predefined_Physical_Less_Equal =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) <= Get_Physical_Value (Right));
+         when Iir_Predefined_Physical_Less =>
+            return Build_Boolean
+              (Get_Physical_Value (Left) < Get_Physical_Value (Right));
+
+         when Iir_Predefined_Physical_Physical_Div =>
+            return Build_Integer
+              (Get_Physical_Value (Left) / Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Integer_Div =>
+            return Build_Physical
+              (Get_Physical_Value (Left) / Get_Value (Right), Orig);
+         when Iir_Predefined_Physical_Minus =>
+            return Build_Physical
+              (Get_Physical_Value (Left) - Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Plus =>
+            return Build_Physical
+              (Get_Physical_Value (Left) + Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Integer_Physical_Mul =>
+            return Build_Physical
+              (Get_Value (Left) * Get_Physical_Value (Right), Orig);
+         when Iir_Predefined_Physical_Integer_Mul =>
+            return Build_Physical
+              (Get_Physical_Value (Left) * Get_Value (Right), Orig);
+         when Iir_Predefined_Real_Physical_Mul =>
+            --  FIXME: overflow??
+            return Build_Physical
+              (Iir_Int64 (Get_Fp_Value (Left)
+                          * Iir_Fp64 (Get_Physical_Value (Right))), Orig);
+         when Iir_Predefined_Physical_Real_Mul =>
+            --  FIXME: overflow??
+            return Build_Physical
+              (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left))
+                          * Get_Fp_Value (Right)), Orig);
+         when Iir_Predefined_Physical_Real_Div =>
+            --  FIXME: overflow??
+            return Build_Physical
+              (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left))
+                          / Get_Fp_Value (Right)), Orig);
+
+         when Iir_Predefined_Physical_Minimum =>
+            return Build_Physical (Iir_Int64'Min (Get_Physical_Value (Left),
+                                                  Get_Physical_Value (Right)),
+                                   Orig);
+         when Iir_Predefined_Physical_Maximum =>
+            return Build_Physical (Iir_Int64'Max (Get_Physical_Value (Left),
+                                                  Get_Physical_Value (Right)),
+                                   Orig);
+
+         when Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Array_Array_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            return Eval_Concatenation (Left, Right, Orig, Func);
+
+         when Iir_Predefined_Enum_Equality
+           | Iir_Predefined_Bit_Match_Equality =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) = Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Inequality
+           | Iir_Predefined_Bit_Match_Inequality =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) /= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Greater_Equal
+           | Iir_Predefined_Bit_Match_Greater_Equal =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) >= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Greater
+           | Iir_Predefined_Bit_Match_Greater =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) > Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Less_Equal
+           | Iir_Predefined_Bit_Match_Less_Equal =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) <= Get_Enum_Pos (Right), Orig);
+         when Iir_Predefined_Enum_Less
+           | Iir_Predefined_Bit_Match_Less =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) < Get_Enum_Pos (Right), Orig);
+
+         when Iir_Predefined_Enum_Minimum =>
+            if Get_Enum_Pos (Left) < Get_Enum_Pos (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+         when Iir_Predefined_Enum_Maximum =>
+            if Get_Enum_Pos (Left) > Get_Enum_Pos (Right) then
+               return Left;
+            else
+               return Right;
+            end if;
+
+         when Iir_Predefined_Boolean_And
+           | Iir_Predefined_Bit_And =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Nand
+           | Iir_Predefined_Bit_Nand =>
+            return Build_Enumeration
+              (not (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1),
+               Orig);
+         when Iir_Predefined_Boolean_Or
+           | Iir_Predefined_Bit_Or =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Nor
+           | Iir_Predefined_Bit_Nor =>
+            return Build_Enumeration
+              (not (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1),
+               Orig);
+         when Iir_Predefined_Boolean_Xor
+           | Iir_Predefined_Bit_Xor =>
+            return Build_Enumeration
+              (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1, Orig);
+         when Iir_Predefined_Boolean_Xnor
+           | Iir_Predefined_Bit_Xnor =>
+            return Build_Enumeration
+              (not (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1),
+               Orig);
+
+         when Iir_Predefined_Dyadic_TF_Array_Functions =>
+            --  FIXME: only for bit ?
+            return Eval_Dyadic_Bit_Array_Operator (Orig, Left, Right, Func);
+
+         when Iir_Predefined_Universal_R_I_Mul =>
+            return Build_Floating
+              (Get_Fp_Value (Left) * Iir_Fp64 (Get_Value (Right)), Orig);
+         when Iir_Predefined_Universal_I_R_Mul =>
+            return Build_Floating
+              (Iir_Fp64 (Get_Value (Left)) * Get_Fp_Value (Right), Orig);
+         when Iir_Predefined_Universal_R_I_Div =>
+            return Build_Floating
+              (Get_Fp_Value (Left) / Iir_Fp64 (Get_Value (Right)), Orig);
+
+         when Iir_Predefined_Array_Equality =>
+            return Build_Boolean (Eval_Array_Equality (Left, Right));
+
+         when Iir_Predefined_Array_Inequality =>
+            return Build_Boolean (not Eval_Array_Equality (Left, Right));
+
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra
+           | Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            declare
+               Left_Aggr : Iir;
+               Res : Iir;
+            begin
+               Left_Aggr := Eval_String_Literal (Left);
+               Res := Eval_Shift_Operator (Left_Aggr, Right, Orig, Func);
+               Free_Eval_String_Literal (Left_Aggr, Left);
+               return Res;
+            end;
+
+         when Iir_Predefined_Array_Less
+           | Iir_Predefined_Array_Less_Equal
+           | Iir_Predefined_Array_Greater
+           | Iir_Predefined_Array_Greater_Equal =>
+            --  FIXME: todo.
+            Error_Internal (Orig, "eval_dyadic_operator: " &
+                            Iir_Predefined_Functions'Image (Func));
+
+         when Iir_Predefined_Boolean_Not
+           | Iir_Predefined_Boolean_Rising_Edge
+           | Iir_Predefined_Boolean_Falling_Edge
+           | Iir_Predefined_Bit_Not
+           | Iir_Predefined_Bit_Rising_Edge
+           | Iir_Predefined_Bit_Falling_Edge
+           | Iir_Predefined_Integer_Absolute
+           | Iir_Predefined_Integer_Identity
+           | Iir_Predefined_Integer_Negation
+           | Iir_Predefined_Floating_Absolute
+           | Iir_Predefined_Floating_Negation
+           | Iir_Predefined_Floating_Identity
+           | Iir_Predefined_Physical_Absolute
+           | Iir_Predefined_Physical_Identity
+           | Iir_Predefined_Physical_Negation
+           | Iir_Predefined_Error
+           | Iir_Predefined_Record_Equality
+           | Iir_Predefined_Record_Inequality
+           | Iir_Predefined_Access_Equality
+           | Iir_Predefined_Access_Inequality
+           | Iir_Predefined_TF_Array_Not
+           | Iir_Predefined_Now_Function
+           | Iir_Predefined_Deallocate
+           | Iir_Predefined_Write
+           | Iir_Predefined_Read
+           | Iir_Predefined_Read_Length
+           | Iir_Predefined_Flush
+           | Iir_Predefined_File_Open
+           | Iir_Predefined_File_Open_Status
+           | Iir_Predefined_File_Close
+           | Iir_Predefined_Endfile
+           | Iir_Predefined_Attribute_Image
+           | Iir_Predefined_Attribute_Value
+           | Iir_Predefined_Attribute_Pos
+           | Iir_Predefined_Attribute_Val
+           | Iir_Predefined_Attribute_Succ
+           | Iir_Predefined_Attribute_Pred
+           | Iir_Predefined_Attribute_Rightof
+           | Iir_Predefined_Attribute_Leftof
+           | Iir_Predefined_Attribute_Left
+           | Iir_Predefined_Attribute_Right
+           | Iir_Predefined_Attribute_Event
+           | Iir_Predefined_Attribute_Active
+           | Iir_Predefined_Attribute_Last_Value
+           | Iir_Predefined_Attribute_Last_Event
+           | Iir_Predefined_Attribute_Last_Active
+           | Iir_Predefined_Attribute_Driving
+           | Iir_Predefined_Attribute_Driving_Value
+           | Iir_Predefined_Array_Char_To_String
+           | Iir_Predefined_Bit_Vector_To_Ostring
+           | Iir_Predefined_Bit_Vector_To_Hstring =>
+            --  Not binary or never locally static.
+            Error_Internal (Orig, "eval_dyadic_operator: " &
+                              Iir_Predefined_Functions'Image (Func));
+
+         when Iir_Predefined_Bit_Condition =>
+            raise Internal_Error;
+
+         when Iir_Predefined_Array_Minimum
+           | Iir_Predefined_Array_Maximum
+           | Iir_Predefined_Vector_Minimum
+           | Iir_Predefined_Vector_Maximum =>
+            raise Internal_Error;
+
+         when Iir_Predefined_Std_Ulogic_Match_Equality
+           | Iir_Predefined_Std_Ulogic_Match_Inequality
+           | Iir_Predefined_Std_Ulogic_Match_Less
+           | Iir_Predefined_Std_Ulogic_Match_Less_Equal
+           | Iir_Predefined_Std_Ulogic_Match_Greater
+           | Iir_Predefined_Std_Ulogic_Match_Greater_Equal =>
+            -- TODO
+            raise Internal_Error;
+
+         when Iir_Predefined_Enum_To_String
+           | Iir_Predefined_Integer_To_String
+           | Iir_Predefined_Floating_To_String
+           | Iir_Predefined_Real_To_String_Digits
+           | Iir_Predefined_Real_To_String_Format
+           | Iir_Predefined_Physical_To_String
+           | Iir_Predefined_Time_To_String_Unit =>
+            --  TODO
+            raise Internal_Error;
+
+         when Iir_Predefined_TF_Array_Element_And
+           | Iir_Predefined_TF_Element_Array_And
+           | Iir_Predefined_TF_Array_Element_Or
+           | Iir_Predefined_TF_Element_Array_Or
+           | Iir_Predefined_TF_Array_Element_Nand
+           | Iir_Predefined_TF_Element_Array_Nand
+           | Iir_Predefined_TF_Array_Element_Nor
+           | Iir_Predefined_TF_Element_Array_Nor
+           | Iir_Predefined_TF_Array_Element_Xor
+           | Iir_Predefined_TF_Element_Array_Xor
+           | Iir_Predefined_TF_Array_Element_Xnor
+           | Iir_Predefined_TF_Element_Array_Xnor =>
+            --  TODO
+            raise Internal_Error;
+
+         when Iir_Predefined_TF_Reduction_And
+           | Iir_Predefined_TF_Reduction_Or
+           | Iir_Predefined_TF_Reduction_Nand
+           | Iir_Predefined_TF_Reduction_Nor
+           | Iir_Predefined_TF_Reduction_Xor
+           | Iir_Predefined_TF_Reduction_Xnor
+           | Iir_Predefined_TF_Reduction_Not =>
+            --  TODO
+            raise Internal_Error;
+
+         when Iir_Predefined_Bit_Array_Match_Equality
+           | Iir_Predefined_Bit_Array_Match_Inequality
+           | Iir_Predefined_Std_Ulogic_Array_Match_Equality
+           | Iir_Predefined_Std_Ulogic_Array_Match_Inequality =>
+            --  TODO
+            raise Internal_Error;
+      end case;
+   exception
+      when Constraint_Error =>
+         Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         return Build_Overflow (Orig);
+   end Eval_Dyadic_Operator;
+
+   --  Evaluate any array attribute, return the type for the prefix.
+   function Eval_Array_Attribute (Attr : Iir) return Iir
+   is
+      Prefix : Iir;
+      Prefix_Type : Iir;
+   begin
+      Prefix := Get_Prefix (Attr);
+      case Get_Kind (Prefix) is
+         when Iir_Kinds_Object_Declaration --  FIXME: remove
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Implicit_Dereference =>
+            Prefix_Type := Get_Type (Prefix);
+         when Iir_Kind_Attribute_Value =>
+            --  The type of the attribute declaration may be unconstrained.
+            Prefix_Type := Get_Type
+              (Get_Expression (Get_Attribute_Specification (Prefix)));
+         when Iir_Kinds_Subtype_Definition =>
+            Prefix_Type := Prefix;
+         when Iir_Kinds_Denoting_Name =>
+            Prefix_Type := Get_Type (Prefix);
+         when others =>
+            Error_Kind ("eval_array_attribute", Prefix);
+      end case;
+      if Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition then
+         Error_Kind ("eval_array_attribute(2)", Prefix_Type);
+      end if;
+      return Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type),
+                              Natural (Get_Value (Get_Parameter (Attr)) - 1));
+   end Eval_Array_Attribute;
+
+   function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir
+   is
+      use Str_Table;
+      Img : String (1 .. 24); --  23 is enough, 24 is rounded.
+      L : Natural;
+      V : Iir_Int64;
+      Id : String_Id;
+   begin
+      V := Val;
+      L := Img'Last;
+      loop
+         Img (L) := Character'Val (Character'Pos ('0') + abs (V rem 10));
+         V := V / 10;
+         L := L - 1;
+         exit when V = 0;
+      end loop;
+      if Val < 0 then
+         Img (L) := '-';
+         L := L - 1;
+      end if;
+      Id := Start;
+      for I in L + 1 .. Img'Last loop
+         Append (Img (I));
+      end loop;
+      Finish;
+      return Build_String (Id, Int32 (Img'Last - L), Orig);
+   end Eval_Integer_Image;
+
+   function Eval_Floating_Image (Val : Iir_Fp64; Orig : Iir) return Iir
+   is
+      use Str_Table;
+      Id : String_Id;
+
+      --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+      --  + exp_digits (4) -> 24.
+      Str : String (1 .. 25);
+      P : Natural;
+      V : Iir_Fp64;
+      Vd : Iir_Fp64;
+      Exp : Integer;
+      D : Integer;
+      B : Boolean;
+
+      Res : Iir;
+   begin
+      --  Handle sign.
+      if Val < 0.0 then
+         Str (1) := '-';
+         P := 1;
+         V := -Val;
+      else
+         P := 0;
+         V := Val;
+      end if;
+
+      --  Compute the mantissa.
+      --  FIXME: should do a dichotomy.
+      if V  = 0.0 then
+         Exp := 0;
+      elsif V < 1.0 then
+         Exp := -1;
+         while V * (10.0 ** (-Exp)) < 1.0 loop
+            Exp := Exp - 1;
+         end loop;
+      else
+         Exp := 0;
+         while V / (10.0 ** Exp) >= 10.0 loop
+            Exp := Exp + 1;
+         end loop;
+      end if;
+
+      --  Normalize VAL: in [0; 10[
+      if Exp >= 0 then
+         V := V / (10.0 ** Exp);
+      else
+         V := V * 10.0 ** (-Exp);
+      end if;
+
+      for I in 0 .. 15 loop
+         Vd := Iir_Fp64'Truncation (V);
+         P := P + 1;
+         Str (P) := Character'Val (48 + Integer (Vd));
+         V := (V - Vd) * 10.0;
+
+         if I = 0 then
+            P := P + 1;
+            Str (P) := '.';
+         end if;
+         exit when I > 0 and V < 10.0 ** (I + 1 - 15);
+      end loop;
+
+      if Exp /= 0 then
+         --  LRM93 14.3
+         --  if the exponent is present, the `e' is written as a lower case
+         --  character.
+         P := P + 1;
+         Str (P) := 'e';
+
+         if Exp < 0 then
+            P := P + 1;
+            Str (P) := '-';
+            Exp := -Exp;
+         end if;
+         B := False;
+         for I in 0 .. 4 loop
+            D := (Exp / 10000) mod 10;
+            if D /= 0 or B or I = 4 then
+               P := P + 1;
+               Str (P) := Character'Val (48 + D);
+               B := True;
+            end if;
+            Exp := (Exp - D * 10000) * 10;
+         end loop;
+      end if;
+
+      Id := Start;
+      for I in 1 .. P loop
+         Append (Str (I));
+      end loop;
+      Finish;
+      Res := Build_String (Id, Int32 (P), Orig);
+      --  FIXME: this is not correct since the type is *not* constrained.
+      Set_Type (Res, Create_Unidim_Array_By_Length
+                (Get_Type (Orig), Iir_Int64 (P), Orig));
+      return Res;
+   end Eval_Floating_Image;
+
+   function Eval_Enumeration_Image (Enum, Expr : Iir) return Iir
+   is
+      Name : constant String := Image_Identifier (Enum);
+      Image_Id : constant String_Id := Str_Table.Start;
+   begin
+      for i in Name'range loop
+         Str_Table.Append(Name(i));
+      end loop;
+      Str_Table.Finish;
+      return Build_String (Image_Id, Nat32(Name'Length), Expr);
+   end Eval_Enumeration_Image;
+
+   function Build_Enumeration_Value (Val : String; Enum, Expr : Iir) return Iir
+   is
+      Value : String (Val'range);
+      List  : constant Iir_List := Get_Enumeration_Literal_List (Enum);
+   begin
+      for I in Val'range loop
+         Value (I) := Ada.Characters.Handling.To_Lower (Val (I));
+      end loop;
+      for I in 0 .. Get_Nbr_Elements (List) - 1 loop
+         if Value = Image_Identifier (Get_Nth_Element (List, I)) then
+            return Build_Enumeration (Iir_Index32 (I), Expr);
+         end if;
+      end loop;
+      Warning_Msg_Sem ("value """ & Value & """ not in enumeration", Expr);
+      return Build_Overflow (Expr);
+   end Build_Enumeration_Value;
+
+   function Eval_Physical_Image (Phys, Expr: Iir) return Iir
+   is
+      --  Reduces to the base unit (e.g. femtoseconds).
+      Value : constant String := Iir_Int64'Image (Get_Physical_Value (Phys));
+      Unit : constant Iir :=
+        Get_Primary_Unit (Get_Base_Type (Get_Type (Phys)));
+      UnitName : constant String := Image_Identifier (Unit);
+      Image_Id : constant String_Id := Str_Table.Start;
+      Length : Nat32 := Value'Length + UnitName'Length + 1;
+   begin
+      for I in Value'range loop
+         -- Suppress the Ada +ve integer'image leading space
+         if I > Value'first or else Value (I) /= ' ' then
+            Str_Table.Append (Value (I));
+         else
+            Length := Length - 1;
+         end if;
+      end loop;
+      Str_Table.Append (' ');
+      for I in UnitName'range loop
+         Str_Table.Append (UnitName (I));
+      end loop;
+      Str_Table.Finish;
+
+      return Build_String (Image_Id, Length, Expr);
+   end Eval_Physical_Image;
+
+   function Build_Physical_Value (Val: String; Phys_Type, Expr: Iir) return Iir
+   is
+      function White (C : in Character) return Boolean is
+         NBSP : constant Character := Character'Val (160);
+         HT   : constant Character := Character'Val (9);
+      begin
+         return C = ' ' or C = NBSP or C = HT;
+      end White;
+
+      UnitName : String (Val'range);
+      Mult : Iir_Int64;
+      Sep : Natural;
+      Found_Unit : Boolean := false;
+      Found_Real : Boolean := false;
+      Unit : Iir := Get_Primary_Unit (Phys_Type);
+   begin
+      -- Separate string into numeric value and make lowercase unit.
+      for I in reverse Val'range loop
+         UnitName (I) := Ada.Characters.Handling.To_Lower (Val (I));
+         if White (Val (I)) and Found_Unit then
+            Sep := I;
+            exit;
+         else
+            Found_Unit := true;
+         end if;
+      end loop;
+
+      -- Unit name  is UnitName(Sep+1..Unit'Last)
+      for I in Val'First .. Sep loop
+         if Val (I) = '.' then
+            Found_Real := true;
+         end if;
+      end loop;
+
+      -- Chain down the units looking for matching one
+      Unit := Get_Primary_Unit (Phys_Type);
+      while Unit /= Null_Iir loop
+         exit when (UnitName (Sep + 1 .. UnitName'Last)
+                      = Image_Identifier (Unit));
+         Unit := Get_Chain (Unit);
+      end loop;
+      if Unit = Null_Iir then
+         Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last)
+                         & """ not in physical type", Expr);
+         return Build_Overflow (Expr);
+      end if;
+
+      Mult := Get_Value (Get_Physical_Unit_Value (Unit));
+      if Found_Real then
+         return Build_Physical
+           (Iir_Int64 (Iir_Fp64'Value (Val (Val'First .. Sep))
+                         * Iir_Fp64 (Mult)),
+            Expr);
+      else
+         return Build_Physical
+           (Iir_Int64'Value (Val (Val'First .. Sep)) * Mult, Expr);
+      end if;
+   end Build_Physical_Value;
+
+   function Eval_Incdec (Expr : Iir; N : Iir_Int64; Origin : Iir) return Iir
+   is
+      P : Iir_Int64;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Integer_Literal =>
+            return Build_Integer (Get_Value (Expr) + N, Origin);
+         when Iir_Kind_Enumeration_Literal =>
+            P := Iir_Int64 (Get_Enum_Pos (Expr)) + N;
+            if P < 0 then
+               Warning_Msg_Sem ("static constant violates bounds", Expr);
+               return Build_Overflow (Origin);
+            else
+               return Build_Enumeration (Iir_Index32 (P), Origin);
+            end if;
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Unit_Declaration =>
+            return Build_Physical (Get_Physical_Value (Expr) + N, Origin);
+         when others =>
+            Error_Kind ("eval_incdec", Expr);
+      end case;
+   end Eval_Incdec;
+
+   function Convert_Range (Rng : Iir; Res_Type : Iir; Loc : Iir) return Iir
+   is
+      Res_Btype : Iir;
+
+      function Create_Bound (Val : Iir) return Iir
+      is
+         R : Iir;
+      begin
+         R := Create_Iir (Iir_Kind_Integer_Literal);
+         Location_Copy (R, Loc);
+         Set_Value (R, Get_Value (Val));
+         Set_Type (R, Res_Btype);
+         Set_Expr_Staticness (R, Locally);
+         return R;
+      end Create_Bound;
+
+      Res : Iir;
+   begin
+      Res_Btype := Get_Base_Type (Res_Type);
+      Res := Create_Iir (Iir_Kind_Range_Expression);
+      Location_Copy (Res, Loc);
+      Set_Type (Res, Res_Btype);
+      Set_Left_Limit (Res, Create_Bound (Get_Left_Limit (Rng)));
+      Set_Right_Limit (Res, Create_Bound (Get_Right_Limit (Rng)));
+      Set_Direction (Res, Get_Direction (Rng));
+      Set_Expr_Staticness (Res, Locally);
+      return Res;
+   end Convert_Range;
+
+   function Eval_Array_Type_Conversion (Conv : Iir; Val : Iir) return Iir
+   is
+      Conv_Type : constant Iir := Get_Type (Conv);
+      Val_Type : constant Iir := Get_Type (Val);
+      Conv_Index_Type : constant Iir := Get_Index_Type (Conv_Type, 0);
+      Val_Index_Type : constant Iir := Get_Index_Type (Val_Type, 0);
+      Index_Type : Iir;
+      Res_Type : Iir;
+      Res : Iir;
+      Rng : Iir;
+   begin
+      --  The expression is either a simple aggregate or a (bit) string.
+      Res := Build_Constant (Val, Conv);
+      case Get_Kind (Conv_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            Set_Type (Res, Conv_Type);
+            if Eval_Discrete_Type_Length (Conv_Index_Type)
+              /= Eval_Discrete_Type_Length (Val_Index_Type)
+            then
+               Warning_Msg_Sem
+                 ("non matching length in type conversion", Conv);
+               return Build_Overflow (Conv);
+            end if;
+            return Res;
+         when Iir_Kind_Array_Type_Definition =>
+            if Get_Base_Type (Conv_Index_Type) = Get_Base_Type (Val_Index_Type)
+            then
+               Index_Type := Val_Index_Type;
+            else
+               --  Convert the index range.
+               --  It is an integer type.
+               Rng := Convert_Range (Get_Range_Constraint (Val_Index_Type),
+                                     Conv_Index_Type, Conv);
+               Index_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+               Location_Copy (Index_Type, Conv);
+               Set_Range_Constraint (Index_Type, Rng);
+               Set_Base_Type (Index_Type, Get_Base_Type (Conv_Index_Type));
+               Set_Type_Staticness (Index_Type, Locally);
+            end if;
+            Res_Type := Create_Unidim_Array_From_Index
+              (Get_Base_Type (Conv_Type), Index_Type, Conv);
+            Set_Type (Res, Res_Type);
+            Set_Type_Conversion_Subtype (Conv, Res_Type);
+            return Res;
+         when others =>
+            Error_Kind ("eval_array_type_conversion", Conv_Type);
+      end case;
+   end Eval_Array_Type_Conversion;
+
+   function Eval_Type_Conversion (Expr : Iir) return Iir
+   is
+      Val : Iir;
+      Val_Type : Iir;
+      Conv_Type : Iir;
+   begin
+      Val := Eval_Static_Expr (Get_Expression (Expr));
+      Val_Type := Get_Base_Type (Get_Type (Val));
+      Conv_Type := Get_Base_Type (Get_Type (Expr));
+      if Conv_Type = Val_Type then
+         return Build_Constant (Val, Expr);
+      end if;
+      case Get_Kind (Conv_Type) is
+         when Iir_Kind_Integer_Type_Definition =>
+            case Get_Kind (Val_Type) is
+               when Iir_Kind_Integer_Type_Definition =>
+                  return Build_Integer (Get_Value (Val), Expr);
+               when Iir_Kind_Floating_Type_Definition =>
+                  return Build_Integer (Iir_Int64 (Get_Fp_Value (Val)), Expr);
+               when others =>
+                  Error_Kind ("eval_type_conversion(1)", Val_Type);
+            end case;
+         when Iir_Kind_Floating_Type_Definition =>
+            case Get_Kind (Val_Type) is
+               when Iir_Kind_Integer_Type_Definition =>
+                  return Build_Floating (Iir_Fp64 (Get_Value (Val)), Expr);
+               when Iir_Kind_Floating_Type_Definition =>
+                  return Build_Floating (Get_Fp_Value (Val), Expr);
+               when others =>
+                  Error_Kind ("eval_type_conversion(2)", Val_Type);
+            end case;
+         when Iir_Kind_Array_Type_Definition =>
+            return Eval_Array_Type_Conversion (Expr, Val);
+         when others =>
+            Error_Kind ("eval_type_conversion(3)", Conv_Type);
+      end case;
+   end Eval_Type_Conversion;
+
+   function Eval_Physical_Literal (Expr : Iir) return Iir
+   is
+      Val : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Physical_Fp_Literal =>
+            Val := Expr;
+         when Iir_Kind_Physical_Int_Literal =>
+            if Get_Named_Entity (Get_Unit_Name (Expr))
+              = Get_Primary_Unit (Get_Base_Type (Get_Type (Expr)))
+            then
+               return Expr;
+            else
+               Val := Expr;
+            end if;
+         when Iir_Kind_Unit_Declaration =>
+            Val := Expr;
+         when Iir_Kinds_Denoting_Name =>
+            Val := Get_Named_Entity (Expr);
+            pragma Assert (Get_Kind (Val) = Iir_Kind_Unit_Declaration);
+         when others =>
+            Error_Kind ("eval_physical_literal", Expr);
+      end case;
+      return Build_Physical (Get_Physical_Value (Val), Expr);
+   end Eval_Physical_Literal;
+
+   function Eval_Static_Expr (Expr: Iir) return Iir
+   is
+      Res : Iir;
+      Val : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kinds_Denoting_Name =>
+            return Eval_Static_Expr (Get_Named_Entity (Expr));
+
+         when Iir_Kind_Integer_Literal
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            return Expr;
+         when Iir_Kind_Constant_Declaration =>
+            Val := Eval_Static_Expr (Get_Default_Value (Expr));
+            --  Type of the expression should be type of the constant
+            --  declaration at least in case of array subtype.
+            --  If the constant is declared as an unconstrained array, get type
+            --  from the default value.
+            --  FIXME: handle this during semantisation of the declaration:
+            --    add an implicit subtype conversion node ?
+            --  FIXME: this currently creates a node at each evalation.
+            if Get_Kind (Get_Type (Val)) = Iir_Kind_Array_Type_Definition then
+               Res := Build_Constant (Val, Expr);
+               Set_Type (Res, Get_Type (Val));
+               return Res;
+            else
+               return Val;
+            end if;
+         when Iir_Kind_Object_Alias_Declaration =>
+            return Eval_Static_Expr (Get_Name (Expr));
+         when Iir_Kind_Unit_Declaration =>
+            return Get_Physical_Unit_Value (Expr);
+         when Iir_Kind_Simple_Aggregate =>
+            return Expr;
+
+         when Iir_Kind_Parenthesis_Expression =>
+            return Eval_Static_Expr (Get_Expression (Expr));
+         when Iir_Kind_Qualified_Expression =>
+            return Eval_Static_Expr (Get_Expression (Expr));
+         when Iir_Kind_Type_Conversion =>
+            return Eval_Type_Conversion (Expr);
+
+         when Iir_Kinds_Monadic_Operator =>
+            declare
+               Operand : Iir;
+            begin
+               Operand := Eval_Static_Expr (Get_Operand (Expr));
+               return Eval_Monadic_Operator (Expr, Operand);
+            end;
+         when Iir_Kinds_Dyadic_Operator =>
+            declare
+               Left : constant Iir := Get_Left (Expr);
+               Right : constant Iir := Get_Right (Expr);
+               Left_Val, Right_Val : Iir;
+               Res : Iir;
+            begin
+               Left_Val := Eval_Static_Expr (Left);
+               Right_Val := Eval_Static_Expr (Right);
+
+               Res := Eval_Dyadic_Operator
+                 (Expr, Get_Implementation (Expr), Left_Val, Right_Val);
+
+               Free_Eval_Static_Expr (Left_Val, Left);
+               Free_Eval_Static_Expr (Right_Val, Right);
+
+               return Res;
+            end;
+
+         when Iir_Kind_Attribute_Name =>
+            --  An attribute name designates an attribute value.
+            declare
+               Attr_Val : constant Iir := Get_Named_Entity (Expr);
+               Attr_Expr : constant Iir :=
+                 Get_Expression (Get_Attribute_Specification (Attr_Val));
+               Val : Iir;
+            begin
+               Val := Eval_Static_Expr (Attr_Expr);
+               --  FIXME: see constant_declaration.
+               --  Currently, this avoids weird nodes, such as a string literal
+               --  whose type is an unconstrained array type.
+               Res := Build_Constant (Val, Expr);
+               Set_Type (Res, Get_Type (Val));
+               return Res;
+            end;
+
+         when Iir_Kind_Pos_Attribute =>
+            declare
+               Param : constant Iir := Get_Parameter (Expr);
+               Val : Iir;
+               Res : Iir;
+            begin
+               Val := Eval_Static_Expr (Param);
+               --  FIXME: check bounds, handle overflow.
+               Res := Build_Integer (Eval_Pos (Val), Expr);
+               Free_Eval_Static_Expr (Val, Param);
+               return Res;
+            end;
+         when Iir_Kind_Val_Attribute =>
+            declare
+               Expr_Type : constant Iir := Get_Type (Expr);
+               Val_Expr : Iir;
+               Val : Iir_Int64;
+            begin
+               Val_Expr := Eval_Static_Expr (Get_Parameter (Expr));
+               Val := Eval_Pos (Val_Expr);
+               --  Note: the type of 'val is a base type.
+               --  FIXME: handle VHDL93 restrictions.
+               if Get_Kind (Expr_Type) = Iir_Kind_Enumeration_Type_Definition
+                 and then
+                 not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type))
+               then
+                  Warning_Msg_Sem
+                    ("static argument out of the type range", Expr);
+                  return Build_Overflow (Expr);
+               end if;
+               if Get_Kind (Get_Base_Type (Get_Type (Expr)))
+                 = Iir_Kind_Physical_Type_Definition
+               then
+                  return Build_Physical (Val, Expr);
+               else
+                  return Build_Discrete (Val, Expr);
+               end if;
+            end;
+         when Iir_Kind_Image_Attribute =>
+            declare
+               Param : Iir;
+               Param_Type : Iir;
+            begin
+               Param := Get_Parameter (Expr);
+               Param := Eval_Static_Expr (Param);
+               Set_Parameter (Expr, Param);
+               Param_Type := Get_Base_Type (Get_Type (Param));
+               case Get_Kind (Param_Type) is
+                  when Iir_Kind_Integer_Type_Definition =>
+                     return Eval_Integer_Image (Get_Value (Param), Expr);
+                  when Iir_Kind_Floating_Type_Definition =>
+                     return Eval_Floating_Image (Get_Fp_Value (Param), Expr);
+                  when Iir_Kind_Enumeration_Type_Definition =>
+                     return Eval_Enumeration_Image (Param, Expr);
+                  when Iir_Kind_Physical_Type_Definition =>
+                     return Eval_Physical_Image (Param, Expr);
+                  when others =>
+                     Error_Kind ("eval_static_expr('image)", Param);
+               end case;
+            end;
+         when Iir_Kind_Value_Attribute =>
+            declare
+               Param : Iir;
+               Param_Type : Iir;
+            begin
+               Param := Get_Parameter (Expr);
+               Param := Eval_Static_Expr (Param);
+               Set_Parameter (Expr, Param);
+               if Get_Kind (Param) /= Iir_Kind_String_Literal then
+                  --  FIXME: Isn't it an implementation restriction.
+                  Warning_Msg_Sem ("'value argument not a string", Expr);
+                  return Build_Overflow (Expr);
+               else
+                  -- what type are we converting the string to?
+                  Param_Type := Get_Base_Type (Get_Type (Expr));
+                  declare
+                     Value : constant String := Image_String_Lit (Param);
+                  begin
+                     case Get_Kind (Param_Type) is
+                     when Iir_Kind_Integer_Type_Definition =>
+                        return Build_Discrete (Iir_Int64'Value (Value), Expr);
+                     when Iir_Kind_Enumeration_Type_Definition =>
+                        return Build_Enumeration_Value (Value, Param_Type,
+                                                        Expr);
+                     when Iir_Kind_Floating_Type_Definition =>
+                        return Build_Floating (Iir_Fp64'value (Value), Expr);
+                     when Iir_Kind_Physical_Type_Definition =>
+                        return Build_Physical_Value (Value, Param_Type, Expr);
+                     when others =>
+                        Error_Kind ("eval_static_expr('value)", Param);
+                     end case;
+                  end;
+               end if;
+            end;
+
+         when Iir_Kind_Left_Type_Attribute =>
+            return Eval_Static_Expr
+              (Get_Left_Limit (Eval_Static_Range (Get_Prefix (Expr))));
+         when Iir_Kind_Right_Type_Attribute =>
+            return Eval_Static_Expr
+              (Get_Right_Limit (Eval_Static_Range (Get_Prefix (Expr))));
+         when Iir_Kind_High_Type_Attribute =>
+            return Eval_Static_Expr
+              (Get_High_Limit (Eval_Static_Range (Get_Prefix (Expr))));
+         when Iir_Kind_Low_Type_Attribute =>
+            return Eval_Static_Expr
+              (Get_Low_Limit (Eval_Static_Range (Get_Prefix (Expr))));
+         when Iir_Kind_Ascending_Type_Attribute =>
+            return Build_Boolean
+              (Get_Direction (Eval_Static_Range (Get_Prefix (Expr))) = Iir_To);
+
+         when Iir_Kind_Length_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Build_Discrete (Eval_Discrete_Type_Length (Index), Expr);
+            end;
+         when Iir_Kind_Left_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Eval_Static_Expr
+                 (Get_Left_Limit (Get_Range_Constraint (Index)));
+            end;
+         when Iir_Kind_Right_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Eval_Static_Expr
+                 (Get_Right_Limit (Get_Range_Constraint (Index)));
+            end;
+         when Iir_Kind_Low_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Eval_Static_Expr
+                 (Get_Low_Limit (Get_Range_Constraint (Index)));
+            end;
+         when Iir_Kind_High_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Eval_Static_Expr
+                 (Get_High_Limit (Get_Range_Constraint (Index)));
+            end;
+         when Iir_Kind_Ascending_Array_Attribute =>
+            declare
+               Index : Iir;
+            begin
+               Index := Eval_Array_Attribute (Expr);
+               return Build_Boolean
+                 (Get_Direction (Get_Range_Constraint (Index)) = Iir_To);
+            end;
+
+         when Iir_Kind_Pred_Attribute =>
+            Res := Eval_Incdec
+              (Eval_Static_Expr (Get_Parameter (Expr)), -1, Expr);
+            Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr)));
+            return Res;
+         when Iir_Kind_Succ_Attribute =>
+            Res := Eval_Incdec
+              (Eval_Static_Expr (Get_Parameter (Expr)), +1, Expr);
+            Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr)));
+            return Res;
+         when Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute =>
+            declare
+               Rng : Iir;
+               N : Iir_Int64;
+               Prefix_Type : Iir;
+               Res : Iir;
+            begin
+               Prefix_Type := Get_Type (Get_Prefix (Expr));
+               Rng := Eval_Static_Range (Prefix_Type);
+               case Get_Direction (Rng) is
+                  when Iir_To =>
+                     N := 1;
+                  when Iir_Downto =>
+                     N := -1;
+               end case;
+               case Get_Kind (Expr) is
+                  when Iir_Kind_Leftof_Attribute =>
+                     N := -N;
+                  when Iir_Kind_Rightof_Attribute =>
+                     null;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               Res := Eval_Incdec
+                 (Eval_Static_Expr (Get_Parameter (Expr)), N, Expr);
+               Eval_Check_Bound (Res, Prefix_Type);
+               return Res;
+            end;
+
+         when Iir_Kind_Simple_Name_Attribute =>
+            declare
+               use Str_Table;
+               Id : String_Id;
+            begin
+               Id := Start;
+               Image (Get_Simple_Name_Identifier (Expr));
+               for I in 1 .. Name_Length loop
+                  Append (Name_Buffer (I));
+               end loop;
+               Finish;
+               return Build_String (Id, Nat32 (Name_Length), Expr);
+            end;
+
+         when Iir_Kind_Null_Literal =>
+            return Expr;
+
+         when Iir_Kind_Function_Call =>
+            declare
+               Imp : constant Iir := Get_Implementation (Expr);
+               Left, Right : Iir;
+            begin
+               --  Note: there can't be association by name.
+               Left := Get_Parameter_Association_Chain (Expr);
+               Right := Get_Chain (Left);
+
+               Left := Eval_Static_Expr (Get_Actual (Left));
+               if Right = Null_Iir then
+                  return Eval_Monadic_Operator (Expr, Left);
+               else
+                  Right := Eval_Static_Expr (Get_Actual (Right));
+                  return Eval_Dyadic_Operator (Expr, Imp, Left, Right);
+               end if;
+            end;
+
+         when Iir_Kind_Error =>
+            return Expr;
+         when others =>
+            Error_Kind ("eval_static_expr", Expr);
+      end case;
+   end Eval_Static_Expr;
+
+   --  If FORCE is true, always return a literal.
+   function Eval_Expr_Keep_Orig (Expr : Iir; Force : Boolean) return Iir
+   is
+      Res : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kinds_Denoting_Name =>
+            declare
+               Orig : constant Iir := Get_Named_Entity (Expr);
+            begin
+               Res := Eval_Static_Expr (Orig);
+               if Res /= Orig or else Force then
+                  return Build_Constant (Res, Expr);
+               else
+                  return Expr;
+               end if;
+            end;
+         when others =>
+            Res := Eval_Static_Expr (Expr);
+            if Res /= Expr
+              and then Get_Literal_Origin (Res) /= Expr
+            then
+               --  Need to build a constant if the result is a different
+               --  literal not tied to EXPR.
+               return Build_Constant (Res, Expr);
+            else
+               return Res;
+            end if;
+      end case;
+   end Eval_Expr_Keep_Orig;
+
+   function Eval_Expr (Expr: Iir) return Iir is
+   begin
+      if Get_Expr_Staticness (Expr) /= Locally then
+         Error_Msg_Sem ("expression must be locally static", Expr);
+         return Expr;
+      else
+         return Eval_Expr_Keep_Orig (Expr, False);
+      end if;
+   end Eval_Expr;
+
+   function Eval_Expr_If_Static (Expr : Iir) return Iir is
+   begin
+      if Expr /= Null_Iir and then Get_Expr_Staticness (Expr) = Locally then
+         return Eval_Expr_Keep_Orig (Expr, False);
+      else
+         return Expr;
+      end if;
+   end Eval_Expr_If_Static;
+
+   function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Eval_Expr_Keep_Orig (Expr, False);
+      Eval_Check_Bound (Res, Sub_Type);
+      return Res;
+   end Eval_Expr_Check;
+
+   function Eval_Expr_Check_If_Static (Expr : Iir; Atype : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      if Expr /= Null_Iir and then Get_Expr_Staticness (Expr) = Locally then
+         --  Expression is static and can be evaluated.
+         Res := Eval_Expr_Keep_Orig (Expr, False);
+
+         if Res /= Null_Iir
+           and then Get_Type_Staticness (Atype) = Locally
+           and then Get_Kind (Atype) in Iir_Kinds_Range_Type_Definition
+         then
+            --  Check bounds (as this can be done).
+            --  FIXME: create overflow_expr ?
+            Eval_Check_Bound (Res, Atype);
+         end if;
+
+         return Res;
+      else
+         return Expr;
+      end if;
+   end Eval_Expr_Check_If_Static;
+
+   function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean is
+   begin
+      case Get_Kind (Bound) is
+         when Iir_Kind_Range_Expression =>
+            case Get_Direction (Bound) is
+               when Iir_To =>
+                  if Val < Eval_Pos (Get_Left_Limit (Bound))
+                    or else Val > Eval_Pos (Get_Right_Limit (Bound))
+                  then
+                     return False;
+                  end if;
+               when Iir_Downto =>
+                  if Val > Eval_Pos (Get_Left_Limit (Bound))
+                    or else Val < Eval_Pos (Get_Right_Limit (Bound))
+                  then
+                     return False;
+                  end if;
+            end case;
+         when others =>
+            Error_Kind ("eval_int_in_range", Bound);
+      end case;
+      return True;
+   end Eval_Int_In_Range;
+
+   function Eval_Phys_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean
+   is
+      Left, Right : Iir_Int64;
+   begin
+      case Get_Kind (Bound) is
+         when Iir_Kind_Range_Expression =>
+            case Get_Kind (Get_Type (Get_Left_Limit (Bound))) is
+               when Iir_Kind_Integer_Type_Definition
+                 | Iir_Kind_Integer_Subtype_Definition =>
+                  Left := Get_Value (Get_Left_Limit (Bound));
+                  Right := Get_Value (Get_Right_Limit (Bound));
+               when Iir_Kind_Physical_Type_Definition
+                 | Iir_Kind_Physical_Subtype_Definition =>
+                  Left := Get_Physical_Value (Get_Left_Limit (Bound));
+                  Right := Get_Physical_Value (Get_Right_Limit (Bound));
+               when others =>
+                  Error_Kind ("eval_phys_in_range(1)", Get_Type (Bound));
+            end case;
+            case Get_Direction (Bound) is
+               when Iir_To =>
+                  if Val < Left or else Val > Right then
+                     return False;
+                  end if;
+               when Iir_Downto =>
+                  if Val > Left or else Val < Right then
+                     return False;
+                  end if;
+            end case;
+         when others =>
+            Error_Kind ("eval_phys_in_range", Bound);
+      end case;
+      return True;
+   end Eval_Phys_In_Range;
+
+   function Eval_Fp_In_Range (Val : Iir_Fp64; Bound : Iir) return Boolean is
+   begin
+      case Get_Kind (Bound) is
+         when Iir_Kind_Range_Expression =>
+            case Get_Direction (Bound) is
+               when Iir_To =>
+                  if Val < Get_Fp_Value (Get_Left_Limit (Bound))
+                    or else Val > Get_Fp_Value (Get_Right_Limit (Bound))
+                  then
+                     return False;
+                  end if;
+               when Iir_Downto =>
+                  if Val > Get_Fp_Value (Get_Left_Limit (Bound))
+                    or else Val < Get_Fp_Value (Get_Right_Limit (Bound))
+                  then
+                     return False;
+                  end if;
+            end case;
+         when others =>
+            Error_Kind ("eval_fp_in_range", Bound);
+      end case;
+      return True;
+   end Eval_Fp_In_Range;
+
+   --  Return TRUE if literal EXPR is in SUB_TYPE bounds.
+   function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) return Boolean
+   is
+      Type_Range : Iir;
+      Val : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Error =>
+            --  Ignore errors.
+            return True;
+         when Iir_Kind_Overflow_Literal =>
+            --  Never within bounds
+            return False;
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Selected_Name =>
+            Val := Get_Named_Entity (Expr);
+         when others =>
+            Val := Expr;
+      end case;
+
+      case Get_Kind (Sub_Type) is
+         when Iir_Kind_Integer_Subtype_Definition =>
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Int_In_Range (Get_Value (Val), Type_Range);
+         when Iir_Kind_Floating_Subtype_Definition =>
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Fp_In_Range (Get_Fp_Value (Val), Type_Range);
+         when Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            --  A check is required for an enumeration type definition for
+            --  'val attribute.
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Int_In_Range
+              (Iir_Int64 (Get_Enum_Pos (Val)), Type_Range);
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Type_Range := Get_Range_Constraint (Sub_Type);
+            return Eval_Phys_In_Range (Get_Physical_Value (Val), Type_Range);
+
+         when Iir_Kind_Base_Attribute =>
+            return Eval_Is_In_Bound (Val, Get_Type (Sub_Type));
+
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            --  FIXME: do it.
+            return True;
+
+         when others =>
+            Error_Kind ("eval_is_in_bound", Sub_Type);
+      end case;
+   end Eval_Is_In_Bound;
+
+   procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) is
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Overflow_Literal then
+         --  Nothing to check, and a message was already generated.
+         return;
+      end if;
+
+      if not Eval_Is_In_Bound (Expr, Sub_Type) then
+         Error_Msg_Sem ("static constant violates bounds", Expr);
+      end if;
+   end Eval_Check_Bound;
+
+   function Eval_Is_Range_In_Bound
+     (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean)
+     return Boolean
+   is
+      Type_Range : Iir;
+      Range_Constraint : constant Iir := Eval_Static_Range (A_Range);
+   begin
+      Type_Range := Get_Range_Constraint (Sub_Type);
+      if not Any_Dir
+        and then Get_Direction (Type_Range) /= Get_Direction (Range_Constraint)
+      then
+         return True;
+      end if;
+
+      case Get_Kind (Sub_Type) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            declare
+               L, R : Iir_Int64;
+            begin
+               --  Check for null range.
+               L := Eval_Pos (Get_Left_Limit (Range_Constraint));
+               R := Eval_Pos (Get_Right_Limit (Range_Constraint));
+               case Get_Direction (Range_Constraint) is
+                  when Iir_To =>
+                     if L > R then
+                        return True;
+                     end if;
+                  when Iir_Downto =>
+                     if L < R then
+                        return True;
+                     end if;
+               end case;
+               return Eval_Int_In_Range (L, Type_Range)
+                 and then Eval_Int_In_Range (R, Type_Range);
+            end;
+         when Iir_Kind_Floating_Subtype_Definition =>
+            declare
+               L, R : Iir_Fp64;
+            begin
+               --  Check for null range.
+               L := Get_Fp_Value (Get_Left_Limit (Range_Constraint));
+               R := Get_Fp_Value (Get_Right_Limit (Range_Constraint));
+               case Get_Direction (Range_Constraint) is
+                  when Iir_To =>
+                     if L > R then
+                        return True;
+                     end if;
+                  when Iir_Downto =>
+                     if L < R then
+                        return True;
+                     end if;
+               end case;
+               return Eval_Fp_In_Range (L, Type_Range)
+                 and then Eval_Fp_In_Range (R, Type_Range);
+            end;
+         when others =>
+            Error_Kind ("eval_is_range_in_bound", Sub_Type);
+      end case;
+
+      --  Should check L <= R or L >= R according to direction.
+      --return Eval_Is_In_Bound (Get_Left_Limit (A_Range), Sub_Type)
+      --  and then Eval_Is_In_Bound (Get_Right_Limit (A_Range), Sub_Type);
+   end Eval_Is_Range_In_Bound;
+
+   procedure Eval_Check_Range
+     (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean)
+   is
+   begin
+      if not Eval_Is_Range_In_Bound (A_Range, Sub_Type, Any_Dir) then
+         Error_Msg_Sem ("static range violates bounds", A_Range);
+      end if;
+   end Eval_Check_Range;
+
+   function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64
+   is
+      Res : Iir_Int64;
+      Left, Right : Iir_Int64;
+   begin
+      Left := Eval_Pos (Get_Left_Limit (Constraint));
+      Right := Eval_Pos (Get_Right_Limit (Constraint));
+      case Get_Direction (Constraint) is
+         when Iir_To =>
+            if Right < Left then
+               --  Null range.
+               return 0;
+            else
+               Res := Right - Left + 1;
+            end if;
+         when Iir_Downto =>
+            if Left < Right then
+               --  Null range
+               return 0;
+            else
+               Res := Left - Right + 1;
+            end if;
+      end case;
+      return Res;
+   end Eval_Discrete_Range_Length;
+
+   function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64
+   is
+   begin
+      case Get_Kind (Sub_Type) is
+         when Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            return Eval_Discrete_Range_Length
+              (Get_Range_Constraint (Sub_Type));
+         when others =>
+            Error_Kind ("eval_discrete_type_length", Sub_Type);
+      end case;
+   end Eval_Discrete_Type_Length;
+
+   function Eval_Pos (Expr : Iir) return Iir_Int64 is
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Integer_Literal =>
+            return Get_Value (Expr);
+         when Iir_Kind_Enumeration_Literal =>
+            return Iir_Int64 (Get_Enum_Pos (Expr));
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Unit_Declaration =>
+            return Get_Physical_Value (Expr);
+         when Iir_Kinds_Denoting_Name =>
+            return Eval_Pos (Get_Named_Entity (Expr));
+         when others =>
+            Error_Kind ("eval_pos", Expr);
+      end case;
+   end Eval_Pos;
+
+   function Eval_Static_Range (Rng : Iir) return Iir
+   is
+      Expr : Iir;
+      Kind : Iir_Kind;
+   begin
+      Expr := Rng;
+      loop
+         Kind := Get_Kind (Expr);
+         case Kind is
+            when Iir_Kind_Range_Expression =>
+               if Get_Expr_Staticness (Expr) /= Locally then
+                  return Null_Iir;
+               end if;
+
+               --  Normalize the range expression.
+               Set_Left_Limit
+                 (Expr, Eval_Expr_Keep_Orig (Get_Left_Limit (Expr), True));
+               Set_Right_Limit
+                 (Expr, Eval_Expr_Keep_Orig (Get_Right_Limit (Expr), True));
+               return Expr;
+            when Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Floating_Subtype_Definition
+              | Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition
+              | Iir_Kind_Physical_Subtype_Definition =>
+               Expr := Get_Range_Constraint (Expr);
+            when Iir_Kind_Range_Array_Attribute
+              | Iir_Kind_Reverse_Range_Array_Attribute =>
+               declare
+                  Prefix : Iir;
+                  Res : Iir;
+               begin
+                  Prefix := Get_Prefix (Expr);
+                  if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition
+                  then
+                     Prefix := Get_Type (Prefix);
+                  end if;
+                  if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition
+                  then
+                     --  Unconstrained object.
+                     return Null_Iir;
+                  end if;
+                  Expr := Get_Nth_Element
+                    (Get_Index_Subtype_List (Prefix),
+                     Natural (Eval_Pos (Get_Parameter (Expr))) - 1);
+                  if Kind = Iir_Kind_Reverse_Range_Array_Attribute then
+                     Expr := Eval_Static_Range (Expr);
+
+                     Res := Create_Iir (Iir_Kind_Range_Expression);
+                     Location_Copy (Res, Expr);
+                     Set_Type (Res, Get_Type (Expr));
+                     case Get_Direction (Expr) is
+                        when Iir_To =>
+                           Set_Direction (Res, Iir_Downto);
+                        when Iir_Downto =>
+                           Set_Direction (Res, Iir_To);
+                     end case;
+                     Set_Left_Limit (Res, Get_Right_Limit (Expr));
+                     Set_Right_Limit (Res, Get_Left_Limit (Expr));
+                     Set_Range_Origin (Res, Rng);
+                     Set_Expr_Staticness (Res, Get_Expr_Staticness (Expr));
+                     return Res;
+                  end if;
+               end;
+
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Base_Attribute =>
+               Expr := Get_Type (Expr);
+            when Iir_Kind_Type_Declaration =>
+               Expr := Get_Type_Definition (Expr);
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               Expr := Get_Named_Entity (Expr);
+            when others =>
+               Error_Kind ("eval_static_range", Expr);
+         end case;
+      end loop;
+   end Eval_Static_Range;
+
+   function Eval_Range (Arange : Iir) return Iir is
+      Res : Iir;
+   begin
+      Res := Eval_Static_Range (Arange);
+      if Res /= Arange
+        and then Get_Range_Origin (Res) /= Arange
+      then
+         return Build_Constant_Range (Res, Arange);
+      else
+         return Res;
+      end if;
+   end Eval_Range;
+
+   function Eval_Range_If_Static (Arange : Iir) return Iir is
+   begin
+      if Get_Expr_Staticness (Arange) /= Locally then
+         return Arange;
+      else
+         return Eval_Range (Arange);
+      end if;
+   end Eval_Range_If_Static;
+
+   --  Return the range constraint of a discrete range.
+   function Eval_Discrete_Range_Expression (Constraint : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Eval_Static_Range (Constraint);
+      if Res = Null_Iir then
+         Error_Kind ("eval_discrete_range_expression", Constraint);
+      else
+         return Res;
+      end if;
+   end Eval_Discrete_Range_Expression;
+
+   function Eval_Discrete_Range_Left (Constraint : Iir) return Iir
+   is
+      Range_Expr : Iir;
+   begin
+      Range_Expr := Eval_Discrete_Range_Expression (Constraint);
+      return Get_Left_Limit (Range_Expr);
+   end Eval_Discrete_Range_Left;
+
+   procedure Eval_Operator_Symbol_Name (Id : Name_Id)
+   is
+   begin
+      Image (Id);
+      Name_Buffer (2 .. Name_Length + 1) := Name_Buffer (1 .. Name_Length);
+      Name_Buffer (1) := '"'; --"
+      Name_Length := Name_Length + 2;
+      Name_Buffer (Name_Length) := '"'; --"
+   end Eval_Operator_Symbol_Name;
+
+   procedure Eval_Simple_Name (Id : Name_Id)
+   is
+   begin
+      --  LRM 14.1
+      --  E'SIMPLE_NAME
+      --    Result: [...] but with apostrophes (in the case of a character
+      --            literal)
+      if Is_Character (Id) then
+         Name_Buffer (1) := ''';
+         Name_Buffer (2) := Get_Character (Id);
+         Name_Buffer (3) := ''';
+         Name_Length := 3;
+         return;
+      end if;
+      case Id is
+         when Std_Names.Name_Word_Operators
+           | Std_Names.Name_First_Operator .. Std_Names.Name_Last_Operator =>
+            Eval_Operator_Symbol_Name (Id);
+            return;
+         when Std_Names.Name_Xnor
+           | Std_Names.Name_Shift_Operators =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Eval_Operator_Symbol_Name (Id);
+               return;
+            end if;
+         when others =>
+            null;
+      end case;
+      Image (Id);
+--       if Name_Buffer (1) = '\' then
+--          declare
+--             I : Natural;
+--          begin
+--             I := 2;
+--             while I <= Name_Length loop
+--                if Name_Buffer (I) = '\' then
+--                   Name_Length := Name_Length + 1;
+--                   Name_Buffer (I + 1 .. Name_Length) :=
+--                     Name_Buffer (I .. Name_Length - 1);
+--                   I := I + 1;
+--                end if;
+--                I := I + 1;
+--             end loop;
+--             Name_Length := Name_Length + 1;
+--             Name_Buffer (Name_Length) := '\';
+--          end;
+--       end if;
+   end Eval_Simple_Name;
+
+   function Compare_String_Literals (L, R : Iir) return Compare_Type
+   is
+      type Str_Info is record
+         El : Iir;
+         Ptr : String_Fat_Acc;
+         Len : Nat32;
+         Lit_0 : Iir;
+         Lit_1 : Iir;
+         List : Iir_List;
+      end record;
+
+      Literal_List : Iir_List;
+
+      --  Fill Res from EL.  This is used to speed up Lt and Eq operations.
+      procedure Get_Info (Expr : Iir; Res : out Str_Info) is
+      begin
+         case Get_Kind (Expr) is
+            when Iir_Kind_Simple_Aggregate =>
+               Res := Str_Info'(El => Expr,
+                                Ptr => null,
+                                Len => 0,
+                                Lit_0 | Lit_1 => Null_Iir,
+                                List => Get_Simple_Aggregate_List (Expr));
+               Res.Len := Nat32 (Get_Nbr_Elements (Res.List));
+            when Iir_Kind_Bit_String_Literal =>
+               Res := Str_Info'(El => Expr,
+                                Ptr => Get_String_Fat_Acc (Expr),
+                                Len => Get_String_Length (Expr),
+                                Lit_0 => Get_Bit_String_0 (Expr),
+                                Lit_1 => Get_Bit_String_1 (Expr),
+                                List => Null_Iir_List);
+            when Iir_Kind_String_Literal =>
+               Res := Str_Info'(El => Expr,
+                                Ptr => Get_String_Fat_Acc (Expr),
+                                Len => Get_String_Length (Expr),
+                                Lit_0 | Lit_1 => Null_Iir,
+                                List => Null_Iir_List);
+            when others =>
+               Error_Kind ("sem_string_choice_range.get_info", Expr);
+         end case;
+      end Get_Info;
+
+      --  Return the position of element IDX of STR.
+      function Get_Pos (Str : Str_Info; Idx : Nat32) return Iir_Int32
+      is
+         S : Iir;
+         C : Character;
+      begin
+         case Get_Kind (Str.El) is
+            when Iir_Kind_Simple_Aggregate =>
+               S := Get_Nth_Element (Str.List, Natural (Idx));
+            when Iir_Kind_String_Literal =>
+               C := Str.Ptr (Idx + 1);
+               --  FIXME: build a table from character to position.
+               --  This linear search is O(n)!
+               S := Find_Name_In_List (Literal_List,
+                                       Name_Table.Get_Identifier (C));
+               if S = Null_Iir then
+                  return -1;
+               end if;
+            when Iir_Kind_Bit_String_Literal =>
+               C := Str.Ptr (Idx + 1);
+               case C is
+                  when '0' =>
+                     S := Str.Lit_0;
+                  when '1' =>
+                     S := Str.Lit_1;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            when others =>
+               Error_Kind ("sem_string_choice_range.get_pos", Str.El);
+         end case;
+         return Get_Enum_Pos (S);
+      end Get_Pos;
+
+      L_Info, R_Info : Str_Info;
+      L_Pos, R_Pos : Iir_Int32;
+   begin
+      Get_Info (L, L_Info);
+      Get_Info (R, R_Info);
+
+      if L_Info.Len /= R_Info.Len then
+         raise Internal_Error;
+      end if;
+
+      Literal_List := Get_Enumeration_Literal_List
+        (Get_Base_Type (Get_Element_Subtype (Get_Type (L))));
+
+      for I in 0 .. L_Info.Len - 1 loop
+         L_Pos := Get_Pos (L_Info, I);
+         R_Pos := Get_Pos (R_Info, I);
+         if L_Pos /= R_Pos then
+            if L_Pos < R_Pos then
+               return Compare_Lt;
+            else
+               return Compare_Gt;
+            end if;
+         end if;
+      end loop;
+      return Compare_Eq;
+   end Compare_String_Literals;
+
+   function Get_Path_Instance_Name_Suffix (Attr : Iir)
+                                          return Path_Instance_Name_Type
+   is
+      --  Current path for name attributes.
+      Path_Str : String_Acc := null;
+      Path_Maxlen : Natural := 0;
+      Path_Len : Natural;
+      Path_Instance : Iir;
+
+      procedure Deallocate is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+
+      procedure Path_Reset is
+      begin
+         Path_Len := 0;
+         Path_Instance := Null_Iir;
+         if Path_Maxlen = 0 then
+            Path_Maxlen := 256;
+            Path_Str := new String (1 .. Path_Maxlen);
+         end if;
+      end Path_Reset;
+
+      procedure Path_Add (Str : String)
+      is
+         N_Len : Natural;
+         N_Path : String_Acc;
+      begin
+         N_Len := Path_Maxlen;
+         loop
+            exit when Path_Len + Str'Length <= N_Len;
+            N_Len := N_Len * 2;
+         end loop;
+         if N_Len /= Path_Maxlen then
+            N_Path := new String (1 .. N_Len);
+            N_Path (1 .. Path_Len) := Path_Str (1 .. Path_Len);
+            Deallocate (Path_Str);
+            Path_Str := N_Path;
+            Path_Maxlen := N_Len;
+         end if;
+         Path_Str (Path_Len + 1 .. Path_Len + Str'Length) := Str;
+         Path_Len := Path_Len + Str'Length;
+      end Path_Add;
+
+      procedure Path_Add_Type_Name (Atype : Iir)
+      is
+         Adecl : Iir;
+      begin
+         Adecl := Get_Type_Declarator (Atype);
+         Image (Get_Identifier (Adecl));
+         Path_Add (Name_Buffer (1 .. Name_Length));
+      end Path_Add_Type_Name;
+
+      procedure Path_Add_Signature (Subprg : Iir)
+      is
+         Chain : Iir;
+      begin
+         Path_Add ("[");
+         Chain := Get_Interface_Declaration_Chain (Subprg);
+         while Chain /= Null_Iir loop
+            Path_Add_Type_Name (Get_Type (Chain));
+            Chain := Get_Chain (Chain);
+            if Chain /= Null_Iir then
+               Path_Add (",");
+            end if;
+         end loop;
+
+         case Get_Kind (Subprg) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Implicit_Function_Declaration =>
+               Path_Add (" return ");
+               Path_Add_Type_Name (Get_Return_Type (Subprg));
+            when others =>
+               null;
+         end case;
+         Path_Add ("]");
+      end Path_Add_Signature;
+
+      procedure Path_Add_Name (N : Iir) is
+      begin
+         Eval_Simple_Name (Get_Identifier (N));
+         if Name_Buffer (1) /= 'P' then
+            --  Skip anonymous processes.
+            Path_Add (Name_Buffer (1 .. Name_Length));
+         end if;
+      end Path_Add_Name;
+
+      procedure Path_Add_Element (El : Iir; Is_Instance : Boolean) is
+      begin
+         --  LRM 14.1
+         --  E'INSTANCE_NAME
+         --    There is one full path instance element for each component
+         --    instantiation, block statement, generate statemenent, process
+         --    statement, or subprogram body in the design hierarchy between
+         --    the top design entity and the named entity denoted by the
+         --    prefix.
+         --
+         --  E'PATH_NAME
+         --    There is one path instance element for each component
+         --    instantiation, block statement, generate statement, process
+         --    statement, or subprogram body in the design hierarchy between
+         --    the root design entity and the named entity denoted by the
+         --    prefix.
+         case Get_Kind (El) is
+            when Iir_Kind_Library_Declaration =>
+               Path_Add (":");
+               Path_Add_Name (El);
+               Path_Add (":");
+            when Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Body =>
+               Path_Add_Element
+                 (Get_Library (Get_Design_File (Get_Design_Unit (El))),
+                  Is_Instance);
+               Path_Add_Name (El);
+               Path_Add (":");
+            when Iir_Kind_Entity_Declaration =>
+               Path_Instance := El;
+            when Iir_Kind_Architecture_Body =>
+               Path_Instance := El;
+            when Iir_Kind_Design_Unit =>
+               Path_Add_Element (Get_Library_Unit (El), Is_Instance);
+            when Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Process_Statement
+              | Iir_Kind_Block_Statement =>
+               Path_Add_Element (Get_Parent (El), Is_Instance);
+               Path_Add_Name (El);
+               Path_Add (":");
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Path_Add_Element (Get_Parent (El), Is_Instance);
+               Path_Add_Name (El);
+               if Flags.Vhdl_Std >= Vhdl_02 then
+                  --  Add signature.
+                  Path_Add_Signature (El);
+               end if;
+               Path_Add (":");
+            when Iir_Kind_Procedure_Body =>
+               Path_Add_Element (Get_Subprogram_Specification (El),
+                                 Is_Instance);
+            when Iir_Kind_Generate_Statement =>
+               declare
+                  Scheme : Iir;
+               begin
+                  Scheme := Get_Generation_Scheme (El);
+                  if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                     Path_Instance := El;
+                  else
+                     Path_Add_Element (Get_Parent (El), Is_Instance);
+                     Path_Add_Name (El);
+                     Path_Add (":");
+                  end if;
+               end;
+            when Iir_Kinds_Sequential_Statement =>
+               Path_Add_Element (Get_Parent (El), Is_Instance);
+            when others =>
+               Error_Kind ("path_add_element", El);
+         end case;
+      end Path_Add_Element;
+
+      Prefix : constant Iir := Get_Named_Entity (Get_Prefix (Attr));
+      Is_Instance : constant Boolean :=
+        Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute;
+   begin
+      Path_Reset;
+
+      --  LRM 14.1
+      --  E'PATH_NAME
+      --    The local item name in E'PATH_NAME equals E'SIMPLE_NAME, unless
+      --    E denotes a library, package, subprogram or label. In this
+      --    latter case, the package based path or instance based path,
+      --    as appropriate, will not contain a local item name.
+      --
+      --  E'INSTANCE_NAME
+      --    The local item name in E'INSTANCE_NAME equals E'SIMPLE_NAME,
+      --    unless E denotes a library, package, subprogram, or label.  In
+      --    this latter case, the package based path or full instance based
+      --    path, as appropriate, will not contain a local item name.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            Path_Add_Element (Get_Parent (Prefix), Is_Instance);
+            Path_Add_Name (Prefix);
+         when Iir_Kind_Library_Declaration
+           | Iir_Kinds_Library_Unit_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement =>
+            Path_Add_Element (Prefix, Is_Instance);
+         when others =>
+            Error_Kind ("get_path_instance_name_suffix", Prefix);
+      end case;
+
+      declare
+         Result : constant Path_Instance_Name_Type :=
+           (Len => Path_Len,
+            Path_Instance => Path_Instance,
+            Suffix => Path_Str (1 .. Path_Len));
+      begin
+         Deallocate (Path_Str);
+         return Result;
+      end;
+   end Get_Path_Instance_Name_Suffix;
+
+end Evaluation;
diff --git a/src/evaluation.ads b/src/evaluation.ads
new file mode 100644
index 000000000..66ec2a1cc
--- /dev/null
+++ b/src/evaluation.ads
@@ -0,0 +1,161 @@
+--  Evaluation of static expressions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Evaluation is
+
+   --  Evaluation is about compile-time computation of expressions, such as
+   --  2 + 1 --> 3.  This is (of course) possible only with locally (and some
+   --  globally) static expressions.  Evaluation is required during semantic
+   --  analysis at many places (in fact those where locally static expression
+   --  are required by the language).  For example, the type of O'Range (N)
+   --  depends on N, so we need to evaluate N.
+   --
+   --  The result of evaluation is a literal (integer, enumeration, real,
+   --  physical), a string or a simple aggregate.  For scalar types, the
+   --  result is therefore normalized (there is only one kind of result), but
+   --  for array types, the result isn't: in general it will be a string, but
+   --  it may be a simple aggregate.  Strings are preferred (because they are
+   --  more compact), but aren't possible in some cases.  For example, the
+   --  evaluation of "Text" & NUL cannot be a string.
+   --
+   --  Some functions (like Eval_Static_Expr) simply returns a result (which
+   --  may be a node of the expression), others returns a result and set the
+   --  origin (Literal_Origin or Range_Origin) to remember the original
+   --  expression that was evaluation.  The original expression is kept so that
+   --  it is possible to print the original tree.
+
+   --  Get the value of a physical integer literal or unit.
+   function Get_Physical_Value (Expr : Iir) return Iir_Int64;
+
+   --  Evaluate the locally static expression EXPR (without checking that EXPR
+   --  is locally static).  Return a literal or an aggregate, without setting
+   --  the origin, and do not modify EXPR.  This can be used only to get the
+   --  value of an expression, without replacing it.
+   function Eval_Static_Expr (Expr: Iir) return Iir;
+
+   --  Evaluate (ie compute) expression EXPR.
+   --  EXPR is required to be a locally static expression, otherwise an error
+   --  message is generated.
+   --  The result is a literal with the origin set.
+   function Eval_Expr (Expr: Iir) return Iir;
+
+   --  Same as Eval_Expr, but if EXPR is not locally static, the result is
+   --  EXPR.  Also, if EXPR is null_iir, then null_iir is returned.
+   --  The purpose of this function is to evaluate an expression only if it
+   --  is locally static.
+   function Eval_Expr_If_Static (Expr : Iir) return Iir;
+
+   --  Evaluate a physical literal and return a normalized literal (using
+   --  the primary unit as unit).
+   function Eval_Physical_Literal (Expr : Iir) return Iir;
+
+   --  Return TRUE if literal EXPR is in SUB_TYPE bounds.
+   function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) return Boolean;
+
+   --  Emit an error if EXPR violates SUB_TYPE bounds.
+   procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir);
+
+   --  Same as Eval_Expr, but a range check with SUB_TYPE is performed after
+   --  computation.
+   function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir;
+
+   --  Call Eval_Expr_Check only if EXPR is static.
+   function Eval_Expr_Check_If_Static (Expr : Iir; Atype : Iir) return Iir;
+
+   --  For a locally static range RNG (a range expression, a range attribute
+   --  or a name that denotes a type or a subtype) returns its corresponding
+   --  locally static range_expression.  The bounds of the results are also
+   --  literals.
+   --  Return a range_expression or NULL_IIR for a non locally static range.
+   function Eval_Static_Range (Rng : Iir) return Iir;
+
+   --  Return a locally static range expression with the origin set for ARANGE.
+   function Eval_Range (Arange : Iir) return Iir;
+
+   --  If ARANGE is a locally static range, return locally static range
+   --  expression (with the origin set), else return ARANGE.
+   function Eval_Range_If_Static (Arange : Iir) return Iir;
+
+   --  Emit an error if A_RANGE is not included in SUB_TYPE.  A_RANGE can be
+   --  a range expression, a range attribute or a name that denotes a discrete
+   --  type or subtype.  A_RANGE must be a locally static range.
+   procedure Eval_Check_Range (A_Range : Iir; Sub_Type : Iir;
+                               Any_Dir : Boolean);
+
+   --  Return TRUE if range expression A_RANGE is not included in SUB_TYPE.
+   function Eval_Is_Range_In_Bound
+     (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean)
+     return Boolean;
+
+   --  Return TRUE iff VAL belongs to BOUND.
+   function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean;
+
+   --  Return the length of the discrete range CONSTRAINT.
+   function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64;
+
+   --  Return the length of SUB_TYPE.
+   function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64;
+
+   --  Get the left bound of a range constraint.
+   --  Note: the range constraint may be an attribute or a subtype.
+   function Eval_Discrete_Range_Left (Constraint : Iir) return Iir;
+
+   --  Return the position of EXPR, ie the result of sub_type'pos (EXPR), where
+   --  sub_type is the type of expr.
+   --  EXPR must be of a discrete subtype.
+   function Eval_Pos (Expr : Iir) return Iir_Int64;
+
+   --  Replace ORIGIN (an overflow literal) with extreme positive value (if
+   --  IS_POS is true) or extreme negative value.
+   function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir;
+
+   --  Create an array subtype from LEN and BASE_TYPE, according to rules
+   --  of LRM93 7.3.2.2. (which are the same as LRM93 7.2.4).
+   function Create_Unidim_Array_By_Length
+     (Base_Type : Iir; Len : Iir_Int64; Loc : Iir)
+     return Iir_Array_Subtype_Definition;
+
+   --  Create a subtype of A_TYPE whose length is LEN.
+   --  This is used to create subtypes for strings or aggregates.
+   function Create_Range_Subtype_By_Length
+     (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type)
+     return Iir;
+
+   --  Store into NAME_BUFFER, NAME_LENGTH the simple name, character literal
+   --  or operator sumbol of ID, using the same format as SIMPLE_NAME
+   --  attribute.
+   procedure Eval_Simple_Name (Id : Name_Id);
+
+   --  Compare two string literals (of same length).
+   type Compare_Type is (Compare_Lt, Compare_Eq, Compare_Gt);
+   function Compare_String_Literals (L, R : Iir) return Compare_Type;
+
+   --  Return the local part of 'Instance_Name or 'Path_Name.
+   type Path_Instance_Name_Type (Len : Natural) is record
+      --  The node before suffix (entity, architecture or generate iterator).
+      Path_Instance : Iir;
+
+      --  The suffix
+      Suffix : String (1 .. Len);
+   end record;
+
+   function Get_Path_Instance_Name_Suffix (Attr : Iir)
+                                          return Path_Instance_Name_Type;
+end Evaluation;
diff --git a/src/files_map.adb b/src/files_map.adb
new file mode 100644
index 000000000..f4927e8db
--- /dev/null
+++ b/src/files_map.adb
@@ -0,0 +1,857 @@
+--  Loading of source files.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces.C;
+with Ada.Characters.Latin_1;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.Table;
+with GNAT.OS_Lib;
+with GNAT.Directory_Operations;
+with Name_Table; use Name_Table;
+with Str_Table;
+with Ada.Calendar;
+with Ada.Calendar.Time_Zones;
+
+package body Files_Map is
+
+   -- Check validity of FILE.
+   -- Raise an exception in case of error.
+   procedure Check_File (File: in Source_File_Entry);
+
+   type Lines_Table_Type is array (Positive) of Source_Ptr;
+   type Lines_Table_Ptr is access all Lines_Table_Type;
+
+   --  Data associed with a file.
+   type Source_File_Record is record
+      --  All location between first and last belong to this file.
+      First_Location : Location_Type;
+      Last_Location : Location_Type;
+
+      -- The name_id that identify this file.
+      -- FIXME: what about file aliasing (links) ?
+      File_Name: Name_Id;
+
+      Directory : Name_Id;
+
+      -- The buffer containing the file.
+      Source: File_Buffer_Acc;
+
+      -- Length of the file, which is also the length of the buffer.
+      File_Length: Natural;
+
+      Time_Stamp: Time_Stamp_Id;
+
+      --  Current number of line in Lines_Table.
+      Nbr_Lines: Natural;
+
+      Lines_Table: Lines_Table_Ptr;
+
+      --  Current size of Lines_Table.
+      Lines_Table_Max: Natural;
+
+      --  Cache.
+      Cache_Line : Natural;
+      Cache_Pos : Source_Ptr;
+   end record;
+
+   --  Next location to use.
+   Next_Location : Location_Type := Location_Nil + 1;
+
+   package Source_Files is new GNAT.Table
+     (Table_Index_Type => Source_File_Entry,
+      Table_Component_Type => Source_File_Record,
+      Table_Low_Bound => No_Source_File_Entry + 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   function Get_Last_Source_File_Entry return Source_File_Entry is
+   begin
+      return Source_Files.Last;
+   end Get_Last_Source_File_Entry;
+
+   Home_Dir : Name_Id := Null_Identifier;
+
+   function Get_Home_Directory return Name_Id is
+   begin
+      if Home_Dir = Null_Identifier then
+         GNAT.Directory_Operations.Get_Current_Dir (Name_Buffer, Name_Length);
+         Home_Dir := Get_Identifier;
+      end if;
+      return Home_Dir;
+   end Get_Home_Directory;
+
+   procedure Location_To_File_Pos (Location : Location_Type;
+                                   File : out Source_File_Entry;
+                                   Pos : out Source_Ptr)
+   is
+   begin
+      --  FIXME: use a cache
+      --  FIXME: dicotomy
+      for I in Source_Files.First .. Source_Files.Last loop
+         declare
+            F : Source_File_Record renames Source_Files.Table (I);
+         begin
+            if Location >= F.First_Location
+              and then Location <= F.Last_Location
+            then
+               File := I;
+               Pos := Source_Ptr (Location - F.First_Location);
+               return;
+            end if;
+         end;
+      end loop;
+      --  File not found, location must be bad...
+      raise Internal_Error;
+   end Location_To_File_Pos;
+
+   function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr)
+     return Location_Type
+   is
+   begin
+      if Source_Files.Table (File).Source = null then
+         raise Internal_Error;
+      else
+         return Source_Files.Table (File).First_Location + Location_Type (Pos);
+      end if;
+   end File_Pos_To_Location;
+
+   function Source_File_To_Location (File : Source_File_Entry)
+     return Location_Type
+   is
+   begin
+      return Source_Files.Table (File).First_Location;
+   end Source_File_To_Location;
+
+   procedure Reallocate_Lines_Table
+     (File: in out Source_File_Record; New_Size: Natural) is
+      use Interfaces.C;
+
+      function realloc
+        (memblock : Lines_Table_Ptr;
+         size     : size_t)
+         return     Lines_Table_Ptr;
+      pragma Import (C, realloc);
+
+      function malloc
+        (size     : size_t)
+         return     Lines_Table_Ptr;
+      pragma Import (C, malloc);
+
+      New_Table: Lines_Table_Ptr;
+      New_Byte_Size : size_t;
+   begin
+      New_Byte_Size :=
+        size_t(New_Size *
+                Lines_Table_Type'Component_Size / System.Storage_Unit);
+      if File.Lines_Table = null then
+         New_Table := malloc (New_Byte_Size);
+      else
+         New_Table := realloc (File.Lines_Table, New_Byte_Size);
+      end if;
+      if New_Table = null then
+         raise Storage_Error;
+      else
+         File.Lines_Table := New_Table;
+         File.Lines_Table (File.Lines_Table_Max + 1 .. New_Size) :=
+           (others => Source_Ptr_Bad);
+         File.Lines_Table_Max := New_Size;
+      end if;
+   end Reallocate_Lines_Table;
+
+   -- Add a new entry in the lines_table.
+   -- The new entry must be the next one after the last entry.
+   procedure File_Add_Line_Number
+     (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr) is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+   begin
+      -- Just check File is not out of bounds.
+      if File > Source_Files.Last then
+         raise Internal_Error;
+      end if;
+
+      if Line = 1 then
+         -- The position of the first line is well-known.
+         if Pos /= Source_Ptr_Org then
+            raise Internal_Error;
+         end if;
+      else
+         -- The position of a non first line is not the well-known value.
+         if Pos <= Source_Ptr_Org then
+            raise Internal_Error;
+         end if;
+         -- Take care of scan backtracking.
+         if Line <= Source_File.Nbr_Lines then
+            if Source_File.Lines_Table (Line) = Source_Ptr_Bad then
+               Source_File.Lines_Table (Line) := Pos;
+            elsif Pos /= Source_File.Lines_Table (Line) then
+               Put_Line ("file" & Source_File_Entry'Image (File)
+                         & " for line" & Natural'Image (Line)
+                         & " pos =" & Source_Ptr'Image (Pos)
+                         & ", lines_table = "
+                         & Source_Ptr'Image (Source_File.Lines_Table (Line)));
+               raise Internal_Error;
+            end if;
+            return;
+         end if;
+         -- The new entry must just follow the last entry.
+--          if Line /= Source_File.Nbr_Lines + 1 then
+--             raise Internal_Error;
+--          end if;
+      end if;
+      if Line > Source_File.Lines_Table_Max then
+         Reallocate_Lines_Table (Source_File, (Line / 128 + 1) * 128);
+      end if;
+      Source_File.Lines_Table (Line) := Pos;
+      if Line > Source_File.Nbr_Lines then
+         Source_File.Nbr_Lines := Line;
+      end if;
+      -- Source_File.Nbr_Lines := Source_File.Nbr_Lines + 1;
+      if False then
+         Put_Line ("file" & Source_File_Entry'Image (File)
+                   & " line" & Natural'Image (Line)
+                   & " at position" & Source_Ptr'Image (Pos));
+      end if;
+   end File_Add_Line_Number;
+
+   --  Convert a physical column to a logical column.
+   --  A physical column is the offset in byte from the first byte of the line.
+   --  A logical column is the position of the character when displayed.
+   --  A HT (tabulation) moves the cursor to the next position multiple of 8.
+   --  The first character is at position 1 and at offset 0.
+   procedure Coord_To_Position
+     (File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Offset : Natural;
+      Name : out Name_Id;
+      Col : out Natural)
+   is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+      Res : Positive := 1;
+   begin
+      Name := Source_File.File_Name;
+      for I in Line_Pos .. Line_Pos + Source_Ptr (Offset) - 1 loop
+         if Source_File.Source (I) = Ada.Characters.Latin_1.HT then
+            Res := Res + 8 - Res mod 8;
+         else
+            Res := Res + 1;
+         end if;
+      end loop;
+      Col := Res;
+   end Coord_To_Position;
+
+   --  Should only be called by Location_To_Coord.
+   function Location_To_Line
+     (Source_File : Source_File_Record; Pos : Source_Ptr)
+     return Natural
+   is
+      Low, Hi, Mid : Natural;
+      Mid1 : Natural;
+      Lines_Table : constant Lines_Table_Ptr := Source_File.Lines_Table;
+   begin
+      --  Look in the cache.
+      if Pos >= Source_File.Cache_Pos then
+         Low := Source_File.Cache_Line;
+         Hi := Source_File.Nbr_Lines;
+      else
+         Low := 1;
+         Hi := Source_File.Cache_Line;
+      end if;
+
+      loop
+         << Again >> null;
+         Mid := (Hi + Low) / 2;
+         if Lines_Table (Mid) = Source_Ptr_Bad then
+            -- There is a hole: no position for this line.
+            -- Set MID1 to a line which has a position.
+            -- Try downward.
+            Mid1 := Mid;
+            while Lines_Table (Mid1) = Source_Ptr_Bad loop
+               --  Note: Low may have no line.
+               exit when Mid1 = Low;
+               Mid1 := Mid1 - 1;
+            end loop;
+            if Mid1 /= Low then
+               --  Mid1 has a line.
+               if Pos < Lines_Table (Mid1) then
+                  Hi := Mid1;
+                  goto Again;
+               end if;
+               if Pos > Lines_Table (Mid1) then
+                  Low := Mid1;
+                  goto Again;
+               end if;
+               --  Found, handled just below.
+            else
+               --  Failed (downward is LOW): try upward.
+               Mid1 := Mid;
+               while Lines_Table (Mid1) = Source_Ptr_Bad loop
+                  Mid1 := Mid1 + 1;
+               end loop;
+               if Mid1 = Hi then
+                  --  Failed: no lines between LOW and HI.
+                  if Pos >= Lines_Table (Hi) then
+                     Mid1 := Hi;
+                  else
+                     Mid1 := Low;
+                  end if;
+                  return Mid1;
+               end if;
+               --  Mid1 has a line.
+               if Pos < Lines_Table (Mid1) then
+                  Hi := Mid1;
+                  goto Again;
+               end if;
+               if Pos > Lines_Table (Mid1) then
+                  Low := Mid1;
+                  goto Again;
+               end if;
+            end if;
+            Mid := Mid1;
+         end if;
+         if Pos >= Lines_Table (Mid) then
+            if Mid = Source_File.Nbr_Lines
+              or else Pos < Lines_Table (Mid + 1)
+              or else Pos = Lines_Table (Mid)
+              or else (Hi <= Mid + 1
+                       and Lines_Table (Mid + 1) = Source_Ptr_Bad)
+            then
+               return Mid;
+            end if;
+         end if;
+         if Pos < Lines_Table (Mid) then
+            Hi := Mid - 1;
+         else
+            if Lines_Table (Mid + 1) /= Source_Ptr_Bad then
+               Low := Mid + 1;
+            else
+               Low := Mid;
+            end if;
+         end if;
+      end loop;
+   end Location_To_Line;
+
+   procedure Location_To_Coord
+     (Source_File : in out Source_File_Record;
+      Pos : Source_Ptr;
+      Line_Pos : out Source_Ptr;
+      Line : out Natural;
+      Offset : out Natural)
+   is
+      Line_P : Source_Ptr;
+      Line_Threshold : constant Natural := 4;
+      Low, Hi : Natural;
+   begin
+      --  Look in the cache.
+      if Pos >= Source_File.Cache_Pos then
+         Low := Source_File.Cache_Line;
+         Hi := Source_File.Nbr_Lines;
+
+         --  Maybe adjust the threshold.
+         --  Quick look.
+         if Pos - Source_File.Cache_Pos <= 120
+           and then Low + Line_Threshold <= Hi
+         then
+            for I in 1 .. Line_Threshold loop
+               Line_P := Source_File.Lines_Table (Low + I);
+               if Line_P > Pos then
+                  Line := Low + I - 1;
+                  goto Found;
+               else
+                  exit when Line_P = Source_Ptr_Bad;
+               end if;
+            end loop;
+         end if;
+      end if;
+
+      Line := Location_To_Line (Source_File, Pos);
+
+      << Found >> null;
+
+      Line_Pos := Source_File.Lines_Table (Line);
+      Offset := Natural (Pos - Source_File.Lines_Table (Line));
+
+      --  Update cache.
+      Source_File.Cache_Pos := Pos;
+      Source_File.Cache_Line := Line;
+   end Location_To_Coord;
+
+   procedure Location_To_Position
+     (Location : Location_Type;
+      Name : out Name_Id;
+      Line : out Natural;
+      Col : out Natural)
+   is
+      File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Offset : Natural;
+   begin
+      Location_To_Coord (Location, File, Line_Pos, Line, Offset);
+      Coord_To_Position (File, Line_Pos, Offset, Name, Col);
+   end Location_To_Position;
+
+   procedure Location_To_Coord
+     (Location : Location_Type;
+      File : out Source_File_Entry;
+      Line_Pos : out Source_Ptr;
+      Line : out Natural;
+      Offset : out Natural)
+   is
+      Pos : Source_Ptr;
+   begin
+      Location_To_File_Pos (Location, File, Pos);
+      Location_To_Coord (Source_Files.Table (File), Pos,
+                         Line_Pos, Line, Offset);
+   end Location_To_Coord;
+
+   -- Convert the first digit of VAL into a character (base 10).
+   function Digit_To_Char (Val: Natural) return Character is
+   begin
+      return Character'Val (Character'Pos ('0') + Val mod 10);
+   end Digit_To_Char;
+
+   -- Format: YYYYMMDDHHmmsscc
+   -- Y: year, M: month, D: day, H: hour, m: minute, s: second, cc:100th sec
+   function Os_Time_To_Time_Stamp_Id (Time: GNAT.OS_Lib.OS_Time)
+     return Time_Stamp_Id
+   is
+      use GNAT.OS_Lib;
+      use Str_Table;
+      Res: Time_Stamp_Id;
+      Year: Year_Type;
+      Month: Month_Type;
+      Day: Day_Type;
+      Hour: Hour_Type;
+      Minute: Minute_Type;
+      Second: Second_Type;
+   begin
+      GM_Split (Time, Year, Month, Day, Hour, Minute, Second);
+      Res := Time_Stamp_Id (Start);
+      Append (Digit_To_Char (Year / 1000));
+      Append (Digit_To_Char (Year / 100));
+      Append (Digit_To_Char (Year / 10));
+      Append (Digit_To_Char (Year / 1));
+      Append (Digit_To_Char (Month / 10));
+      Append (Digit_To_Char (Month / 1));
+      Append (Digit_To_Char (Day / 10));
+      Append (Digit_To_Char (Day / 1));
+      Append (Digit_To_Char (Hour / 10));
+      Append (Digit_To_Char (Hour / 1));
+      Append (Digit_To_Char (Minute / 10));
+      Append (Digit_To_Char (Minute / 1));
+      Append (Digit_To_Char (Second / 10));
+      Append (Digit_To_Char (Second / 1));
+      Append ('.');
+      Append ('0');
+      Append ('0');
+      Append ('0');
+      Finish;
+      return Res;
+   end Os_Time_To_Time_Stamp_Id;
+
+   function Get_File_Time_Stamp (Filename : System.Address)
+     return Time_Stamp_Id
+   is
+      use GNAT.OS_Lib;
+      Fd : File_Descriptor;
+      Res : Time_Stamp_Id;
+   begin
+      Fd := Open_Read (Filename, Binary);
+      if Fd = Invalid_FD then
+         return Null_Time_Stamp;
+      end if;
+      Res :=  Os_Time_To_Time_Stamp_Id (File_Time_Stamp (Fd));
+      Close (Fd);
+      return Res;
+   end Get_File_Time_Stamp;
+
+   function Get_File_Time_Stamp (FD : GNAT.OS_Lib.File_Descriptor)
+                                return Time_Stamp_Id
+   is
+   begin
+      return Os_Time_To_Time_Stamp_Id (GNAT.OS_Lib.File_Time_Stamp (FD));
+   end Get_File_Time_Stamp;
+
+   function Get_Os_Time_Stamp return Time_Stamp_Id
+   is
+      use Ada.Calendar;
+      use Ada.Calendar.Time_Zones;
+      use Str_Table;
+
+      Now : constant Time := Clock;
+      Now_UTC : constant Time := Now - Duration (UTC_Time_Offset (Now) * 60);
+      Year : Year_Number;
+      Month : Month_Number;
+      Day : Day_Number;
+      Sec : Day_Duration;
+      S : Integer;
+      S1 : Integer;
+      M : Integer;
+      Res: Time_Stamp_Id;
+   begin
+      --  Use UTC time (like file time stamp).
+      Split (Now_UTC, Year, Month, Day, Sec);
+
+      Res := Time_Stamp_Id (Start);
+      Append (Digit_To_Char (Year / 1000));
+      Append (Digit_To_Char (Year / 100));
+      Append (Digit_To_Char (Year / 10));
+      Append (Digit_To_Char (Year / 1));
+      Append (Digit_To_Char (Month / 10));
+      Append (Digit_To_Char (Month / 1));
+      Append (Digit_To_Char (Day / 10));
+      Append (Digit_To_Char (Day / 1));
+      S := Integer (Sec);
+      if Day_Duration (S) > Sec then
+         --  We need a truncation.
+         S := S - 1;
+      end if;
+      S1 := S / 3600;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+      S1 := (S / 60) mod 60;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+      S1 := S mod 60;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+
+      Append ('.');
+      Sec := Sec - Day_Duration (S);
+      M := Integer (Sec * 1000);
+      if M = 1000 then
+         --  We need truncation.
+         M := 999;
+      end if;
+      Append (Digit_To_Char (M / 100));
+      Append (Digit_To_Char (M / 10));
+      Append (Digit_To_Char (M));
+      Finish;
+      return Res;
+   end Get_Os_Time_Stamp;
+
+   function Get_Pathname (Directory : Name_Id;
+                          Name: Name_Id;
+                          Add_Nul : Boolean)
+     return String
+   is
+      L : Natural;
+   begin
+      Image (Name);
+      if not GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then
+         L := Name_Length;
+         Image (Directory);
+         Name_Buffer (Name_Length + 1 .. Name_Length + L) := Image (Name);
+         Name_Length := Name_Length + L;
+      end if;
+      if Add_Nul then
+         Name_Length := Name_Length + 1;
+         Name_Buffer (Name_Length) := Character'Val (0);
+      end if;
+      return Name_Buffer (1 .. Name_Length);
+   end Get_Pathname;
+
+   --  Find a source_file by DIRECTORY and NAME.
+   --  Return NO_SOURCE_FILE_ENTRY if not already opened.
+   function Find_Source_File (Directory : Name_Id; Name: Name_Id)
+     return Source_File_Entry
+   is
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         if Source_Files.Table (I).File_Name = Name
+           and then Source_Files.Table (I).Directory = Directory
+         then
+            return I;
+         end if;
+      end loop;
+      return No_Source_File_Entry;
+   end Find_Source_File;
+
+   -- Return an entry for a filename.
+   -- The file is not loaded.
+   function Create_Source_File_Entry (Directory : Name_Id; Name: Name_Id)
+     return Source_File_Entry
+   is
+      Res: Source_File_Entry;
+   begin
+      if Find_Source_File (Directory, Name) /= No_Source_File_Entry then
+         raise Internal_Error;
+      end if;
+
+      -- Create a new entry.
+      Res := Source_Files.Allocate;
+      Source_Files.Table (Res) := (First_Location => Next_Location,
+                                   Last_Location => Next_Location,
+                                   File_Name => Name,
+                                   Directory => Directory,
+                                   Time_Stamp => Null_Time_Stamp,
+                                   Source => null,
+                                   File_Length => 0,
+                                   Nbr_Lines => 0,
+                                   Lines_Table_Max => 0,
+                                   Lines_Table => null,
+                                   Cache_Pos => Source_Ptr_Org,
+                                   Cache_Line => 1);
+      File_Add_Line_Number (Res, 1, Source_Ptr_Org);
+      return Res;
+   end Create_Source_File_Entry;
+
+   function Create_Source_File_From_String (Name: Name_Id; Content : String)
+                                           return Source_File_Entry
+   is
+      Res : Source_File_Entry;
+      Buffer: File_Buffer_Acc;
+      Len : constant Source_Ptr := Source_Ptr (Content'Length);
+   begin
+      Res := Create_Source_File_Entry (Null_Identifier, Name);
+
+      Buffer := new File_Buffer
+        (Source_Ptr_Org .. Source_Ptr_Org + Len + 1);
+
+      Buffer (Source_Ptr_Org .. Source_Ptr_Org + Len - 1) :=
+        File_Buffer (Content);
+      Buffer (Source_Ptr_Org + Len) := EOT;
+      Buffer (Source_Ptr_Org + Len + 1) := EOT;
+
+      Source_Files.Table (Res).Last_Location :=
+        Next_Location + Location_Type (Len) + 1;
+      Next_Location := Source_Files.Table (Res).Last_Location + 1;
+      Source_Files.Table (Res).Source := Buffer;
+      Source_Files.Table (Res).File_Length := Natural (Len);
+
+      return Res;
+   end Create_Source_File_From_String;
+
+   function Create_Virtual_Source_File (Name: Name_Id)
+                                       return Source_File_Entry
+   is
+   begin
+      return Create_Source_File_From_String (Name, "");
+   end Create_Virtual_Source_File;
+
+   -- Return an entry for a filename.
+   -- Load the filename if necessary.
+   function Load_Source_File (Directory : Name_Id; Name: Name_Id)
+                              return Source_File_Entry
+   is
+      use GNAT.OS_Lib;
+      Fd: File_Descriptor;
+
+      Res: Source_File_Entry;
+
+      Length: Source_Ptr;
+      Buffer: File_Buffer_Acc;
+   begin
+      --  If the file is already loaded, nothing to do!
+      Res := Find_Source_File (Directory, Name);
+      if Res /= No_Source_File_Entry then
+         if Source_Files.Table (Res).Source = null then
+            raise Internal_Error;
+         end if;
+         return Res;
+      end if;
+
+      --  Open the file (punt on non regular files).
+      declare
+         Filename : String := Get_Pathname (Directory, Name, True);
+      begin
+         if not Is_Regular_File(Filename) then
+            return No_Source_File_Entry;
+         end if;
+         Fd := Open_Read (Filename'Address, Binary);
+         if Fd = Invalid_FD then
+            return No_Source_File_Entry;
+         end if;
+      end;
+
+      Res := Create_Source_File_Entry (Directory, Name);
+
+      Source_Files.Table (Res).Time_Stamp := Get_File_Time_Stamp (Fd);
+
+      Length := Source_Ptr (File_Length (Fd));
+
+      Buffer :=
+        new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length + 1);
+
+      if Read (Fd, Buffer (Source_Ptr_Org)'Address, Integer (Length))
+        /= Integer (Length)
+      then
+         Close (Fd);
+         raise Internal_Error;
+      end if;
+      Buffer (Length) := EOT;
+      Buffer (Length + 1) := EOT;
+
+      if Source_Files.Table (Res).First_Location /= Next_Location then
+         --  Load_Source_File call must follow its Create_Source_File.
+         raise Internal_Error;
+      end if;
+
+      Source_Files.Table (Res).Last_Location :=
+        Next_Location + Location_Type (Length) + 1;
+      Next_Location := Source_Files.Table (Res).Last_Location + 1;
+      Source_Files.Table (Res).Source := Buffer;
+      Source_Files.Table (Res).File_Length := Integer (Length);
+
+      Close (Fd);
+
+      return Res;
+   end Load_Source_File;
+
+   -- Check validity of FILE.
+   -- Raise an exception in case of error.
+   procedure Check_File (File: in Source_File_Entry) is
+   begin
+      if File > Source_Files.Last then
+         raise Internal_Error;
+      end if;
+   end Check_File;
+
+   -- Return a buffer (access to the contents of the file) for a file entry.
+   function Get_File_Source (File: Source_File_Entry)
+                             return File_Buffer_Acc is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Source;
+   end Get_File_Source;
+
+   -- Return the length of the file (which is the size of the file buffer).
+   function Get_File_Length (File: Source_File_Entry) return Source_Ptr is
+   begin
+      Check_File (File);
+      return Source_Ptr (Source_Files.Table (File).File_Length);
+   end Get_File_Length;
+
+   -- Return the name of the file.
+   function Get_File_Name (File: Source_File_Entry) return Name_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).File_Name;
+   end Get_File_Name;
+
+   -- Return the date of the file (last modification date) as a string.
+   function Get_File_Time_Stamp (File: Source_File_Entry)
+     return Time_Stamp_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Time_Stamp;
+   end Get_File_Time_Stamp;
+
+   function Get_Source_File_Directory (File : Source_File_Entry)
+                                       return Name_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Directory;
+   end Get_Source_File_Directory;
+
+   function Line_To_Position (File : Source_File_Entry; Line : Natural)
+                             return Source_Ptr
+   is
+   begin
+      Check_File (File);
+      if Line > Source_Files.Table (File).Nbr_Lines then
+         return Source_Ptr_Bad;
+      else
+         return Source_Files.Table (File).Lines_Table (Line);
+      end if;
+   end Line_To_Position;
+
+   function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
+   is
+      use Str_Table;
+      L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+   begin
+      return L_Str (1 .. Time_Stamp_String'Length)
+        = R_Str (1 .. Time_Stamp_String'Length);
+   end Is_Eq;
+
+   function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
+   is
+      use Str_Table;
+      L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+   begin
+      return L_Str (1 .. Time_Stamp_String'Length)
+        > R_Str (1 .. Time_Stamp_String'Length);
+   end Is_Gt;
+
+   function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is
+   begin
+      if Ts = Null_Time_Stamp then
+         return "NULL_TS";
+      else
+         return String (Str_Table.Get_String_Fat_Acc (String_Id (Ts))
+                          (1 .. Time_Stamp_String'Length));
+      end if;
+   end Get_Time_Stamp_String;
+
+   -- Debug procedures.
+   procedure Debug_Source_Lines (File: Source_File_Entry);
+   pragma Unreferenced (Debug_Source_Lines);
+
+   procedure Debug_Source_File;
+   pragma Unreferenced (Debug_Source_File);
+
+   --  Disp sources lines of a file.
+   procedure Debug_Source_Lines (File: Source_File_Entry) is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+   begin
+      Check_File (File);
+      for I in Positive'First .. Source_File.Nbr_Lines loop
+         Put_Line ("line" & Natural'Image (I) & " at offset"
+                   & Source_Ptr'Image (Source_File.Lines_Table (I)));
+      end loop;
+   end Debug_Source_Lines;
+
+   procedure Debug_Source_File is
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         declare
+            F : Source_File_Record renames Source_Files.Table(I);
+         begin
+            Put ("file" & Source_File_Entry'Image (I));
+            Put (" name: " & Image (F.File_Name));
+            Put (" dir:" & Image (F.Directory));
+            Put (" length:" & Natural'Image (F.File_Length));
+            New_Line;
+            if F.Time_Stamp /= Null_Time_Stamp then
+               Put (" time_stamp: " & Get_Time_Stamp_String (F.Time_Stamp));
+            end if;
+            Put (" nbr lines:" & Natural'Image (F.Nbr_Lines));
+            Put (" lines_table_max:" & Natural'Image (F.Lines_Table_Max));
+            New_Line;
+         end;
+      end loop;
+   end Debug_Source_File;
+
+   procedure Initialize
+   is
+      procedure free (Ptr : Lines_Table_Ptr);
+      pragma Import (C, free);
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (File_Buffer, File_Buffer_Acc);
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         free (Source_Files.Table (I).Lines_Table);
+         Free (Source_Files.Table (I).Source);
+      end loop;
+      Source_Files.Free;
+      Source_Files.Init;
+   end Initialize;
+end Files_Map;
diff --git a/src/files_map.ads b/src/files_map.ads
new file mode 100644
index 000000000..c360995c3
--- /dev/null
+++ b/src/files_map.ads
@@ -0,0 +1,152 @@
+--  Loading of source files.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with System;
+
+package Files_Map is
+
+   -- Source file handling
+   -----------------------
+
+   --  Create the path from DIRECTORY and NAME:
+   --  If NAME is an absolute pathname, then return NAME.
+   --  Otherwise, return the concatenation of DIRECTORY and NAME.
+   --  If ADD_NUL is TRUE, then a trailing '\0' is appended.
+   function Get_Pathname (Directory : Name_Id;
+                          Name: Name_Id;
+                          Add_Nul : Boolean)
+     return String;
+
+   --  Return an entry for a filename.
+   --  Load the filename if necessary.
+   --  Return No_Source_File_Entry if the file does not exist.
+   function Load_Source_File (Directory : Name_Id; Name: Name_Id)
+                              return Source_File_Entry;
+
+   --  Each file in memory has two terminal EOT.
+   EOT : constant Character := Character'Val (4);
+
+   --  Create a Source_File for a virtual file name.  Used for implicit,
+   --  command-line and std.standard library.
+   function Create_Virtual_Source_File (Name: Name_Id)
+                                       return Source_File_Entry;
+
+   --  Create a Source_File for a possible virtual file NAME using CONTENT
+   --  as content of the file.  The file must not already exist.
+   function Create_Source_File_From_String (Name: Name_Id; Content : String)
+                                           return Source_File_Entry;
+
+   -- Return a buffer (access to the contents of the file) for a file entry.
+   function Get_File_Source (File: Source_File_Entry)
+                             return File_Buffer_Acc;
+
+   -- Return the length of the file (which is the size of the file buffer).
+   function Get_File_Length (File: Source_File_Entry) return Source_Ptr;
+
+   --  Return the entry of the last known file.
+   --  This allow the user to create a table of Source_File_Entry.
+   function Get_Last_Source_File_Entry return Source_File_Entry;
+
+   --  Time stamp handling.
+   function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean;
+   function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean;
+   function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String;
+
+   -- Return the date of the file (last modification date) as a string.
+   function Get_File_Time_Stamp (File: Source_File_Entry)
+     return Time_Stamp_Id;
+   function Get_File_Time_Stamp (Filename : System.Address)
+     return Time_Stamp_Id;
+
+   -- Return the current date of the system.
+   function Get_Os_Time_Stamp return Time_Stamp_Id;
+
+   -- Return the home directory (current directory).
+   function Get_Home_Directory return Name_Id;
+
+   -- Return the directory of the file.
+   function Get_Source_File_Directory (File : Source_File_Entry)
+                                       return Name_Id;
+
+   -- Return the name of the file.
+   function Get_File_Name (File: Source_File_Entry) return Name_Id;
+
+   --  Get the path of directory DIR.
+   --function Get_Directory_Path (Dir : Directory_Index) return String;
+
+   -- Add a new entry in the lines_table.
+   -- The new entry must be the next one after the last entry.
+   procedure File_Add_Line_Number
+     (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr);
+
+   --  Convert LOCATION into a source file FILE and an offset POS in the
+   --  file.
+   procedure Location_To_File_Pos (Location : Location_Type;
+                                   File : out Source_File_Entry;
+                                   Pos : out Source_Ptr);
+   --  Convert a FILE and an offset POS in the file into a location.
+   function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr)
+     return Location_Type;
+   --  Convert a FILE into a location.
+   function Source_File_To_Location (File : Source_File_Entry)
+     return Location_Type;
+
+   --  Convert a FILE+LINE into a position.
+   --  Return Source_Ptr_Bad in case of error (LINE out of bounds).
+   function Line_To_Position (File : Source_File_Entry; Line : Natural)
+                             return Source_Ptr;
+
+   --  Translate LOCATION into coordinate (physical position).
+   --  FILE identifies the filename.
+   --  LINE_POS is the offset in the file of the first character of the line,
+   --  LINE is the line number (first line is 1),
+   --  OFFSET is the offset of the location in the line (first character is 0,
+   --     a tabulation is one character),
+   procedure Location_To_Coord
+     (Location : Location_Type;
+      File : out Source_File_Entry;
+      Line_Pos : out Source_Ptr;
+      Line : out Natural;
+      Offset : out Natural);
+
+   --  Translate coordinate into logical position.
+   --  NAME is the name of the file,
+   --  COL is the column (first character is 1, tabulation are at every 8
+   --    positions).
+   procedure Coord_To_Position
+     (File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Offset : Natural;
+      Name : out Name_Id;
+      Col : out Natural);
+
+   --  Translate LOCATION to NAME, LINE and COL.
+   --  It is like to two procedures above.
+   procedure Location_To_Position
+     (Location : Location_Type;
+      Name : out Name_Id;
+      Line : out Natural;
+      Col : out Natural);
+
+   --  Get LINE and COL from LOCATION.
+   --procedure Get_Source_File_Line_And_Column
+   --  (Location: Location_Type; Line, Col: out Natural; Name : out Name_Id);
+
+   --  Free all memory and reinitialize.
+   procedure Initialize;
+end Files_Map;
diff --git a/src/flags.adb b/src/flags.adb
new file mode 100644
index 000000000..fc00368a5
--- /dev/null
+++ b/src/flags.adb
@@ -0,0 +1,53 @@
+--  Global flags.
+--  Copyright (C) 2002, 2003, 2004, 2005, 2008 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Flags is
+   procedure Create_Flag_String is
+   begin
+      case Vhdl_Std is
+         when Vhdl_87 =>
+            Flag_String (1 .. 2) := "87";
+         when Vhdl_93c
+           | Vhdl_93
+           | Vhdl_00
+           | Vhdl_02 =>
+            Flag_String (1 .. 2) := "93";
+         when Vhdl_08 =>
+            Flag_String (1 .. 2) := "08";
+      end case;
+      if Flag_Integer_64 then
+         Flag_String (3) := 'I';
+      else
+         Flag_String (3) := 'i';
+      end if;
+      if Flag_Time_64 then
+         Flag_String (4) := 'T';
+      else
+         Flag_String (4) := 't';
+      end if;
+      if not Flag_Time_64 and Vhdl_Std = Vhdl_87 then
+         Flag_String (5) := Time_Resolution;
+      else
+         if Flag_Time_64 then
+            Flag_String (5) := '-';
+         else
+            Flag_String (5) := '?';
+         end if;
+      end if;
+   end Create_Flag_String;
+end Flags;
diff --git a/src/flags.ads b/src/flags.ads
new file mode 100644
index 000000000..03e9fe959
--- /dev/null
+++ b/src/flags.ads
@@ -0,0 +1,190 @@
+--  Global flags.
+--  Copyright (C) 2002, 2003, 2004, 2005, 2008 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+--  All the variables declared in this package are set by Parse_Option function
+--  and can by read as soon as the command line is parsed.
+--
+--  Since the names are not prefixed, this package is expected to be with'ed
+--  but not to be use'd.
+
+package Flags is
+   --  List of vhdl standards.
+   --  VHDL_93c is vhdl_93 with backward compatibility with 87 (file).
+   type Vhdl_Std_Type is
+     (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02, Vhdl_08);
+
+   --  Standard accepted.
+   Vhdl_Std: Vhdl_Std_Type := Vhdl_93c;
+
+   --  Enable AMS-VHDL extensions.
+   AMS_Vhdl : Boolean := False;
+
+   --  Some flags (such as vhdl version) must be the same for every design
+   --  units of a hierarchy.
+   --  The Flag_String is a signature of all these flags.
+   Flag_String : String (1 .. 5);
+   procedure Create_Flag_String;
+
+   -- If set, a multi-bytes sequence can appear in a comment, ie, all
+   -- characters except VT, CR, LF and FF are allowed in a comment.
+   -- Set by -C and --mb-comments
+   Mb_Comment: Boolean := False;
+
+   -- If set, relax rules about std library: working library can be std.
+   Bootstrap : Boolean := False;
+
+   --  Options -dX
+   --  -dp: disp tree after parsing
+   Dump_Parse: Boolean := False;
+
+   --  -ds: disp tree after semantic
+   Dump_Sem: Boolean := False;
+
+   --  -dc: disp tree after canon
+   Dump_Canon : Boolean := False;
+
+   --  -da: disp tree after annotation
+   Dump_Annotate: Boolean := False;
+
+   --  --dall: makes -dX options to apply to all files.
+   Dump_All: Boolean := False;
+
+   --  -dstats: disp statistics.
+   Dump_Stats : Boolean := False;
+
+   -- -lX options: list tree as a vhdl file.
+
+   -- --lall option: makes -lX options to apply to all files
+   List_All: Boolean := False;
+
+   -- -lv: list verbose
+   List_Verbose: Boolean := False;
+
+   -- -ls: list tree after semantic.
+   List_Sem: Boolean := False;
+
+   -- -lc: list tree after canon.
+   List_Canon: Boolean := False;
+
+   -- -la: list tree after back-end annotation.
+   List_Annotate: Boolean := False;
+
+   -- -v: disp phase of compilation.
+   Verbose : Boolean := False;
+
+   --  If set to true, it means that analyze is done for elaboration.
+   --  The purpose is to avoid spurious warning "will be checked
+   --  at elaboration"
+   Flag_Elaborate : Boolean := False;
+
+   --  If set, a default aspect entity aspect might be an outdated unit.
+   --  Used by ghdldrv.
+   Flag_Elaborate_With_Outdated : Boolean := False;
+
+   --  Do not display parse and sem warnings.  Used during elaboration.
+   Flag_Only_Elab_Warnings : Boolean := False;
+
+   --  If set, explicit subprogram declarations take precedence over
+   --  implicit declarations, even through use clauses.
+   Flag_Explicit : Boolean := False;
+
+   --  If set, use 'L.C' rule from VHDL02 to do default component binding.
+   Flag_Syn_Binding : Boolean := False;
+
+   --  If set, performs VITAL checks.
+   Flag_Vital_Checks : Boolean := True;
+
+   -- --time-resolution=X
+   -- Where X corresponds to:
+   -- fs => 'f'
+   -- ps => 'p'
+   -- ns => 'n'
+   -- us => 'u'
+   -- ms => 'm'
+   -- sec => 's'
+   -- min => 'M'
+   -- hr => 'h'
+   Time_Resolution: Character := 'f';
+
+   --  Integer and time types can be either 32 bits or 64 bits values.
+   --  The default is 32 bits for Integer and 64 bits for Time.
+   --  Be very careful: if you don't use the default sizes, you may have to
+   --  change other parts of your systems (such as GRT).
+   Flag_Integer_64 : Boolean := False;
+   Flag_Time_64 : Boolean := True;
+
+   --  If set, generate cross-references during sem.
+   Flag_Xref : Boolean := False;
+
+   --  If set, all the design units are analyzed in whole to do the simulation.
+   Flag_Whole_Analyze : Boolean := False;
+
+   --  If true, relax some rules:
+   --  * the scope of an object declaration names start after the declaration,
+   --    so that it is possible to use the old name in the default expression:
+   --    constant x : xtype := x;
+   Flag_Relaxed_Rules : Boolean := False;
+
+   -- --warn-undriven
+   --Warn_Undriven : Boolean := False;
+
+   --  --warn-default-binding
+   --  Should emit a warning when there is no default binding for a component
+   --  instantiation.
+   Warn_Default_Binding : Boolean := False;
+
+   --  --warn-binding
+   --  Emit a warning at elaboration for unbound component.
+   Warn_Binding : Boolean := True;
+
+   --  --warn-reserved
+   --  Emit a warning when a vhdl93 reserved word is used as a
+   --  vhdl87 identifier.
+   Warn_Reserved_Word : Boolean := False;
+
+   --  --warn-library
+   --  Emit a warning when a design unit redefines another design unit.
+   Warn_Library : Boolean := False;
+
+   --  --warn-vital-generic
+   --  Emit a warning when a generic of a vital entity is not a vital name.
+   Warn_Vital_Generic : Boolean := True;
+
+   --  --warn-delayed-checks
+   --  Emit warnings about delayed checks (checks performed at elaboration
+   --   time).
+   Warn_Delayed_Checks : Boolean := False;
+
+   --  --warn-body
+   --  Emit a warning when a package body is not required but is analyzed.
+   Warn_Body : Boolean := True;
+
+   --  --warn-specs
+   --  Emit a warning when an all/others specification does not apply, because
+   --  there is no such named entities.
+   Warn_Specs : Boolean := True;
+
+   --  --warn-unused
+   --  Emit a warning when a declaration is never used.
+   --  FIXME: currently only subprograms are handled.
+   Warn_Unused : Boolean := True;
+
+   --  --warn-error
+   --  Turns warnings into errors.
+   Warn_Error : Boolean := False;
+end Flags;
diff --git a/src/ieee-std_logic_1164.adb b/src/ieee-std_logic_1164.adb
new file mode 100644
index 000000000..ee58fe7a5
--- /dev/null
+++ b/src/ieee-std_logic_1164.adb
@@ -0,0 +1,170 @@
+--  Nodes recognizer for ieee.std_logic_1164.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Std_Names; use Std_Names;
+with Errorout; use Errorout;
+with Std_Package;
+
+package body Ieee.Std_Logic_1164 is
+   function Skip_Implicit (Decl : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Decl;
+      loop
+         exit when Res = Null_Iir;
+         exit when Get_Kind (Res) /= Iir_Kind_Implicit_Function_Declaration;
+         Res := Get_Chain (Res);
+      end loop;
+      return Res;
+   end Skip_Implicit;
+
+   procedure Extract_Declarations (Pkg : Iir_Package_Declaration)
+   is
+      Error : exception;
+
+      Decl : Iir;
+      Def : Iir;
+   begin
+      Std_Logic_1164_Pkg := Pkg;
+
+      Decl := Get_Declaration_Chain (Pkg);
+
+      --  Skip a potential copyright constant.
+      if Decl /= Null_Iir
+        and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration
+        and then (Get_Base_Type (Get_Type (Decl))
+                  = Std_Package.String_Type_Definition)
+      then
+         Decl := Get_Chain (Decl);
+      end if;
+
+      --  The first declaration should be type std_ulogic.
+      if Decl = Null_Iir
+        or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration
+        or else Get_Identifier (Decl) /= Name_Std_Ulogic
+      then
+         raise Error;
+      end if;
+
+      Def := Get_Type_Definition (Decl);
+      if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then
+         raise Error;
+      end if;
+      Std_Ulogic_Type := Def;
+
+      --  The second declaration should be std_ulogic_vector.
+      Decl := Get_Chain (Decl);
+      Decl := Skip_Implicit (Decl);
+      if Decl = Null_Iir
+        or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration
+        or else Get_Identifier (Decl) /= Name_Std_Ulogic_Vector
+      then
+         raise Error;
+      end if;
+      Def := Get_Type_Definition (Decl);
+      if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then
+         raise Error;
+      end if;
+      Std_Ulogic_Vector_Type := Def;
+
+      --  The third declaration should be resolved.
+      Decl := Get_Chain (Decl);
+      Decl := Skip_Implicit (Decl);
+      if Decl = Null_Iir
+        or else Get_Kind (Decl) /= Iir_Kind_Function_Declaration
+      then
+         --  FIXME: check name ?
+         raise Error;
+      end if;
+      Resolved := Decl;
+
+      --  The fourth declaration should be std_logic.
+      Decl := Get_Chain (Decl);
+      Decl := Skip_Implicit (Decl);
+      if Decl = Null_Iir
+        or else Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration
+        or else Get_Identifier (Decl) /= Name_Std_Logic
+      then
+         raise Error;
+      end if;
+      Def := Get_Type (Decl);
+      if Get_Kind (Def) /= Iir_Kind_Enumeration_Subtype_Definition then
+         raise Error;
+      end if;
+      Std_Logic_Type := Def;
+
+      --  The fifth declaration should be std_logic_vector.
+      Decl := Get_Chain (Decl);
+      Decl := Skip_Implicit (Decl);
+      if Decl = Null_Iir
+        or else (Get_Kind (Decl) /= Iir_Kind_Type_Declaration
+                   and then Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration)
+        or else Get_Identifier (Decl) /= Name_Std_Logic_Vector
+      then
+         raise Error;
+      end if;
+      Def := Get_Type (Decl);
+--      if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then
+--         raise Error;
+--      end if;
+      Std_Logic_Vector_Type := Def;
+
+      --  Skip any declarations but functions.
+      loop
+         Decl := Get_Chain (Decl);
+         exit when Decl = Null_Iir;
+
+         if Get_Kind (Decl) = Iir_Kind_Function_Declaration then
+            if Get_Identifier (Decl) = Name_Rising_Edge then
+               Rising_Edge := Decl;
+            elsif Get_Identifier (Decl) = Name_Falling_Edge then
+               Falling_Edge := Decl;
+            end if;
+         end if;
+      end loop;
+
+      --  Since rising_edge and falling_edge do not read activity of its
+      --  parameter, clear the flag to allow more optimizations.
+      if Rising_Edge /= Null_Iir then
+         Set_Has_Active_Flag
+           (Get_Interface_Declaration_Chain (Rising_Edge), False);
+      else
+         raise Error;
+      end if;
+      if Falling_Edge /= Null_Iir then
+         Set_Has_Active_Flag
+           (Get_Interface_Declaration_Chain (Falling_Edge), False);
+      else
+         raise Error;
+      end if;
+
+   exception
+      when Error =>
+         Error_Msg_Sem ("package ieee.std_logic_1164 is ill-formed", Pkg);
+
+         --  Clear all definitions.
+         Std_Logic_1164_Pkg := Null_Iir;
+         Std_Ulogic_Type := Null_Iir;
+         Std_Ulogic_Vector_Type := Null_Iir;
+         Std_Logic_Type := Null_Iir;
+         Std_Logic_Vector_Type := Null_Iir;
+         Rising_Edge := Null_Iir;
+         Falling_Edge := Null_Iir;
+   end Extract_Declarations;
+end Ieee.Std_Logic_1164;
diff --git a/src/ieee-std_logic_1164.ads b/src/ieee-std_logic_1164.ads
new file mode 100644
index 000000000..b1f14f272
--- /dev/null
+++ b/src/ieee-std_logic_1164.ads
@@ -0,0 +1,35 @@
+--  Nodes recognizer for ieee.std_logic_1164.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Ieee.Std_Logic_1164 is
+   --  Nodes corresponding to declarations in the package.
+   Std_Logic_1164_Pkg : Iir_Package_Declaration := Null_Iir;
+   Std_Ulogic_Type : Iir_Enumeration_Type_Definition := Null_Iir;
+   Std_Ulogic_Vector_Type : Iir_Array_Type_Definition := Null_Iir;
+   Std_Logic_Type : Iir_Enumeration_Subtype_Definition := Null_Iir;
+   Std_Logic_Vector_Type : Iir_Array_Type_Definition := Null_Iir;
+   Resolved : Iir_Function_Declaration := Null_Iir;
+   Rising_Edge : Iir_Function_Declaration := Null_Iir;
+   Falling_Edge : Iir_Function_Declaration := Null_Iir;
+
+   --  Extract declarations from PKG.
+   --  PKG is the package declaration for ieee.std_logic_1164 package.
+   --  Fills the node aboves.
+   procedure Extract_Declarations (Pkg : Iir_Package_Declaration);
+end Ieee.Std_Logic_1164;
diff --git a/src/ieee-vital_timing.adb b/src/ieee-vital_timing.adb
new file mode 100644
index 000000000..d6429e251
--- /dev/null
+++ b/src/ieee-vital_timing.adb
@@ -0,0 +1,1377 @@
+--  Nodes recognizer for ieee.vital_timing.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Std_Names;
+with Errorout; use Errorout;
+with Std_Package; use Std_Package;
+with Tokens; use Tokens;
+with Name_Table;
+with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164;
+with Sem_Scopes;
+with Evaluation;
+with Sem;
+with Iirs_Utils;
+with Flags;
+
+package body Ieee.Vital_Timing is
+   --  This package is based on IEEE 1076.4 1995.
+
+   --  Control generics identifier.
+   InstancePath_Id : Name_Id;
+   TimingChecksOn_Id : Name_Id;
+   XOn_Id : Name_Id;
+   MsgOn_Id : Name_Id;
+
+   --  Extract declarations from package IEEE.VITAL_Timing.
+   procedure Extract_Declarations (Pkg : Iir_Package_Declaration)
+   is
+      use Name_Table;
+
+      Ill_Formed : exception;
+
+      Decl : Iir;
+      Id : Name_Id;
+
+      VitalDelayType_Id : Name_Id;
+      VitalDelayType01_Id   : Name_Id;
+      VitalDelayType01Z_Id  : Name_Id;
+      VitalDelayType01ZX_Id : Name_Id;
+
+      VitalDelayArrayType_Id     : Name_Id;
+      VitalDelayArrayType01_Id   : Name_Id;
+      VitalDelayArrayType01Z_Id  : Name_Id;
+      VitalDelayArrayType01ZX_Id : Name_Id;
+   begin
+      --  Get Vital delay type identifiers.
+      Name_Buffer (1 .. 18) := "vitaldelaytype01zx";
+      Name_Length := 14;
+      VitalDelayType_Id := Get_Identifier_No_Create;
+      if VitalDelayType_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 16;
+      VitalDelayType01_Id := Get_Identifier_No_Create;
+      if VitalDelayType01_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 17;
+      VitalDelayType01Z_Id := Get_Identifier_No_Create;
+      if VitalDelayType01Z_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 18;
+      VitalDelayType01ZX_Id := Get_Identifier_No_Create;
+      if VitalDelayType01ZX_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+
+      Name_Buffer (1 .. 23) := "vitaldelayarraytype01zx";
+      Name_Length := 19;
+      VitalDelayArrayType_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 21;
+      VitalDelayArrayType01_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 22;
+      VitalDelayArrayType01Z_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01Z_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+      Name_Length := 23;
+      VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create;
+      if VitalDelayArrayType01ZX_Id = Null_Identifier then
+         raise Ill_Formed;
+      end if;
+
+      --  Iterate on every declaration.
+      --  Do name-matching.
+      Decl := Get_Declaration_Chain (Pkg);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Attribute_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = Std_Names.Name_VITAL_Level0 then
+                  Vital_Level0_Attribute := Decl;
+               elsif Id = Std_Names.Name_VITAL_Level1 then
+                  Vital_Level1_Attribute := Decl;
+               end if;
+            when Iir_Kind_Subtype_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayType_Id then
+                  VitalDelayType := Get_Type (Decl);
+               end if;
+            when Iir_Kind_Type_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayArrayType_Id then
+                  VitalDelayArrayType := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01_Id then
+                  VitalDelayArrayType01 := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01Z_Id then
+                  VitalDelayArrayType01Z := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayArrayType01ZX_Id then
+                  VitalDelayArrayType01ZX := Get_Type_Definition (Decl);
+               end if;
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Id := Get_Identifier (Decl);
+               if Id = VitalDelayType01_Id then
+                  VitalDelayType01 := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayType01Z_Id then
+                  VitalDelayType01Z := Get_Type_Definition (Decl);
+               elsif Id = VitalDelayType01ZX_Id then
+                  VitalDelayType01ZX := Get_Type_Definition (Decl);
+               end if;
+            when others =>
+               null;
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      --  If a declaration was not found, then the package is not the expected
+      --  one.
+      if Vital_Level0_Attribute = Null_Iir
+        or Vital_Level1_Attribute = Null_Iir
+        or VitalDelayType = Null_Iir
+        or VitalDelayType01 = Null_Iir
+        or VitalDelayType01Z = Null_Iir
+        or VitalDelayType01ZX = Null_Iir
+        or VitalDelayArrayType = Null_Iir
+        or VitalDelayArrayType01 = Null_Iir
+        or VitalDelayArrayType01Z = Null_Iir
+        or VitalDelayArrayType01ZX = Null_Iir
+      then
+         raise Ill_Formed;
+      end if;
+
+      --  Create identifier for control generics.
+      InstancePath_Id := Get_Identifier ("instancepath");
+      TimingChecksOn_Id := Get_Identifier ("timingcheckson");
+      XOn_Id := Get_Identifier ("xon");
+      MsgOn_Id := Get_Identifier ("msgon");
+
+      exception
+         when Ill_Formed =>
+            Error_Msg_Sem ("package ieee.vital_timing is ill-formed", Pkg);
+
+            Vital_Level0_Attribute := Null_Iir;
+            Vital_Level1_Attribute := Null_Iir;
+
+            VitalDelayType := Null_Iir;
+            VitalDelayType01 := Null_Iir;
+            VitalDelayType01Z := Null_Iir;
+            VitalDelayType01ZX := Null_Iir;
+
+            VitalDelayArrayType := Null_Iir;
+            VitalDelayArrayType01 := Null_Iir;
+            VitalDelayArrayType01Z := Null_Iir;
+            VitalDelayArrayType01ZX := Null_Iir;
+   end Extract_Declarations;
+
+   procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem;
+   procedure Error_Vital (Msg : String; Loc : Location_Type)
+     renames Error_Msg_Sem;
+   procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem;
+
+   --  Check DECL is the VITAL level 0 attribute specification.
+   procedure Check_Level0_Attribute_Specification (Decl : Iir)
+   is
+      Expr : Iir;
+   begin
+      if Get_Kind (Decl) /= Iir_Kind_Attribute_Specification
+        or else (Get_Named_Entity (Get_Attribute_Designator (Decl))
+                   /= Vital_Level0_Attribute)
+      then
+         Error_Vital
+           ("first declaration must be the VITAL attribute specification",
+            Decl);
+         return;
+      end if;
+
+      --  IEEE 1076.4 4.1
+      --  The expression in the VITAL_Level0 attribute specification shall be
+      --  the Boolean literal TRUE.
+      Expr := Get_Expression (Decl);
+      if Get_Kind (Expr) not in Iir_Kinds_Denoting_Name
+        or else Get_Named_Entity (Expr) /= Boolean_True
+      then
+         Error_Vital
+           ("the expression in the VITAL_Level0 attribute specification shall "
+            & "be the Boolean literal TRUE", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.1
+      --  The entity specification of the decorating attribute specification
+      --  shall be such that the enclosing entity or architecture inherits the
+      --  VITAL_Level0 attribute.
+      case Get_Entity_Class (Decl) is
+         when Tok_Entity
+           | Tok_Architecture =>
+            null;
+         when others =>
+            Error_Vital ("VITAL attribute specification does not decorate the "
+                         & "enclosing entity or architecture", Decl);
+      end case;
+   end Check_Level0_Attribute_Specification;
+
+   procedure Check_Entity_Port_Declaration
+     (Decl : Iir_Interface_Signal_Declaration)
+   is
+      use Name_Table;
+
+      Atype : Iir;
+      Base_Type : Iir;
+      Type_Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  The identifiers in an entity port declaration shall not contain
+      --  underscore characters.
+      Image (Get_Identifier (Decl));
+      if Name_Buffer (1) = '/' then
+         Error_Vital ("VITAL entity port shall not be an extended identifier",
+                      Decl);
+      end if;
+      for I in 1 .. Name_Length loop
+         if Name_Buffer (I) = '_' then
+            Error_Vital
+              ("VITAL entity port shall not contain underscore", Decl);
+            exit;
+         end if;
+      end loop;
+
+      --  IEEE 1076.4 4.3.1
+      --  A port that is declared in an entity port declaration shall not be
+      --  of mode LINKAGE.
+      if Get_Mode (Decl) = Iir_Linkage_Mode then
+         Error_Vital ("VITAL entity port shall not be of mode LINKAGE", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.3.1
+      --  The type mark in an entity port declaration shall denote a type or
+      --  a subtype that is declared in package Std_Logic_1164.  The type
+      --  mark in the declaration of a scalar port shall denote the subtype
+      --  Std_Ulogic or a subtype of Std_Ulogic.  The type mark in the
+      --  declaration of an array port shall denote the type Std_Logic_Vector.
+      Atype := Get_Type (Decl);
+      Base_Type := Get_Base_Type (Atype);
+      Type_Decl := Get_Type_Declarator (Atype);
+      if Base_Type = Std_Logic_Vector_Type then
+         if Get_Resolution_Indication (Atype) /= Null_Iir then
+            Error_Vital
+              ("VITAL array port type cannot override resolution function",
+               Decl);
+         end if;
+         --  FIXME: is an unconstrained array port allowed ?
+         --  FIXME: what about staticness of the index_constraint ?
+      elsif Base_Type = Std_Ulogic_Type then
+         if Type_Decl = Null_Iir
+           or else Get_Parent (Type_Decl) /= Std_Logic_1164_Pkg
+         then
+            Error_Vital
+              ("VITAL entity port type mark shall be one of Std_Logic_1164",
+               Decl);
+         end if;
+      else
+         Error_Vital ("VITAL port type must be Std_Logic_Vector or Std_Ulogic",
+                      Decl);
+      end if;
+
+      if Get_Signal_Kind (Decl) /= Iir_No_Signal_Kind then
+         Error_Vital ("VITAL entity port cannot be guarded", Decl);
+      end if;
+   end Check_Entity_Port_Declaration;
+
+   --  Current position in the generic name, stored into
+   --  name_table.name_buffer.
+   Gen_Name_Pos : Natural;
+
+   --  Length of the generic name.
+   Gen_Name_Length : Natural;
+
+   --  The generic being analyzed.
+   Gen_Decl : Iir;
+   Gen_Chain : Iir;
+
+   procedure Error_Vital_Name (Str : String)
+   is
+      Loc : Location_Type;
+   begin
+      Loc := Get_Location (Gen_Decl);
+      Error_Vital (Str, Loc + Location_Type (Gen_Name_Pos - 1));
+   end Error_Vital_Name;
+
+   --  Check the next sub-string in the generic name is a port.
+   --  Returns the port.
+   function Check_Port return Iir
+   is
+      use Sem_Scopes;
+      use Name_Table;
+
+      C : Character;
+      Res : Iir;
+      Id : Name_Id;
+      Inter : Name_Interpretation_Type;
+   begin
+      Name_Length := 0;
+      while Gen_Name_Pos <= Gen_Name_Length loop
+         C := Name_Buffer (Gen_Name_Pos);
+         Gen_Name_Pos := Gen_Name_Pos + 1;
+         exit when C = '_';
+         Name_Length := Name_Length + 1;
+         Name_Buffer (Name_Length) := C;
+      end loop;
+
+      if Name_Length = 0 then
+         Error_Vital_Name ("port expected in VITAL generic name");
+         return Null_Iir;
+      end if;
+
+      Id := Get_Identifier_No_Create;
+      Res := Null_Iir;
+      if Id /= Null_Identifier then
+         Inter := Get_Interpretation (Id);
+         if Valid_Interpretation (Inter) then
+            Res := Get_Declaration (Inter);
+         end if;
+      end if;
+      if Res = Null_Iir then
+         Warning_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                        & "' is not a port name (in VITAL generic name)",
+                        Gen_Decl);
+      end if;
+      return Res;
+   end Check_Port;
+
+   --  Checks the port is an input port.
+   function Check_Input_Port return Iir
+   is
+      use Name_Table;
+
+      Res : Iir;
+   begin
+      Res := Check_Port;
+      if Res /= Null_Iir then
+         --  IEEE 1076.4 4.3.2.1.3
+         --  an input port is a VHDL port of mode IN or INOUT.
+         case Get_Mode (Res) is
+            when Iir_In_Mode
+              | Iir_Inout_Mode =>
+               null;
+            when others =>
+               Error_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                            & "' must be an input port", Gen_Decl);
+         end case;
+      end if;
+      return Res;
+   end Check_Input_Port;
+
+   --  Checks the port is an output port.
+   function Check_Output_Port return Iir
+   is
+      use Name_Table;
+
+      Res : Iir;
+   begin
+      Res := Check_Port;
+      if Res /= Null_Iir then
+         --  IEEE 1076.4 4.3.2.1.3
+         --  An output port is a VHDL port of mode OUT, INOUT or BUFFER.
+         case Get_Mode (Res) is
+            when Iir_Out_Mode
+              | Iir_Inout_Mode
+              | Iir_Buffer_Mode =>
+               null;
+            when others =>
+               Error_Vital ("'" & Name_Buffer (1 .. Name_Length)
+                            & "' must be an output port", Gen_Decl);
+         end case;
+      end if;
+      return Res;
+   end Check_Output_Port;
+
+   --  Extract a suffix from the generic name.
+   type Suffixes_Kind is
+     (
+      Suffix_Name,     --  [a-z]*
+      Suffix_Num_Name,  --  [0-9]*
+      Suffix_Edge,     --  posedge, negedge, 01, 10, 0z, z1, 1z, z0
+      Suffix_Noedge,   --  noedge
+      Suffix_Eon       --  End of name
+     );
+
+   function Get_Next_Suffix_Kind return Suffixes_Kind
+   is
+      use Name_Table;
+
+      Len : Natural;
+      P : constant Natural := Gen_Name_Pos;
+      C : Character;
+   begin
+      Len := 0;
+      while Gen_Name_Pos <= Gen_Name_Length loop
+         C := Name_Buffer (Gen_Name_Pos);
+         Gen_Name_Pos := Gen_Name_Pos + 1;
+         exit when C = '_';
+         Len := Len + 1;
+      end loop;
+      if Len = 0 then
+         return Suffix_Eon;
+      end if;
+
+      case Name_Buffer (P) is
+         when '0' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '1'
+                                 or Name_Buffer (P + 1) = 'z')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Num_Name;
+            end if;
+         when '1' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '0'
+                                 or Name_Buffer (P + 1) = 'z')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Num_Name;
+            end if;
+         when '2' .. '9' =>
+            return Suffix_Num_Name;
+         when 'z' =>
+            if Len = 2 and then (Name_Buffer (P + 1) = '0'
+                                 or Name_Buffer (P + 1) = '1')
+            then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'p' =>
+            if Len = 7 and then Name_Buffer (P .. P + 6) = "posedge" then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'n' =>
+            if Len = 7 and then Name_Buffer (P .. P + 6) = "negedge" then
+               return Suffix_Edge;
+            elsif Len = 6 and then Name_Buffer (P .. P + 5) = "noedge" then
+               return Suffix_Edge;
+            else
+               return Suffix_Name;
+            end if;
+         when 'a' .. 'm'
+           | 'o'
+           | 'q' .. 'y' =>
+            return Suffix_Name;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Next_Suffix_Kind;
+
+   --  <SDFSimpleConditionAndOrEdge> ::=
+   --     <ConditionName>
+   --   | <Edge>
+   --   | <ConditionName>_<Edge>
+   procedure Check_Simple_Condition_And_Or_Edge
+   is
+      First : Boolean := True;
+   begin
+      loop
+         case Get_Next_Suffix_Kind is
+            when Suffix_Eon =>
+               --  Simple condition is optional.
+               return;
+            when Suffix_Edge =>
+               if Get_Next_Suffix_Kind /= Suffix_Eon then
+                  Error_Vital_Name ("garbage after edge");
+               end if;
+               return;
+            when Suffix_Num_Name =>
+               if First then
+                  Error_Vital_Name ("condition is a simple name");
+               end if;
+            when Suffix_Noedge =>
+               Error_Vital_Name ("'noedge' not allowed in simple condition");
+            when Suffix_Name =>
+               null;
+         end case;
+         First := False;
+      end loop;
+   end Check_Simple_Condition_And_Or_Edge;
+
+   --  <SDFFullConditionAndOrEdge> ::=
+   --    <ConditionNameEdge>[_<SDFSimpleConditionAndOrEdge>]
+   --
+   --  <ConditionNameEdge> ::=
+   --      [<ConditionName>_]<Edge>
+   --    | [<ConditionName>_]noedge
+   procedure Check_Full_Condition_And_Or_Edge
+   is
+   begin
+      case Get_Next_Suffix_Kind is
+         when Suffix_Eon =>
+            --  FullCondition is always optional.
+            return;
+         when Suffix_Edge
+           | Suffix_Noedge =>
+            Check_Simple_Condition_And_Or_Edge;
+            return;
+         when Suffix_Num_Name =>
+            Error_Vital_Name ("condition is a simple name");
+         when Suffix_Name =>
+            null;
+      end case;
+
+      loop
+         case Get_Next_Suffix_Kind is
+            when Suffix_Eon =>
+               Error_Vital_Name ("missing edge or noedge");
+               return;
+            when Suffix_Edge
+              | Suffix_Noedge =>
+               Check_Simple_Condition_And_Or_Edge;
+               return;
+            when Suffix_Num_Name
+              | Suffix_Name =>
+               null;
+         end case;
+      end loop;
+   end Check_Full_Condition_And_Or_Edge;
+
+   procedure Check_End is
+   begin
+      if Get_Next_Suffix_Kind /= Suffix_Eon then
+         Error_Vital_Name ("garbage at end of name");
+      end if;
+   end Check_End;
+
+   --  Return the length of a port P.
+   --  If P is a scalar port, return PORT_LENGTH_SCALAR
+   --  If P is a vector, return the length of the vector (>= 0)
+   --  Otherwise, return PORT_LENGTH_ERROR.
+   Port_Length_Unknown : constant Iir_Int64 := -1;
+   Port_Length_Scalar  : constant Iir_Int64 := -2;
+   Port_Length_Error   : constant Iir_Int64 := -3;
+   function Get_Port_Length (P : Iir) return Iir_Int64
+   is
+      Ptype : Iir;
+      Itype : Iir;
+   begin
+      Ptype := Get_Type (P);
+      if Get_Base_Type (Ptype) = Std_Ulogic_Type then
+         return Port_Length_Scalar;
+      elsif Get_Kind (Ptype) = Iir_Kind_Array_Subtype_Definition
+        and then Get_Base_Type (Ptype) = Std_Logic_Vector_Type
+      then
+         Itype := Get_First_Element (Get_Index_Subtype_List (Ptype));
+         if Get_Type_Staticness (Itype) /= Locally then
+            return Port_Length_Unknown;
+         end if;
+         return Evaluation.Eval_Discrete_Type_Length (Itype);
+      else
+         return Port_Length_Error;
+      end if;
+   end Get_Port_Length;
+
+   --  IEEE 1076.4  9.1  VITAL delay types and subtypes.
+   --  The transition dependent delay types are
+   --  VitalDelayType01, VitalDelayType01Z, VitalDelayType01ZX,
+   --  VitalDelayArrayType01, VitalDelayArrayType01Z, VitalDelayArrayType01ZX.
+   --  The first three are scalar forms, the last three are vector forms.
+   --
+   --  The simple delay types and subtypes include
+   --  Time, VitalDelayType, and VitalDelayArrayType.
+   --  The first two are scalar forms, and the latter is the vector form.
+   type Timing_Generic_Type_Kind is
+     (
+      Timing_Type_Simple_Scalar,
+      Timing_Type_Simple_Vector,
+      Timing_Type_Trans_Scalar,
+      Timing_Type_Trans_Vector,
+      Timing_Type_Bad
+     );
+
+   function Get_Timing_Generic_Type_Kind return Timing_Generic_Type_Kind
+   is
+      Gtype : Iir;
+      Btype : Iir;
+   begin
+      Gtype := Get_Type (Gen_Decl);
+      Btype := Get_Base_Type (Gtype);
+      case Get_Kind (Gtype) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Btype = VitalDelayArrayType then
+               return Timing_Type_Simple_Vector;
+            end if;
+            if Btype = VitalDelayType01
+              or Btype = VitalDelayType01Z
+              or Btype = VitalDelayType01ZX
+            then
+               return Timing_Type_Trans_Scalar;
+            end if;
+            if Btype = VitalDelayArrayType01
+              or Btype = VitalDelayArrayType01Z
+              or Btype = VitalDelayArrayType01ZX
+            then
+               return Timing_Type_Trans_Vector;
+            end if;
+         when Iir_Kind_Physical_Subtype_Definition =>
+            if Gtype = Time_Subtype_Definition
+              or else Gtype = VitalDelayType
+            then
+               return Timing_Type_Simple_Scalar;
+            end if;
+         when others =>
+            null;
+      end case;
+      Error_Vital ("type of timing generic is not a VITAL delay type",
+                   Gen_Decl);
+      return Timing_Type_Bad;
+   end Get_Timing_Generic_Type_Kind;
+
+   function Get_Timing_Generic_Type_Length return Iir_Int64
+   is
+      Itype : Iir;
+   begin
+      Itype := Get_First_Element
+        (Get_Index_Subtype_List (Get_Type (Gen_Decl)));
+      if Get_Type_Staticness (Itype) /= Locally then
+         return Port_Length_Unknown;
+      else
+         return Evaluation.Eval_Discrete_Type_Length (Itype);
+      end if;
+   end Get_Timing_Generic_Type_Length;
+
+   --  IEEE 1076.4  4.3.2.1.2  Timing generic subtypes
+   --  *  If the timing generic is associated with a single port and that port
+   --     is a scalar, then the type of the timing generic shall be a scalar
+   --     form of delay type.
+   --  *  If such a timing generic is associated with a single port and that
+   --     port is a vector, then the type of the timing generic shall be a
+   --     vector form of delay type, and the constraint on the generic shall
+   --     match that on the associated port.
+   procedure Check_Vital_Delay_Type (P : Iir;
+                                     Is_Simple : Boolean := False;
+                                     Is_Scalar : Boolean := False)
+   is
+      Kind : Timing_Generic_Type_Kind;
+      Len : Iir_Int64;
+      Len1 : Iir_Int64;
+   begin
+      Kind := Get_Timing_Generic_Type_Kind;
+      if P = Null_Iir or Kind = Timing_Type_Bad then
+         return;
+      end if;
+      Len := Get_Port_Length (P);
+      if Len = Port_Length_Scalar then
+         case Kind is
+            when Timing_Type_Simple_Scalar =>
+               null;
+            when Timing_Type_Trans_Scalar =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple scalar timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+               return;
+         end case;
+      elsif Len >= Port_Length_Unknown then
+         if Is_Scalar then
+            Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+            return;
+         end if;
+
+         case Kind is
+            when Timing_Type_Simple_Vector =>
+               null;
+            when Timing_Type_Trans_Vector =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple vector timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+               return;
+         end case;
+         Len1 := Get_Timing_Generic_Type_Length;
+         if Len1 /= Len then
+            Error_Vital ("length of port and VITAL vector timing subtype "
+                         & "does not match", Gen_Decl);
+         end if;
+      end if;
+   end Check_Vital_Delay_Type;
+
+   --  IEEE 1076.4  4.3.2.1.2  Timing generic subtypes
+   --  * If the timing generic is associated with two scalar ports, then the
+   --    type of the timing generic shall be a scalar form of delay type.
+   --  * If the timing generic is associated with two ports, one or more of
+   --    which is a vector, then the type of the timing generic shall be a
+   --    vector form of delay type, and the length of the index range of the
+   --    generic shall be equal to the product of the number of scalar
+   --    subelements in the first port and the number of scalar subelements
+   --    in the second port.
+   procedure Check_Vital_Delay_Type
+     (P1, P2 : Iir;
+      Is_Simple : Boolean := False;
+      Is_Scalar : Boolean := False)
+   is
+      Kind : Timing_Generic_Type_Kind;
+      Len1 : Iir_Int64;
+      Len2 : Iir_Int64;
+      Lenp : Iir_Int64;
+   begin
+      Kind := Get_Timing_Generic_Type_Kind;
+      if P1 = Null_Iir or P2 = Null_Iir or Kind = Timing_Type_Bad then
+         return;
+      end if;
+      Len1 := Get_Port_Length (P1);
+      Len2 := Get_Port_Length (P2);
+      if Len1 = Port_Length_Scalar and Len2 = Port_Length_Scalar then
+         case Kind is
+            when Timing_Type_Simple_Scalar =>
+               null;
+            when Timing_Type_Trans_Scalar =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple scalar timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+               return;
+         end case;
+      elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then
+         if Is_Scalar then
+            Error_Vital ("VITAL scalar timing type expected", Gen_Decl);
+            return;
+         end if;
+         case Kind is
+            when Timing_Type_Simple_Vector =>
+               null;
+            when Timing_Type_Trans_Vector =>
+               if Is_Simple then
+                  Error_Vital
+                    ("VITAL simple vector timing type expected", Gen_Decl);
+                  return;
+               end if;
+            when others =>
+               Error_Vital ("VITAL vector timing type expected", Gen_Decl);
+               return;
+         end case;
+         if Len1 = Port_Length_Scalar then
+            Len1 := 1;
+         elsif Len1 = Port_Length_Error then
+            return;
+         end if;
+         if Len2 = Port_Length_Scalar then
+            Len2 := 1;
+         elsif Len2 = Port_Length_Error then
+            return;
+         end if;
+         Lenp := Get_Timing_Generic_Type_Length;
+         if Lenp /= Len1 * Len2 then
+            Error_Vital ("length of port and VITAL vector timing subtype "
+                         & "does not match", Gen_Decl);
+         end if;
+      end if;
+   end Check_Vital_Delay_Type;
+
+   function Check_Timing_Generic_Prefix
+     (Decl : Iir_Interface_Constant_Declaration; Length : Natural)
+     return Boolean
+   is
+      use Name_Table;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  It is an error for a model to use a timing generic prefix to begin
+      --  the simple name of an entity generic that is not a timing generic.
+      if Name_Length < Length or Name_Buffer (Length) /= '_' then
+         Error_Vital ("invalid use of a VITAL timing generic prefix", Decl);
+         return False;
+      end if;
+      Gen_Name_Pos := Length + 1;
+      Gen_Name_Length := Name_Length;
+      Gen_Decl := Decl;
+      return True;
+   end Check_Timing_Generic_Prefix;
+
+   --  IEEE 1076.4 4.3.2.1.3.1 Propagation Delay
+   --  <VITALPropagationDelayName> ::=
+   --     TPD_<InputPort>_<OutputPort>[_<SDFSimpleConditionAndOrEdge>]
+   procedure Check_Propagation_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Oport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 4) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Oport := Check_Output_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Oport);
+   end Check_Propagation_Delay_Name;
+
+   procedure Check_Test_Reference
+   is
+      Tport : Iir;
+      Rport : Iir;
+   begin
+      Tport := Check_Input_Port;
+      Rport := Check_Input_Port;
+      Check_Full_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Tport, Rport, Is_Simple => True);
+   end Check_Test_Reference;
+
+   --  tsetup
+   procedure Check_Input_Setup_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 7) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Setup_Time_Name;
+
+   --  thold
+   procedure Check_Input_Hold_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 6) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Hold_Time_Name;
+
+   --  trecovery
+   procedure Check_Input_Recovery_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 10) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Recovery_Time_Name;
+
+   --  tremoval
+   procedure Check_Input_Removal_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 9) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_Input_Removal_Time_Name;
+
+   --  tperiod
+   procedure Check_Input_Period_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Is_Simple => True);
+   end Check_Input_Period_Name;
+
+   --  tpw
+   procedure Check_Pulse_Width_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 4) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Is_Simple => True);
+   end Check_Pulse_Width_Name;
+
+   --  tskew
+   procedure Check_Input_Skew_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Fport : Iir;
+      Sport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 6) then
+         return;
+      end if;
+      Fport := Check_Port;
+      Sport := Check_Port;
+      Check_Full_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Fport, Sport, Is_Simple => True);
+   end Check_Input_Skew_Time_Name;
+
+   --  tncsetup
+   procedure Check_No_Change_Setup_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 9) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_No_Change_Setup_Time_Name;
+
+   --  tnchold
+   procedure Check_No_Change_Hold_Time_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      Check_Test_Reference;
+   end Check_No_Change_Hold_Time_Name;
+
+   --  tipd
+   procedure Check_Interconnect_Path_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Check_End;
+      Check_Vital_Delay_Type (Iport);
+   end Check_Interconnect_Path_Delay_Name;
+
+   --  tdevice
+   procedure Check_Device_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Oport : Iir;
+      pragma Unreferenced (Oport);
+      Pos : Natural;
+      Kind : Timing_Generic_Type_Kind;
+      pragma Unreferenced (Kind);
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 8) then
+         return;
+      end if;
+      if Get_Next_Suffix_Kind /= Suffix_Name then
+         Error_Vital_Name ("instance_name expected in VITAL generic name");
+         return;
+      end if;
+      Pos := Gen_Name_Pos;
+      if Get_Next_Suffix_Kind /= Suffix_Eon then
+         Gen_Name_Pos := Pos;
+         Oport := Check_Output_Port;
+         Check_End;
+      end if;
+      Kind := Get_Timing_Generic_Type_Kind;
+   end Check_Device_Delay_Name;
+
+   --  tisd
+   procedure Check_Internal_Signal_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Cport : Iir;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Cport := Check_Input_Port;
+      Check_End;
+      Check_Vital_Delay_Type (Iport, Cport,
+                              Is_Simple => True, Is_Scalar => True);
+   end Check_Internal_Signal_Delay_Name;
+
+   --  tbpd
+   procedure Check_Biased_Propagation_Delay_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Iport : Iir;
+      Oport : Iir;
+      Cport : Iir;
+      pragma Unreferenced (Cport);
+      Clock_Start : Natural;
+      Clock_End : Natural;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      Iport := Check_Input_Port;
+      Oport := Check_Output_Port;
+      Clock_Start := Gen_Name_Pos - 1; -- At the '_'.
+      Cport := Check_Input_Port;
+      Clock_End := Gen_Name_Pos;
+      Check_Simple_Condition_And_Or_Edge;
+      Check_Vital_Delay_Type (Iport, Oport);
+
+      --  IEEE 1076.4  4.3.2.1.3.14  Biased propagation delay
+      --  There shall exist, in the same entity generic clause, a corresponding
+      --  propagation delay generic denoting the same ports, condition name,
+      --  and edge.
+      declare
+         use Name_Table;
+
+         --  '-1' is for the missing 'b' in 'tpd'.
+         Tpd_Name : String
+           (1 .. Gen_Name_Length - 1 - (Clock_End - Clock_Start));
+         Tpd_Decl : Iir;
+      begin
+         Image (Get_Identifier (Decl));
+         Tpd_Name (1) := 't';
+         --  The part before '_<ClockPort>'.
+         Tpd_Name (2 .. Clock_Start - 2) := Name_Buffer (3 .. Clock_Start - 1);
+         Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) :=
+           Name_Buffer (Clock_End .. Name_Length);
+
+         Tpd_Decl := Gen_Chain;
+         loop
+            exit when Tpd_Decl = Null_Iir;
+            Image (Get_Identifier (Tpd_Decl));
+            exit when Name_Length = Tpd_Name'Length
+              and then Name_Buffer (1 .. Name_Length) = Tpd_Name;
+            Tpd_Decl := Get_Chain (Tpd_Decl);
+         end loop;
+
+         if Tpd_Decl = Null_Iir then
+            Error_Vital
+              ("no matching 'tpd' generic for VITAL 'tbpd' timing generic",
+               Decl);
+         else
+            --  IEEE 1076.4  4.3.2.1.3.14  Biased propagation delay
+            --  Furthermore, the type of the biased propagation generic shall
+            --  be the same as the type of the corresponding delay generic.
+            if not Sem.Are_Trees_Equal (Get_Type (Decl), Get_Type (Tpd_Decl))
+            then
+               Error_Vital
+                 ("type of VITAL 'tbpd' generic mismatch type of "
+                  & "'tpd' generic", Decl);
+               Error_Vital
+                 ("(corresponding 'tpd' timing generic)", Tpd_Decl);
+            end if;
+         end if;
+      end;
+   end Check_Biased_Propagation_Delay_Name;
+
+   --  ticd
+   procedure Check_Internal_Clock_Delay_Generic_Name
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      Cport : Iir;
+      P_Start : Natural;
+      P_End : Natural;
+   begin
+      if not Check_Timing_Generic_Prefix (Decl, 5) then
+         return;
+      end if;
+      P_Start := Gen_Name_Pos;
+      Cport := Check_Input_Port;
+      P_End := Gen_Name_Pos;
+      Check_End;
+      Check_Vital_Delay_Type (Cport, Is_Simple => True, Is_Scalar => True);
+
+      --  IEEE 1076.4  4.3.2.1.3.15  Internal clock delay
+      --  It is an error for a clocks signal name to appear as one of the
+      --  following elements in the name of a timing generic:
+      --  * As either the input port in the name of a biased propagation
+      --    delay generic.
+      --  * As the input signal name in an internal delay timing generic.
+      --  * As the test port in a timing check or recovery removal timing
+      --    generic.
+      --  FIXME: recovery OR removal ?
+
+      if P_End - 1 /= Gen_Name_Length then
+         --  Do not check in case of error.
+         return;
+      end if;
+      declare
+         use Name_Table;
+         Port : String (1 .. Name_Length);
+         El : Iir;
+         Offset : Natural;
+
+         procedure Check_Not_Clock
+         is
+            S : Natural;
+         begin
+            S := Offset;
+            loop
+               Offset := Offset + 1;
+               exit when Offset > Name_Length
+                 or else Name_Buffer (Offset) = '_';
+            end loop;
+            if Offset - S = Port'Length
+              and then Name_Buffer (S .. Offset - 1) = Port
+            then
+               Error_Vital ("clock port name of 'ticd' VITAL generic must not"
+                            & " appear here", El);
+            end if;
+         end Check_Not_Clock;
+      begin
+         Port := Name_Buffer (P_Start .. Gen_Name_Length);
+
+         El := Gen_Chain;
+         while El /= Null_Iir loop
+            Image (Get_Identifier (El));
+            if Name_Length > 5
+              and then Name_Buffer (1) = 't'
+            then
+               if Name_Buffer (2 .. 5) = "bpd_" then
+                  Offset := 6;
+                  Check_Not_Clock; -- input
+                  Check_Not_Clock; -- output
+               elsif Name_Buffer (2 .. 5) = "isd_" then
+                  Offset := 6;
+                  Check_Not_Clock; -- input
+               elsif Name_Length > 10
+                 and then Name_Buffer (2 .. 10) = "recovery_"
+               then
+                  Offset := 11;
+                  Check_Not_Clock; -- test port
+               elsif Name_Length > 9
+                 and then Name_Buffer (2 .. 9) = "removal_"
+               then
+                  Offset := 10;
+                  Check_Not_Clock;
+               end if;
+            end if;
+            El := Get_Chain (El);
+         end loop;
+      end;
+   end Check_Internal_Clock_Delay_Generic_Name;
+
+   procedure Check_Entity_Generic_Declaration
+     (Decl : Iir_Interface_Constant_Declaration)
+   is
+      use Name_Table;
+      Id : Name_Id;
+   begin
+      Id := Get_Identifier (Decl);
+      Image (Id);
+
+      --  Extract prefix.
+      if Name_Buffer (1) = 't' and Name_Length >= 3 then
+         --  Timing generic names.
+         if Name_Buffer (2) = 'p' then
+            if Name_Buffer (3) = 'd' then
+               Check_Propagation_Delay_Name (Decl); --  tpd
+               return;
+            elsif Name_Buffer (3) = 'w' then
+               Check_Pulse_Width_Name (Decl); -- tpw
+               return;
+            elsif Name_Length >= 7
+              and then Name_Buffer (3 .. 7) = "eriod"
+            then
+               Check_Input_Period_Name (Decl); --  tperiod
+               return;
+            end if;
+         elsif Name_Buffer (2) = 'i'
+           and then Name_Length >= 4
+           and then Name_Buffer (4) = 'd'
+         then
+            if Name_Buffer (3) = 'p' then
+               Check_Interconnect_Path_Delay_Name (Decl); --  tipd
+               return;
+            elsif Name_Buffer (3) = 's' then
+               Check_Internal_Signal_Delay_Name (Decl); --  tisd
+               return;
+            elsif Name_Buffer (3) = 'c' then
+               Check_Internal_Clock_Delay_Generic_Name (Decl); --  ticd
+               return;
+            end if;
+         elsif Name_Length >= 6 and then Name_Buffer (2 .. 6) = "setup" then
+            Check_Input_Setup_Time_Name (Decl); --  tsetup
+            return;
+         elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "hold" then
+            Check_Input_Hold_Time_Name (Decl); -- thold
+            return;
+         elsif Name_Length >= 9 and then Name_Buffer (2 .. 9) = "recovery" then
+            Check_Input_Recovery_Time_Name (Decl); -- trecovery
+            return;
+         elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "removal" then
+            Check_Input_Removal_Time_Name (Decl); -- tremoval
+            return;
+         elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "skew" then
+            Check_Input_Skew_Time_Name (Decl); -- tskew
+            return;
+         elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "ncsetup" then
+            Check_No_Change_Setup_Time_Name (Decl); -- tncsetup
+            return;
+         elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "nchold" then
+            Check_No_Change_Hold_Time_Name (Decl); -- tnchold
+            return;
+         elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "device" then
+            Check_Device_Delay_Name (Decl); -- tdevice
+            return;
+         elsif Name_Length >= 4 and then Name_Buffer (2 .. 4) = "bpd" then
+            Check_Biased_Propagation_Delay_Name (Decl); -- tbpd
+            return;
+         end if;
+      end if;
+
+      if Id = InstancePath_Id then
+         if Get_Type (Decl) /= String_Type_Definition then
+            Error_Vital
+              ("InstancePath VITAL generic must be of type String", Decl);
+         end if;
+         return;
+      elsif Id = TimingChecksOn_Id
+        or Id = XOn_Id
+        or Id = MsgOn_Id
+      then
+         if Get_Type (Decl) /= Boolean_Type_Definition then
+            Error_Vital
+              (Image (Id) & " VITAL generic must be of type Boolean", Decl);
+         end if;
+         return;
+      end if;
+
+      if Flags.Warn_Vital_Generic then
+         Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl);
+      end if;
+   end Check_Entity_Generic_Declaration;
+
+   --  Checks rules for a VITAL level 0 entity.
+   procedure Check_Vital_Level0_Entity (Ent : Iir_Entity_Declaration)
+   is
+      use Sem_Scopes;
+      Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.3.1
+      --  The only form of declaration allowed in the entity declarative part
+      --  is the specification of the VITAL_Level0 attribute.
+      Decl := Get_Declaration_Chain (Ent);
+      if Decl = Null_Iir then
+         --  Cannot happen, since there is at least the attribute spec.
+         raise Internal_Error;
+      end if;
+      Check_Level0_Attribute_Specification (Decl);
+      Decl := Get_Chain (Decl);
+      if Decl /= Null_Iir then
+         Error_Vital ("VITAL entity declarative part must only contain the "
+                      & "attribute specification", Decl);
+      end if;
+
+      --  IEEE 1076.4 4.3.1
+      --  No statements are allowed in the entity statement part.
+      Decl := Get_Concurrent_Statement_Chain (Ent);
+      if Decl /= Null_Iir then
+         Error_Vital ("VITAL entity must not have concurrent statement", Decl);
+      end if;
+
+      --  Check ports.
+      Name_Table.Assert_No_Infos;
+      Open_Declarative_Region;
+      Decl := Get_Port_Chain (Ent);
+      while Decl /= Null_Iir loop
+         Check_Entity_Port_Declaration (Decl);
+         Add_Name (Decl);
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      --  Check generics.
+      Gen_Chain := Get_Generic_Chain (Ent);
+      Decl := Gen_Chain;
+      while Decl /= Null_Iir loop
+         Check_Entity_Generic_Declaration (Decl);
+         Decl := Get_Chain (Decl);
+      end loop;
+      Close_Declarative_Region;
+   end Check_Vital_Level0_Entity;
+
+   --  Return TRUE if UNIT was decorated with attribute VITAL_Level0.
+   function Is_Vital_Level0 (Unit : Iir_Entity_Declaration) return Boolean
+   is
+      Value : Iir_Attribute_Value;
+      Spec : Iir_Attribute_Specification;
+   begin
+      Value := Get_Attribute_Value_Chain (Unit);
+      while Value /= Null_Iir loop
+         Spec := Get_Attribute_Specification (Value);
+         if Get_Named_Entity (Get_Attribute_Designator (Spec))
+           = Vital_Level0_Attribute
+         then
+            return True;
+         end if;
+         Value := Get_Chain (Value);
+      end loop;
+
+      return False;
+   end Is_Vital_Level0;
+
+   procedure Check_Vital_Level0_Architecture (Arch : Iir_Architecture_Body)
+   is
+      Decl : Iir;
+   begin
+      --  IEEE 1076.4 4.1
+      --  The entity associated with a Level 0 architecture shall be a VITAL
+      --  Level 0 entity.
+      if not Is_Vital_Level0 (Iirs_Utils.Get_Entity (Arch)) then
+         Error_Vital ("entity associated with a VITAL level 0 architecture "
+                      & "shall be a VITAL level 0 entity", Arch);
+      end if;
+
+      --  VITAL_Level_0_architecture_declarative_part ::=
+      --    VITAL_Level0_attribute_specification { block_declarative_item }
+      Decl := Get_Declaration_Chain (Arch);
+      Check_Level0_Attribute_Specification (Decl);
+   end Check_Vital_Level0_Architecture;
+
+   --  Check a VITAL level 0 decorated design unit.
+   procedure Check_Vital_Level0 (Unit : Iir_Design_Unit)
+   is
+      Lib_Unit : Iir;
+   begin
+      Lib_Unit := Get_Library_Unit (Unit);
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            Check_Vital_Level0_Entity (Lib_Unit);
+         when Iir_Kind_Architecture_Body =>
+            Check_Vital_Level0_Architecture (Lib_Unit);
+         when others =>
+            Error_Vital
+              ("only entity or architecture can be VITAL_Level0", Lib_Unit);
+      end case;
+   end Check_Vital_Level0;
+
+   procedure Check_Vital_Level1 (Unit : Iir_Design_Unit)
+   is
+      Arch : Iir;
+   begin
+      Arch := Get_Library_Unit (Unit);
+      if Get_Kind (Arch) /= Iir_Kind_Architecture_Body then
+         Error_Vital ("only architecture can be VITAL_Level1", Arch);
+         return;
+      end if;
+      --  FIXME: todo
+   end Check_Vital_Level1;
+
+end Ieee.Vital_Timing;
diff --git a/src/ieee-vital_timing.ads b/src/ieee-vital_timing.ads
new file mode 100644
index 000000000..7abda2eba
--- /dev/null
+++ b/src/ieee-vital_timing.ads
@@ -0,0 +1,41 @@
+--  Nodes recognizer for ieee.vital_timing.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Ieee.Vital_Timing is
+   --  Attribute declarations.
+   Vital_Level0_Attribute : Iir_Attribute_Declaration := Null_Iir;
+   Vital_Level1_Attribute : Iir_Attribute_Declaration := Null_Iir;
+
+   --  Vital delay types.
+   VitalDelayType : Iir := Null_Iir;
+   VitalDelayType01   : Iir_Array_Type_Definition := Null_Iir;
+   VitalDelayType01Z  : Iir_Array_Type_Definition := Null_Iir;
+   VitalDelayType01ZX : Iir_Array_Type_Definition := Null_Iir;
+
+   VitalDelayArrayType     : Iir_Array_Type_Definition := Null_Iir;
+   VitalDelayArrayType01   : Iir_Array_Type_Definition := Null_Iir;
+   VitalDelayArrayType01Z  : Iir_Array_Type_Definition := Null_Iir;
+   VitalDelayArrayType01ZX : Iir_Array_Type_Definition := Null_Iir;
+
+   --  Extract declarations from IEEE.VITAL_Timing package.
+   procedure Extract_Declarations (Pkg : Iir_Package_Declaration);
+
+   procedure Check_Vital_Level0 (Unit : Iir_Design_Unit);
+   procedure Check_Vital_Level1 (Unit : Iir_Design_Unit);
+end Ieee.Vital_Timing;
diff --git a/src/ieee.ads b/src/ieee.ads
new file mode 100644
index 000000000..48ab37630
--- /dev/null
+++ b/src/ieee.ads
@@ -0,0 +1,5 @@
+--  Top of ieee hierarchy.
+--  Too small to be copyrighted.
+package Ieee is
+   pragma Pure (Ieee);
+end Ieee;
diff --git a/src/iir_chain_handling.adb b/src/iir_chain_handling.adb
new file mode 100644
index 000000000..1e70a366a
--- /dev/null
+++ b/src/iir_chain_handling.adb
@@ -0,0 +1,68 @@
+--  Generic package to handle chains.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Iir_Chain_Handling is
+   procedure Build_Init (Last : out Iir) is
+   begin
+      Last := Null_Iir;
+   end Build_Init;
+
+   procedure Build_Init (Last : out Iir; Parent : Iir)
+   is
+      El : Iir;
+   begin
+      El := Get_Chain_Start (Parent);
+      if El /= Null_Iir then
+         loop
+            Last := El;
+            El := Get_Chain (El);
+            exit when El = Null_Iir;
+         end loop;
+      else
+         Last := Null_Iir;
+      end if;
+   end Build_Init;
+
+   procedure Append (Last : in out Iir; Parent : Iir; El : Iir) is
+   begin
+      if Last = Null_Iir then
+         Set_Chain_Start (Parent, El);
+      else
+         Set_Chain (Last, El);
+      end if;
+      Last := El;
+   end Append;
+
+   procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir)
+   is
+      El : Iir;
+   begin
+      if Last = Null_Iir then
+         Set_Chain_Start (Parent, Els);
+      else
+         Set_Chain (Last, Els);
+      end if;
+      El := Els;
+      loop
+         Set_Parent (El, Parent);
+         Last := El;
+         El := Get_Chain (El);
+         exit when El = Null_Iir;
+      end loop;
+   end Append_Subchain;
+end Iir_Chain_Handling;
+
diff --git a/src/iir_chain_handling.ads b/src/iir_chain_handling.ads
new file mode 100644
index 000000000..3865e9b65
--- /dev/null
+++ b/src/iir_chain_handling.ads
@@ -0,0 +1,47 @@
+--  Generic package to handle chains.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+--  The generic package Chain_Handling can be used to build or modify
+--  chains.
+--  The formals are the subprograms to get and set the first element
+--   from the parent.
+generic
+   with function Get_Chain_Start (Parent : Iir) return Iir;
+   with procedure Set_Chain_Start (Parent : Iir; First : Iir);
+package Iir_Chain_Handling is
+
+   --  Building a chain:
+   --  Initialize (set LAST to NULL_IIR).
+   procedure Build_Init (Last : out Iir);
+   --  Set LAST with the last element of the chain.
+   --  This is an initialization for an already built chain.
+   procedure Build_Init (Last : out Iir; Parent : Iir);
+
+   --  Append element EL to the chain, whose parent is PARENT and last
+   --   element LAST.
+   procedure Append (Last : in out Iir; Parent : Iir; El : Iir);
+
+   --  Append a subchain whose first element is ELS to a chain, whose
+   --   parent is PARENT and last element LAST.
+   --   The Parent field of each elements of Els is set to PARENT.
+   --  Note: the Append procedure declared just above is an optimization
+   --   of this subprogram if ELS has no next element.  However, the
+   --   above subprogram does not set the Parent field of EL.
+   procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir);
+end Iir_Chain_Handling;
diff --git a/src/iir_chains.adb b/src/iir_chains.adb
new file mode 100644
index 000000000..ef47b6485
--- /dev/null
+++ b/src/iir_chains.adb
@@ -0,0 +1,64 @@
+--  Chain handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Iir_Chains is
+   function Get_Chain_Length (First : Iir) return Natural
+   is
+      Res : Natural := 0;
+      El : Iir := First;
+   begin
+      while El /= Null_Iir loop
+         Res := Res + 1;
+         El := Get_Chain (El);
+      end loop;
+      return Res;
+   end Get_Chain_Length;
+
+   procedure Sub_Chain_Init (First, Last : out Iir) is
+   begin
+      First := Null_Iir;
+      Last := Null_Iir;
+   end Sub_Chain_Init;
+
+   procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir) is
+   begin
+      if First = Null_Iir then
+         First := El;
+      else
+         Set_Chain (Last, El);
+      end if;
+      Last := El;
+   end Sub_Chain_Append;
+
+   function Is_Chain_Length_One (Chain : Iir) return Boolean is
+   begin
+      return Chain /= Null_Iir and then Get_Chain (Chain) = Null_Iir;
+   end Is_Chain_Length_One;
+
+   procedure Insert (Last : Iir; El : Iir) is
+   begin
+      Set_Chain (El, Get_Chain (Last));
+      Set_Chain (Last, El);
+   end Insert;
+
+   procedure Insert_Incr (Last : in out Iir; El : Iir) is
+   begin
+      Set_Chain (El, Get_Chain (Last));
+      Set_Chain (Last, El);
+      Last := El;
+   end Insert_Incr;
+end Iir_Chains;
diff --git a/src/iir_chains.ads b/src/iir_chains.ads
new file mode 100644
index 000000000..dc2f3894c
--- /dev/null
+++ b/src/iir_chains.ads
@@ -0,0 +1,113 @@
+--  Chain handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+with Iir_Chain_Handling;
+pragma Elaborate_All (Iir_Chain_Handling);
+
+package Iir_Chains is
+   --  Chains are simply linked list of iirs.
+   --  Elements of the chain are ordered.
+   --  Each element of a chain have a Chain field, which points to the next
+   --  element.
+   --  All elements of a chain have the same parent.  This parent contains
+   --  a field which points to the first element of the chain.
+   --  Note: the parent is often the value of the Parent field, but sometimes
+   --    not.
+
+   --  Chains can be covered very simply:
+   --      El : Iir;
+   --   begin
+   --      El := Get_xxx_Chain (Parent);
+   --      while El /= Null_Iir loop
+   --         * Handle element EL of the chain.
+   --         El := Get_Chain (El);
+   --      end loop;
+
+   --  However, building a chain is a little bit more difficult if elements
+   --  have to be appended.  Indeed, there is no direct access to the last
+   --  element of a chain.
+   --  An efficient way to build a chain is to keep the last element of it.
+   --  See Iir_Chain_Handling package.
+
+   package Declaration_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Declaration_Chain,
+      Set_Chain_Start => Set_Declaration_Chain);
+
+   package Interface_Declaration_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Interface_Declaration_Chain,
+      Set_Chain_Start => Set_Interface_Declaration_Chain);
+
+   package Context_Items_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Context_Items,
+      Set_Chain_Start => Set_Context_Items);
+
+   package Unit_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Unit_Chain,
+      Set_Chain_Start => Set_Unit_Chain);
+
+   package Configuration_Item_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Configuration_Item_Chain,
+      Set_Chain_Start => Set_Configuration_Item_Chain);
+
+   package Entity_Class_Entry_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Entity_Class_Entry_Chain,
+      Set_Chain_Start => Set_Entity_Class_Entry_Chain);
+
+   package Conditional_Waveform_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Conditional_Waveform_Chain,
+      Set_Chain_Start => Set_Conditional_Waveform_Chain);
+
+   package Selected_Waveform_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Selected_Waveform_Chain,
+      Set_Chain_Start => Set_Selected_Waveform_Chain);
+
+   package Association_Choices_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Association_Choices_Chain,
+      Set_Chain_Start => Set_Association_Choices_Chain);
+
+   package Case_Statement_Alternative_Chain_Handling is new Iir_Chain_Handling
+     (Get_Chain_Start => Get_Case_Statement_Alternative_Chain,
+      Set_Chain_Start => Set_Case_Statement_Alternative_Chain);
+
+   --  Return the number of elements in a chain starting with FIRST.
+   --  Not very efficient since O(N).
+   function Get_Chain_Length (First : Iir) return Natural;
+
+   --  These two subprograms can be used to build a sub-chain.
+   --  FIRST and LAST designates respectively the first and last element of
+   --  the sub-chain.
+
+   --  Set FIRST and LAST to Null_Iir.
+   procedure Sub_Chain_Init (First, Last : out Iir);
+   pragma Inline (Sub_Chain_Init);
+
+   --  Append element EL to the sub-chain.
+   procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir);
+   pragma Inline (Sub_Chain_Append);
+
+   --  Return TRUE iff CHAIN is of length one, ie CHAIN is not NULL_IIR
+   --  and chain (CHAIN) is NULL_IIR.
+   function Is_Chain_Length_One (Chain : Iir) return Boolean;
+   pragma Inline (Is_Chain_Length_One);
+
+   --  Insert EL after LAST.
+   procedure Insert (Last : Iir; El : Iir);
+
+   --  Insert EL after LAST and set LAST to EL.
+   procedure Insert_Incr (Last : in out Iir; El : Iir);
+end Iir_Chains;
diff --git a/src/iirs.adb b/src/iirs.adb
new file mode 100644
index 000000000..876d1464f
--- /dev/null
+++ b/src/iirs.adb
@@ -0,0 +1,4515 @@
+--  Tree node definitions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO;
+with Nodes; use Nodes;
+with Lists; use Lists;
+with Nodes_Meta; use Nodes_Meta;
+
+package body Iirs is
+   function Is_Null (Node : Iir) return Boolean is
+   begin
+      return Node = Null_Iir;
+   end Is_Null;
+
+   function Is_Null_List (Node : Iir_List) return Boolean is
+   begin
+      return Node = Null_Iir_List;
+   end Is_Null_List;
+
+   ---------------------------------------------------
+   -- General subprograms that operate on every iir --
+   ---------------------------------------------------
+
+   function Get_Format (Kind : Iir_Kind) return Format_Type;
+
+   function Create_Iir (Kind : Iir_Kind) return Iir
+   is
+      Res : Iir;
+      Format : Format_Type;
+   begin
+      Format := Get_Format (Kind);
+      Res := Create_Node (Format);
+      Set_Nkind (Res, Iir_Kind'Pos (Kind));
+      return Res;
+   end Create_Iir;
+
+   --  Statistics.
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+      type Num_Array is array (Iir_Kind) of Natural;
+      Num : Num_Array := (others => 0);
+      type Format_Array is array (Format_Type) of Natural;
+      Formats : Format_Array := (others => 0);
+      Kind : Iir_Kind;
+      I : Iir;
+      Last_I : Iir;
+      Format : Format_Type;
+   begin
+      I := Error_Node + 1;
+      Last_I := Get_Last_Node;
+      while I < Last_I loop
+         Kind := Get_Kind (I);
+         Num (Kind) := Num (Kind) + 1;
+         Format := Get_Format (Kind);
+         Formats (Format) := Formats (Format) + 1;
+         case Format is
+            when Format_Medium =>
+               I := I + 2;
+            when Format_Short
+              | Format_Fp
+              | Format_Int =>
+               I := I + 1;
+         end case;
+      end loop;
+
+      Put_Line ("Stats per iir_kind:");
+      for J in Iir_Kind loop
+         if Num (J) /= 0 then
+            Put_Line (' ' & Iir_Kind'Image (J) & ':'
+                      & Natural'Image (Num (J)));
+         end if;
+      end loop;
+      Put_Line ("Stats per formats:");
+      for J in Format_Type loop
+         Put_Line (' ' & Format_Type'Image (J) & ':'
+                   & Natural'Image (Formats (J)));
+      end loop;
+   end Disp_Stats;
+
+   function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions)
+     return Boolean is
+   begin
+      case Func is
+         when Iir_Predefined_Bit_And
+           | Iir_Predefined_Bit_Or
+           | Iir_Predefined_Bit_Nand
+           | Iir_Predefined_Bit_Nor
+           | Iir_Predefined_Boolean_And
+           | Iir_Predefined_Boolean_Or
+           | Iir_Predefined_Boolean_Nand
+           | Iir_Predefined_Boolean_Nor =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Iir_Predefined_Shortcut_P;
+
+   function Create_Iir_Error return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Node (Format_Short);
+      Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error));
+      Set_Base_Type (Res, Res);
+      return Res;
+   end Create_Iir_Error;
+
+   procedure Location_Copy (Target: Iir; Src: Iir) is
+   begin
+      Set_Location (Target, Get_Location (Src));
+   end Location_Copy;
+
+   -- Get kind
+   function Get_Kind (An_Iir: Iir) return Iir_Kind
+   is
+      --  Speed up: avoid to check that nkind is in the bounds of Iir_Kind.
+      pragma Suppress (Range_Check);
+   begin
+      return Iir_Kind'Val (Get_Nkind (An_Iir));
+   end Get_Kind;
+
+   function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Time_Stamp_Id, Target => Iir);
+
+   function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Time_Stamp_Id);
+
+   function Iir_To_Iir_List is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Iir_List);
+   function Iir_List_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Iir_List, Target => Iir);
+
+   function Iir_To_Token_Type (N : Iir) return Token_Type is
+   begin
+      return Token_Type'Val (N);
+   end Iir_To_Token_Type;
+
+   function Token_Type_To_Iir (T : Token_Type) return Iir is
+   begin
+      return Token_Type'Pos (T);
+   end Token_Type_To_Iir;
+
+--     function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is
+--     begin
+--        return Iir_Index32 (N);
+--     end Iir_To_Iir_Index32;
+
+--     function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is
+--     begin
+--        return Iir_Index32'Pos (V);
+--     end Iir_Index32_To_Iir;
+
+   function Iir_To_Name_Id (N : Iir) return Name_Id is
+   begin
+      return Iir'Pos (N);
+   end Iir_To_Name_Id;
+   pragma Inline (Iir_To_Name_Id);
+
+   function Name_Id_To_Iir (V : Name_Id) return Iir is
+   begin
+      return Name_Id'Pos (V);
+   end Name_Id_To_Iir;
+
+   function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Iir_Int32);
+
+   function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Iir_Int32, Target => Iir);
+
+   function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is
+   begin
+      return Source_Ptr (N);
+   end Iir_To_Source_Ptr;
+
+   function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is
+   begin
+      return Iir (P);
+   end Source_Ptr_To_Iir;
+
+   function Iir_To_Location_Type (N : Iir) return Location_Type is
+   begin
+      return Location_Type (N);
+   end Iir_To_Location_Type;
+
+   function Location_Type_To_Iir (L : Location_Type) return Iir is
+   begin
+      return Iir (L);
+   end Location_Type_To_Iir;
+
+   function Iir_To_String_Id is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => String_Id);
+   function String_Id_To_Iir is new Ada.Unchecked_Conversion
+     (Source => String_Id, Target => Iir);
+
+   function Iir_To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Int32);
+   function Int32_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Iir);
+
+   function Iir_To_PSL_Node is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => PSL_Node);
+
+   function PSL_Node_To_Iir is new Ada.Unchecked_Conversion
+     (Source => PSL_Node, Target => Iir);
+
+   function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => PSL_NFA);
+
+   function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion
+     (Source => PSL_NFA, Target => Iir);
+
+   --  Subprograms
+   function Get_Format (Kind : Iir_Kind) return Format_Type is
+   begin
+      case Kind is
+         when Iir_Kind_Unused
+           | Iir_Kind_Error
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Use_Clause
+           | Iir_Kind_Null_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Waveform_Element
+           | Iir_Kind_Conditional_Waveform
+           | Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package
+           | Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name
+           | Iir_Kind_Entity_Aspect_Entity
+           | Iir_Kind_Entity_Aspect_Configuration
+           | Iir_Kind_Entity_Aspect_Open
+           | Iir_Kind_Block_Configuration
+           | Iir_Kind_Component_Configuration
+           | Iir_Kind_Entity_Class
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Aggregate_Info
+           | Iir_Kind_Procedure_Call
+           | Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Array_Element_Resolution
+           | Iir_Kind_Record_Resolution
+           | Iir_Kind_Record_Element_Resolution
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Configuration_Specification
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Overload_List
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator
+           | Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Aggregate
+           | Iir_Kind_Parenthesis_Expression
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Psl_Expression
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Base_Attribute
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Behavior_Attribute
+           | Iir_Kind_Structure_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return Format_Short;
+         when Iir_Kind_Design_File
+           | Iir_Kind_Design_Unit
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Block_Header
+           | Iir_Kind_Binding_Indication
+           | Iir_Kind_Signature
+           | Iir_Kind_Attribute_Specification
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Subtype_Definition
+           | Iir_Kind_Scalar_Nature_Definition
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Package_Header
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return Format_Medium;
+         when Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            return Format_Fp;
+         when Iir_Kind_Integer_Literal
+           | Iir_Kind_Physical_Int_Literal =>
+            return Format_Int;
+      end case;
+   end Get_Format;
+
+   function Get_First_Design_Unit (Design : Iir) return Iir is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_First_Design_Unit (Get_Kind (Design)));
+      return Get_Field5 (Design);
+   end Get_First_Design_Unit;
+
+   procedure Set_First_Design_Unit (Design : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_First_Design_Unit (Get_Kind (Design)));
+      Set_Field5 (Design, Chain);
+   end Set_First_Design_Unit;
+
+   function Get_Last_Design_Unit (Design : Iir) return Iir is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Last_Design_Unit (Get_Kind (Design)));
+      return Get_Field6 (Design);
+   end Get_Last_Design_Unit;
+
+   procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Last_Design_Unit (Get_Kind (Design)));
+      Set_Field6 (Design, Chain);
+   end Set_Last_Design_Unit;
+
+   function Get_Library_Declaration (Design : Iir) return Iir is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Library_Declaration (Get_Kind (Design)));
+      return Get_Field1 (Design);
+   end Get_Library_Declaration;
+
+   procedure Set_Library_Declaration (Design : Iir; Library : Iir) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Library_Declaration (Get_Kind (Design)));
+      Set_Field1 (Design, Library);
+   end Set_Library_Declaration;
+
+   function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_File_Time_Stamp (Get_Kind (Design)));
+      return Iir_To_Time_Stamp_Id (Get_Field4 (Design));
+   end Get_File_Time_Stamp;
+
+   procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_File_Time_Stamp (Get_Kind (Design)));
+      Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp));
+   end Set_File_Time_Stamp;
+
+   function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design)));
+      return Iir_To_Time_Stamp_Id (Get_Field3 (Design));
+   end Get_Analysis_Time_Stamp;
+
+   procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design)));
+      Set_Field3 (Design, Time_Stamp_Id_To_Iir (Stamp));
+   end Set_Analysis_Time_Stamp;
+
+   function Get_Library (File : Iir_Design_File) return Iir is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Library (Get_Kind (File)));
+      return Get_Field0 (File);
+   end Get_Library;
+
+   procedure Set_Library (File : Iir_Design_File; Lib : Iir) is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Library (Get_Kind (File)));
+      Set_Field0 (File, Lib);
+   end Set_Library;
+
+   function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_File_Dependence_List (Get_Kind (File)));
+      return Iir_To_Iir_List (Get_Field1 (File));
+   end Get_File_Dependence_List;
+
+   procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List)
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_File_Dependence_List (Get_Kind (File)));
+      Set_Field1 (File, Iir_List_To_Iir (Lst));
+   end Set_File_Dependence_List;
+
+   function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Design_File_Filename (Get_Kind (File)));
+      return Name_Id'Val (Get_Field12 (File));
+   end Get_Design_File_Filename;
+
+   procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id)
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Design_File_Filename (Get_Kind (File)));
+      Set_Field12 (File, Name_Id'Pos (Name));
+   end Set_Design_File_Filename;
+
+   function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Design_File_Directory (Get_Kind (File)));
+      return Name_Id'Val (Get_Field11 (File));
+   end Get_Design_File_Directory;
+
+   procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id)
+   is
+   begin
+      pragma Assert (File /= Null_Iir);
+      pragma Assert (Has_Design_File_Directory (Get_Kind (File)));
+      Set_Field11 (File, Name_Id'Pos (Dir));
+   end Set_Design_File_Directory;
+
+   function Get_Design_File (Unit : Iir_Design_Unit) return Iir is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Design_File (Get_Kind (Unit)));
+      return Get_Field0 (Unit);
+   end Get_Design_File;
+
+   procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir) is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Design_File (Get_Kind (Unit)));
+      Set_Field0 (Unit, File);
+   end Set_Design_File;
+
+   function Get_Design_File_Chain (Library : Iir) return Iir is
+   begin
+      pragma Assert (Library /= Null_Iir);
+      pragma Assert (Has_Design_File_Chain (Get_Kind (Library)));
+      return Get_Field1 (Library);
+   end Get_Design_File_Chain;
+
+   procedure Set_Design_File_Chain (Library : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Library /= Null_Iir);
+      pragma Assert (Has_Design_File_Chain (Get_Kind (Library)));
+      Set_Field1 (Library, Chain);
+   end Set_Design_File_Chain;
+
+   function Get_Library_Directory (Library : Iir) return Name_Id is
+   begin
+      pragma Assert (Library /= Null_Iir);
+      pragma Assert (Has_Library_Directory (Get_Kind (Library)));
+      return Name_Id'Val (Get_Field11 (Library));
+   end Get_Library_Directory;
+
+   procedure Set_Library_Directory (Library : Iir; Dir : Name_Id) is
+   begin
+      pragma Assert (Library /= Null_Iir);
+      pragma Assert (Has_Library_Directory (Get_Kind (Library)));
+      Set_Field11 (Library, Name_Id'Pos (Dir));
+   end Set_Library_Directory;
+
+   function Get_Date (Target : Iir) return Date_Type is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Date (Get_Kind (Target)));
+      return Date_Type'Val (Get_Field10 (Target));
+   end Get_Date;
+
+   procedure Set_Date (Target : Iir; Date : Date_Type) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Date (Get_Kind (Target)));
+      Set_Field10 (Target, Date_Type'Pos (Date));
+   end Set_Date;
+
+   function Get_Context_Items (Design_Unit : Iir) return Iir is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Context_Items (Get_Kind (Design_Unit)));
+      return Get_Field1 (Design_Unit);
+   end Get_Context_Items;
+
+   procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir) is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Context_Items (Get_Kind (Design_Unit)));
+      Set_Field1 (Design_Unit, Items_Chain);
+   end Set_Context_Items;
+
+   function Get_Dependence_List (Unit : Iir) return Iir_List is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Dependence_List (Get_Kind (Unit)));
+      return Iir_To_Iir_List (Get_Field8 (Unit));
+   end Get_Dependence_List;
+
+   procedure Set_Dependence_List (Unit : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Dependence_List (Get_Kind (Unit)));
+      Set_Field8 (Unit, Iir_List_To_Iir (List));
+   end Set_Dependence_List;
+
+   function Get_Analysis_Checks_List (Unit : Iir) return Iir_List is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit)));
+      return Iir_To_Iir_List (Get_Field9 (Unit));
+   end Get_Analysis_Checks_List;
+
+   procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit)));
+      Set_Field9 (Unit, Iir_List_To_Iir (List));
+   end Set_Analysis_Checks_List;
+
+   function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Date_State (Get_Kind (Unit)));
+      return Date_State_Type'Val (Get_State1 (Unit));
+   end Get_Date_State;
+
+   procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type)
+   is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Date_State (Get_Kind (Unit)));
+      Set_State1 (Unit, Date_State_Type'Pos (State));
+   end Set_Date_State;
+
+   function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type is
+   begin
+      pragma Assert (Stmt /= Null_Iir);
+      pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt)));
+      return Tri_State_Type'Val (Get_State3 (Stmt));
+   end Get_Guarded_Target_State;
+
+   procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type) is
+   begin
+      pragma Assert (Stmt /= Null_Iir);
+      pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt)));
+      Set_State3 (Stmt, Tri_State_Type'Pos (State));
+   end Set_Guarded_Target_State;
+
+   function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit)));
+      return Get_Field5 (Design_Unit);
+   end Get_Library_Unit;
+
+   procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir)
+   is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit)));
+      Set_Field5 (Design_Unit, Lib_Unit);
+   end Set_Library_Unit;
+
+   function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit)));
+      return Get_Field7 (Design_Unit);
+   end Get_Hash_Chain;
+
+   procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir) is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit)));
+      Set_Field7 (Design_Unit, Chain);
+   end Set_Hash_Chain;
+
+   function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr
+   is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit)));
+      return Iir_To_Source_Ptr (Get_Field4 (Design_Unit));
+   end Get_Design_Unit_Source_Pos;
+
+   procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr)
+   is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit)));
+      Set_Field4 (Design_Unit, Source_Ptr_To_Iir (Pos));
+   end Set_Design_Unit_Source_Pos;
+
+   function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32 is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit)));
+      return Iir_To_Int32 (Get_Field11 (Design_Unit));
+   end Get_Design_Unit_Source_Line;
+
+   procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32) is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit)));
+      Set_Field11 (Design_Unit, Int32_To_Iir (Line));
+   end Set_Design_Unit_Source_Line;
+
+   function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32 is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit)));
+      return Iir_To_Int32 (Get_Field12 (Design_Unit));
+   end Get_Design_Unit_Source_Col;
+
+   procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32) is
+   begin
+      pragma Assert (Design_Unit /= Null_Iir);
+      pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit)));
+      Set_Field12 (Design_Unit, Int32_To_Iir (Line));
+   end Set_Design_Unit_Source_Col;
+
+   function Get_Value (Lit : Iir) return Iir_Int64 is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Value (Get_Kind (Lit)));
+      return Get_Int64 (Lit);
+   end Get_Value;
+
+   procedure Set_Value (Lit : Iir; Val : Iir_Int64) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Value (Get_Kind (Lit)));
+      Set_Int64 (Lit, Val);
+   end Set_Value;
+
+   function Get_Enum_Pos (Lit : Iir) return Iir_Int32 is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Enum_Pos (Get_Kind (Lit)));
+      return Iir_Int32'Val (Get_Field10 (Lit));
+   end Get_Enum_Pos;
+
+   procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Enum_Pos (Get_Kind (Lit)));
+      Set_Field10 (Lit, Iir_Int32'Pos (Val));
+   end Set_Enum_Pos;
+
+   function Get_Physical_Literal (Unit : Iir) return Iir is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Physical_Literal (Get_Kind (Unit)));
+      return Get_Field6 (Unit);
+   end Get_Physical_Literal;
+
+   procedure Set_Physical_Literal (Unit : Iir; Lit : Iir) is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Physical_Literal (Get_Kind (Unit)));
+      Set_Field6 (Unit, Lit);
+   end Set_Physical_Literal;
+
+   function Get_Physical_Unit_Value (Unit : Iir) return Iir is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit)));
+      return Get_Field7 (Unit);
+   end Get_Physical_Unit_Value;
+
+   procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir) is
+   begin
+      pragma Assert (Unit /= Null_Iir);
+      pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit)));
+      Set_Field7 (Unit, Lit);
+   end Set_Physical_Unit_Value;
+
+   function Get_Fp_Value (Lit : Iir) return Iir_Fp64 is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Fp_Value (Get_Kind (Lit)));
+      return Get_Fp64 (Lit);
+   end Get_Fp_Value;
+
+   procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Fp_Value (Get_Kind (Lit)));
+      Set_Fp64 (Lit, Val);
+   end Set_Fp_Value;
+
+   function Get_Enumeration_Decl (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Enumeration_Decl (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Enumeration_Decl;
+
+   procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Enumeration_Decl (Get_Kind (Target)));
+      Set_Field6 (Target, Lit);
+   end Set_Enumeration_Decl;
+
+   function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field3 (Target));
+   end Get_Simple_Aggregate_List;
+
+   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target)));
+      Set_Field3 (Target, Iir_List_To_Iir (List));
+   end Set_Simple_Aggregate_List;
+
+   function Get_Bit_String_Base (Lit : Iir) return Base_Type is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_Base (Get_Kind (Lit)));
+      return Base_Type'Val (Get_Field8 (Lit));
+   end Get_Bit_String_Base;
+
+   procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_Base (Get_Kind (Lit)));
+      Set_Field8 (Lit, Base_Type'Pos (Base));
+   end Set_Bit_String_Base;
+
+   function Get_Bit_String_0 (Lit : Iir) return Iir is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_0 (Get_Kind (Lit)));
+      return Get_Field6 (Lit);
+   end Get_Bit_String_0;
+
+   procedure Set_Bit_String_0 (Lit : Iir; El : Iir) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_0 (Get_Kind (Lit)));
+      Set_Field6 (Lit, El);
+   end Set_Bit_String_0;
+
+   function Get_Bit_String_1 (Lit : Iir) return Iir is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_1 (Get_Kind (Lit)));
+      return Get_Field7 (Lit);
+   end Get_Bit_String_1;
+
+   procedure Set_Bit_String_1 (Lit : Iir; El : Iir) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Bit_String_1 (Get_Kind (Lit)));
+      Set_Field7 (Lit, El);
+   end Set_Bit_String_1;
+
+   function Get_Literal_Origin (Lit : Iir) return Iir is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Literal_Origin (Get_Kind (Lit)));
+      return Get_Field2 (Lit);
+   end Get_Literal_Origin;
+
+   procedure Set_Literal_Origin (Lit : Iir; Orig : Iir) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Literal_Origin (Get_Kind (Lit)));
+      Set_Field2 (Lit, Orig);
+   end Set_Literal_Origin;
+
+   function Get_Range_Origin (Lit : Iir) return Iir is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Range_Origin (Get_Kind (Lit)));
+      return Get_Field4 (Lit);
+   end Get_Range_Origin;
+
+   procedure Set_Range_Origin (Lit : Iir; Orig : Iir) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Range_Origin (Get_Kind (Lit)));
+      Set_Field4 (Lit, Orig);
+   end Set_Range_Origin;
+
+   function Get_Literal_Subtype (Lit : Iir) return Iir is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Literal_Subtype (Get_Kind (Lit)));
+      return Get_Field5 (Lit);
+   end Get_Literal_Subtype;
+
+   procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_Literal_Subtype (Get_Kind (Lit)));
+      Set_Field5 (Lit, Atype);
+   end Set_Literal_Subtype;
+
+   function Get_Entity_Class (Target : Iir) return Token_Type is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Class (Get_Kind (Target)));
+      return Iir_To_Token_Type (Get_Field3 (Target));
+   end Get_Entity_Class;
+
+   procedure Set_Entity_Class (Target : Iir; Kind : Token_Type) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Class (Get_Kind (Target)));
+      Set_Field3 (Target, Token_Type_To_Iir (Kind));
+   end Set_Entity_Class;
+
+   function Get_Entity_Name_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Name_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field1 (Target));
+   end Get_Entity_Name_List;
+
+   procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Name_List (Get_Kind (Target)));
+      Set_Field1 (Target, Iir_List_To_Iir (Names));
+   end Set_Entity_Name_List;
+
+   function Get_Attribute_Designator (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Designator (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Attribute_Designator;
+
+   procedure Set_Attribute_Designator (Target : Iir; Designator : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Designator (Get_Kind (Target)));
+      Set_Field6 (Target, Designator);
+   end Set_Attribute_Designator;
+
+   function Get_Attribute_Specification_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Attribute_Specification_Chain;
+
+   procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target)));
+      Set_Field7 (Target, Chain);
+   end Set_Attribute_Specification_Chain;
+
+   function Get_Attribute_Specification (Val : Iir) return Iir is
+   begin
+      pragma Assert (Val /= Null_Iir);
+      pragma Assert (Has_Attribute_Specification (Get_Kind (Val)));
+      return Get_Field4 (Val);
+   end Get_Attribute_Specification;
+
+   procedure Set_Attribute_Specification (Val : Iir; Attr : Iir) is
+   begin
+      pragma Assert (Val /= Null_Iir);
+      pragma Assert (Has_Attribute_Specification (Get_Kind (Val)));
+      Set_Field4 (Val, Attr);
+   end Set_Attribute_Specification;
+
+   function Get_Signal_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field3 (Target));
+   end Get_Signal_List;
+
+   procedure Set_Signal_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_List (Get_Kind (Target)));
+      Set_Field3 (Target, Iir_List_To_Iir (List));
+   end Set_Signal_List;
+
+   function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir is
+   begin
+      pragma Assert (Val /= Null_Iir);
+      pragma Assert (Has_Designated_Entity (Get_Kind (Val)));
+      return Get_Field3 (Val);
+   end Get_Designated_Entity;
+
+   procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir)
+   is
+   begin
+      pragma Assert (Val /= Null_Iir);
+      pragma Assert (Has_Designated_Entity (Get_Kind (Val)));
+      Set_Field3 (Val, Entity);
+   end Set_Designated_Entity;
+
+   function Get_Formal (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Formal (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Formal;
+
+   procedure Set_Formal (Target : Iir; Formal : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Formal (Get_Kind (Target)));
+      Set_Field1 (Target, Formal);
+   end Set_Formal;
+
+   function Get_Actual (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Actual (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Actual;
+
+   procedure Set_Actual (Target : Iir; Actual : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Actual (Get_Kind (Target)));
+      Set_Field3 (Target, Actual);
+   end Set_Actual;
+
+   function Get_In_Conversion (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_In_Conversion (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_In_Conversion;
+
+   procedure Set_In_Conversion (Target : Iir; Conv : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_In_Conversion (Get_Kind (Target)));
+      Set_Field4 (Target, Conv);
+   end Set_In_Conversion;
+
+   function Get_Out_Conversion (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Out_Conversion (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Out_Conversion;
+
+   procedure Set_Out_Conversion (Target : Iir; Conv : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Out_Conversion (Get_Kind (Target)));
+      Set_Field5 (Target, Conv);
+   end Set_Out_Conversion;
+
+   function Get_Whole_Association_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target)));
+      return Get_Flag1 (Target);
+   end Get_Whole_Association_Flag;
+
+   procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target)));
+      Set_Flag1 (Target, Flag);
+   end Set_Whole_Association_Flag;
+
+   function Get_Collapse_Signal_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target)));
+      return Get_Flag2 (Target);
+   end Get_Collapse_Signal_Flag;
+
+   procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target)));
+      Set_Flag2 (Target, Flag);
+   end Set_Collapse_Signal_Flag;
+
+   function Get_Artificial_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Artificial_Flag (Get_Kind (Target)));
+      return Get_Flag3 (Target);
+   end Get_Artificial_Flag;
+
+   procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Artificial_Flag (Get_Kind (Target)));
+      Set_Flag3 (Target, Flag);
+   end Set_Artificial_Flag;
+
+   function Get_Open_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Open_Flag (Get_Kind (Target)));
+      return Get_Flag3 (Target);
+   end Get_Open_Flag;
+
+   procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Open_Flag (Get_Kind (Target)));
+      Set_Flag3 (Target, Flag);
+   end Set_Open_Flag;
+
+   function Get_After_Drivers_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target)));
+      return Get_Flag5 (Target);
+   end Get_After_Drivers_Flag;
+
+   procedure Set_After_Drivers_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target)));
+      Set_Flag5 (Target, Flag);
+   end Set_After_Drivers_Flag;
+
+   function Get_We_Value (We : Iir_Waveform_Element) return Iir is
+   begin
+      pragma Assert (We /= Null_Iir);
+      pragma Assert (Has_We_Value (Get_Kind (We)));
+      return Get_Field1 (We);
+   end Get_We_Value;
+
+   procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir) is
+   begin
+      pragma Assert (We /= Null_Iir);
+      pragma Assert (Has_We_Value (Get_Kind (We)));
+      Set_Field1 (We, An_Iir);
+   end Set_We_Value;
+
+   function Get_Time (We : Iir_Waveform_Element) return Iir is
+   begin
+      pragma Assert (We /= Null_Iir);
+      pragma Assert (Has_Time (Get_Kind (We)));
+      return Get_Field3 (We);
+   end Get_Time;
+
+   procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir) is
+   begin
+      pragma Assert (We /= Null_Iir);
+      pragma Assert (Has_Time (Get_Kind (We)));
+      Set_Field3 (We, An_Iir);
+   end Set_Time;
+
+   function Get_Associated_Expr (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Associated_Expr (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Associated_Expr;
+
+   procedure Set_Associated_Expr (Target : Iir; Associated : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Associated_Expr (Get_Kind (Target)));
+      Set_Field3 (Target, Associated);
+   end Set_Associated_Expr;
+
+   function Get_Associated_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Associated_Chain (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Associated_Chain;
+
+   procedure Set_Associated_Chain (Target : Iir; Associated : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Associated_Chain (Get_Kind (Target)));
+      Set_Field4 (Target, Associated);
+   end Set_Associated_Chain;
+
+   function Get_Choice_Name (Choice : Iir) return Iir is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Name (Get_Kind (Choice)));
+      return Get_Field5 (Choice);
+   end Get_Choice_Name;
+
+   procedure Set_Choice_Name (Choice : Iir; Name : Iir) is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Name (Get_Kind (Choice)));
+      Set_Field5 (Choice, Name);
+   end Set_Choice_Name;
+
+   function Get_Choice_Expression (Choice : Iir) return Iir is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Expression (Get_Kind (Choice)));
+      return Get_Field5 (Choice);
+   end Get_Choice_Expression;
+
+   procedure Set_Choice_Expression (Choice : Iir; Name : Iir) is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Expression (Get_Kind (Choice)));
+      Set_Field5 (Choice, Name);
+   end Set_Choice_Expression;
+
+   function Get_Choice_Range (Choice : Iir) return Iir is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Range (Get_Kind (Choice)));
+      return Get_Field5 (Choice);
+   end Get_Choice_Range;
+
+   procedure Set_Choice_Range (Choice : Iir; Name : Iir) is
+   begin
+      pragma Assert (Choice /= Null_Iir);
+      pragma Assert (Has_Choice_Range (Get_Kind (Choice)));
+      Set_Field5 (Choice, Name);
+   end Set_Choice_Range;
+
+   function Get_Same_Alternative_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target)));
+      return Get_Flag1 (Target);
+   end Get_Same_Alternative_Flag;
+
+   procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target)));
+      Set_Flag1 (Target, Val);
+   end Set_Same_Alternative_Flag;
+
+   function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Architecture (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Architecture;
+
+   procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Architecture (Get_Kind (Target)));
+      Set_Field3 (Target, Arch);
+   end Set_Architecture;
+
+   function Get_Block_Specification (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Specification (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Block_Specification;
+
+   procedure Set_Block_Specification (Target : Iir; Block : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Specification (Get_Kind (Target)));
+      Set_Field5 (Target, Block);
+   end Set_Block_Specification;
+
+   function Get_Prev_Block_Configuration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Prev_Block_Configuration;
+
+   procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target)));
+      Set_Field4 (Target, Block);
+   end Set_Prev_Block_Configuration;
+
+   function Get_Configuration_Item_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Configuration_Item_Chain;
+
+   procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target)));
+      Set_Field3 (Target, Chain);
+   end Set_Configuration_Item_Chain;
+
+   function Get_Attribute_Value_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Attribute_Value_Chain;
+
+   procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target)));
+      Set_Field4 (Target, Chain);
+   end Set_Attribute_Value_Chain;
+
+   function Get_Spec_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Spec_Chain (Get_Kind (Target)));
+      return Get_Field0 (Target);
+   end Get_Spec_Chain;
+
+   procedure Set_Spec_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Spec_Chain (Get_Kind (Target)));
+      Set_Field0 (Target, Chain);
+   end Set_Spec_Chain;
+
+   function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Attribute_Value_Spec_Chain;
+
+   procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target)));
+      Set_Field4 (Target, Chain);
+   end Set_Attribute_Value_Spec_Chain;
+
+   function Get_Entity_Name (Arch : Iir) return Iir is
+   begin
+      pragma Assert (Arch /= Null_Iir);
+      pragma Assert (Has_Entity_Name (Get_Kind (Arch)));
+      return Get_Field2 (Arch);
+   end Get_Entity_Name;
+
+   procedure Set_Entity_Name (Arch : Iir; Entity : Iir) is
+   begin
+      pragma Assert (Arch /= Null_Iir);
+      pragma Assert (Has_Entity_Name (Get_Kind (Arch)));
+      Set_Field2 (Arch, Entity);
+   end Set_Entity_Name;
+
+   function Get_Package (Package_Body : Iir) return Iir is
+   begin
+      pragma Assert (Package_Body /= Null_Iir);
+      pragma Assert (Has_Package (Get_Kind (Package_Body)));
+      return Get_Field4 (Package_Body);
+   end Get_Package;
+
+   procedure Set_Package (Package_Body : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Package_Body /= Null_Iir);
+      pragma Assert (Has_Package (Get_Kind (Package_Body)));
+      Set_Field4 (Package_Body, Decl);
+   end Set_Package;
+
+   function Get_Package_Body (Pkg : Iir) return Iir is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Body (Get_Kind (Pkg)));
+      return Get_Field2 (Pkg);
+   end Get_Package_Body;
+
+   procedure Set_Package_Body (Pkg : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Body (Get_Kind (Pkg)));
+      Set_Field2 (Pkg, Decl);
+   end Set_Package_Body;
+
+   function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Need_Body (Get_Kind (Decl)));
+      return Get_Flag1 (Decl);
+   end Get_Need_Body;
+
+   procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Need_Body (Get_Kind (Decl)));
+      Set_Flag1 (Decl, Flag);
+   end Set_Need_Body;
+
+   function Get_Block_Configuration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Configuration (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Block_Configuration;
+
+   procedure Set_Block_Configuration (Target : Iir; Block : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Configuration (Get_Kind (Target)));
+      Set_Field5 (Target, Block);
+   end Set_Block_Configuration;
+
+   function Get_Concurrent_Statement_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Concurrent_Statement_Chain;
+
+   procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target)));
+      Set_Field5 (Target, First);
+   end Set_Concurrent_Statement_Chain;
+
+   function Get_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Chain (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Chain;
+
+   procedure Set_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Chain (Get_Kind (Target)));
+      Set_Field2 (Target, Chain);
+   end Set_Chain;
+
+   function Get_Port_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Port_Chain (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Port_Chain;
+
+   procedure Set_Port_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Port_Chain (Get_Kind (Target)));
+      Set_Field7 (Target, Chain);
+   end Set_Port_Chain;
+
+   function Get_Generic_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generic_Chain (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Generic_Chain;
+
+   procedure Set_Generic_Chain (Target : Iir; Generics : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generic_Chain (Get_Kind (Target)));
+      Set_Field6 (Target, Generics);
+   end Set_Generic_Chain;
+
+   function Get_Type (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Type;
+
+   procedure Set_Type (Target : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type (Get_Kind (Target)));
+      Set_Field1 (Target, Atype);
+   end Set_Type;
+
+   function Get_Subtype_Indication (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Indication (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Subtype_Indication;
+
+   procedure Set_Subtype_Indication (Target : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Indication (Get_Kind (Target)));
+      Set_Field5 (Target, Atype);
+   end Set_Subtype_Indication;
+
+   function Get_Discrete_Range (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Discrete_Range (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Discrete_Range;
+
+   procedure Set_Discrete_Range (Target : Iir; Rng : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Discrete_Range (Get_Kind (Target)));
+      Set_Field6 (Target, Rng);
+   end Set_Discrete_Range;
+
+   function Get_Type_Definition (Decl : Iir) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Type_Definition (Get_Kind (Decl)));
+      return Get_Field1 (Decl);
+   end Get_Type_Definition;
+
+   procedure Set_Type_Definition (Decl : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Type_Definition (Get_Kind (Decl)));
+      Set_Field1 (Decl, Atype);
+   end Set_Type_Definition;
+
+   function Get_Subtype_Definition (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Definition (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Subtype_Definition;
+
+   procedure Set_Subtype_Definition (Target : Iir; Def : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Definition (Get_Kind (Target)));
+      Set_Field4 (Target, Def);
+   end Set_Subtype_Definition;
+
+   function Get_Nature (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Nature (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Nature;
+
+   procedure Set_Nature (Target : Iir; Nature : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Nature (Get_Kind (Target)));
+      Set_Field1 (Target, Nature);
+   end Set_Nature;
+
+   function Get_Mode (Target : Iir) return Iir_Mode is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Mode (Get_Kind (Target)));
+      return Iir_Mode'Val (Get_Odigit1 (Target));
+   end Get_Mode;
+
+   procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Mode (Get_Kind (Target)));
+      Set_Odigit1 (Target, Iir_Mode'Pos (Mode));
+   end Set_Mode;
+
+   function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_Kind (Get_Kind (Target)));
+      return Iir_Signal_Kind'Val (Get_State3 (Target));
+   end Get_Signal_Kind;
+
+   procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_Kind (Get_Kind (Target)));
+      Set_State3 (Target, Iir_Signal_Kind'Pos (Signal_Kind));
+   end Set_Signal_Kind;
+
+   function Get_Base_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Base_Name (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Base_Name;
+
+   procedure Set_Base_Name (Target : Iir; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Base_Name (Get_Kind (Target)));
+      Set_Field5 (Target, Name);
+   end Set_Base_Name;
+
+   function Get_Interface_Declaration_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Interface_Declaration_Chain;
+
+   procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target)));
+      Set_Field5 (Target, Chain);
+   end Set_Interface_Declaration_Chain;
+
+   function Get_Subprogram_Specification (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Specification (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Subprogram_Specification;
+
+   procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Specification (Get_Kind (Target)));
+      Set_Field4 (Target, Spec);
+   end Set_Subprogram_Specification;
+
+   function Get_Sequential_Statement_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Sequential_Statement_Chain;
+
+   procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target)));
+      Set_Field5 (Target, Chain);
+   end Set_Sequential_Statement_Chain;
+
+   function Get_Subprogram_Body (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Body (Get_Kind (Target)));
+      return Get_Field9 (Target);
+   end Get_Subprogram_Body;
+
+   procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Body (Get_Kind (Target)));
+      Set_Field9 (Target, A_Body);
+   end Set_Subprogram_Body;
+
+   function Get_Overload_Number (Target : Iir) return Iir_Int32 is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Overload_Number (Get_Kind (Target)));
+      return Iir_Int32'Val (Get_Field12 (Target));
+   end Get_Overload_Number;
+
+   procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Overload_Number (Get_Kind (Target)));
+      Set_Field12 (Target, Iir_Int32'Pos (Val));
+   end Set_Overload_Number;
+
+   function Get_Subprogram_Depth (Target : Iir) return Iir_Int32 is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Depth (Get_Kind (Target)));
+      return Iir_Int32'Val (Get_Field10 (Target));
+   end Get_Subprogram_Depth;
+
+   procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Depth (Get_Kind (Target)));
+      Set_Field10 (Target, Iir_Int32'Pos (Depth));
+   end Set_Subprogram_Depth;
+
+   function Get_Subprogram_Hash (Target : Iir) return Iir_Int32 is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Hash (Get_Kind (Target)));
+      return Iir_Int32'Val (Get_Field11 (Target));
+   end Get_Subprogram_Hash;
+
+   procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subprogram_Hash (Get_Kind (Target)));
+      Set_Field11 (Target, Iir_Int32'Pos (Val));
+   end Set_Subprogram_Hash;
+
+   function Get_Impure_Depth (Target : Iir) return Iir_Int32 is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Impure_Depth (Get_Kind (Target)));
+      return Iir_To_Iir_Int32 (Get_Field3 (Target));
+   end Get_Impure_Depth;
+
+   procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Impure_Depth (Get_Kind (Target)));
+      Set_Field3 (Target, Iir_Int32_To_Iir (Depth));
+   end Set_Impure_Depth;
+
+   function Get_Return_Type (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Return_Type (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Return_Type;
+
+   procedure Set_Return_Type (Target : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Return_Type (Get_Kind (Target)));
+      Set_Field1 (Target, Decl);
+   end Set_Return_Type;
+
+   function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions
+   is
+   begin
+      pragma Assert (D /= Null_Iir);
+      pragma Assert (Has_Implicit_Definition (Get_Kind (D)));
+      return Iir_Predefined_Functions'Val (Get_Field9 (D));
+   end Get_Implicit_Definition;
+
+   procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions)
+   is
+   begin
+      pragma Assert (D /= Null_Iir);
+      pragma Assert (Has_Implicit_Definition (Get_Kind (D)));
+      Set_Field9 (D, Iir_Predefined_Functions'Pos (Def));
+   end Set_Implicit_Definition;
+
+   function Get_Type_Reference (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Reference (Get_Kind (Target)));
+      return Get_Field10 (Target);
+   end Get_Type_Reference;
+
+   procedure Set_Type_Reference (Target : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Reference (Get_Kind (Target)));
+      Set_Field10 (Target, Decl);
+   end Set_Type_Reference;
+
+   function Get_Default_Value (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Value (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Default_Value;
+
+   procedure Set_Default_Value (Target : Iir; Value : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Value (Get_Kind (Target)));
+      Set_Field6 (Target, Value);
+   end Set_Default_Value;
+
+   function Get_Deferred_Declaration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Deferred_Declaration (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Deferred_Declaration;
+
+   procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Deferred_Declaration (Get_Kind (Target)));
+      Set_Field7 (Target, Decl);
+   end Set_Deferred_Declaration;
+
+   function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target)));
+      return Get_Flag1 (Target);
+   end Get_Deferred_Declaration_Flag;
+
+   procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target)));
+      Set_Flag1 (Target, Flag);
+   end Set_Deferred_Declaration_Flag;
+
+   function Get_Shared_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Shared_Flag (Get_Kind (Target)));
+      return Get_Flag2 (Target);
+   end Get_Shared_Flag;
+
+   procedure Set_Shared_Flag (Target : Iir; Shared : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Shared_Flag (Get_Kind (Target)));
+      Set_Flag2 (Target, Shared);
+   end Set_Shared_Flag;
+
+   function Get_Design_Unit (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Design_Unit (Get_Kind (Target)));
+      return Get_Field0 (Target);
+   end Get_Design_Unit;
+
+   procedure Set_Design_Unit (Target : Iir; Unit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Design_Unit (Get_Kind (Target)));
+      Set_Field0 (Target, Unit);
+   end Set_Design_Unit;
+
+   function Get_Block_Statement (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Statement (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Block_Statement;
+
+   procedure Set_Block_Statement (Target : Iir; Block : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Statement (Get_Kind (Target)));
+      Set_Field7 (Target, Block);
+   end Set_Block_Statement;
+
+   function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_Driver (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Signal_Driver;
+
+   procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Signal_Driver (Get_Kind (Target)));
+      Set_Field7 (Target, Driver);
+   end Set_Signal_Driver;
+
+   function Get_Declaration_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Declaration_Chain (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Declaration_Chain;
+
+   procedure Set_Declaration_Chain (Target : Iir; Decls : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Declaration_Chain (Get_Kind (Target)));
+      Set_Field1 (Target, Decls);
+   end Set_Declaration_Chain;
+
+   function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Logical_Name (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_File_Logical_Name;
+
+   procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Logical_Name (Get_Kind (Target)));
+      Set_Field6 (Target, Name);
+   end Set_File_Logical_Name;
+
+   function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Open_Kind (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_File_Open_Kind;
+
+   procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Open_Kind (Get_Kind (Target)));
+      Set_Field7 (Target, Kind);
+   end Set_File_Open_Kind;
+
+   function Get_Element_Position (Target : Iir) return Iir_Index32 is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Element_Position (Get_Kind (Target)));
+      return Iir_Index32'Val (Get_Field4 (Target));
+   end Get_Element_Position;
+
+   procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Element_Position (Get_Kind (Target)));
+      Set_Field4 (Target, Iir_Index32'Pos (Pos));
+   end Set_Element_Position;
+
+   function Get_Element_Declaration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Element_Declaration (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Element_Declaration;
+
+   procedure Set_Element_Declaration (Target : Iir; El : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Element_Declaration (Get_Kind (Target)));
+      Set_Field2 (Target, El);
+   end Set_Element_Declaration;
+
+   function Get_Selected_Element (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Element (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Selected_Element;
+
+   procedure Set_Selected_Element (Target : Iir; El : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Element (Get_Kind (Target)));
+      Set_Field2 (Target, El);
+   end Set_Selected_Element;
+
+   function Get_Use_Clause_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Use_Clause_Chain;
+
+   procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target)));
+      Set_Field3 (Target, Chain);
+   end Set_Use_Clause_Chain;
+
+   function Get_Selected_Name (Target : Iir_Use_Clause) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Name (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Selected_Name;
+
+   procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Name (Get_Kind (Target)));
+      Set_Field1 (Target, Name);
+   end Set_Selected_Name;
+
+   function Get_Type_Declarator (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Type_Declarator (Get_Kind (Def)));
+      return Get_Field3 (Def);
+   end Get_Type_Declarator;
+
+   procedure Set_Type_Declarator (Def : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Type_Declarator (Get_Kind (Def)));
+      Set_Field3 (Def, Decl);
+   end Set_Type_Declarator;
+
+   function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field2 (Target));
+   end Get_Enumeration_Literal_List;
+
+   procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target)));
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Enumeration_Literal_List;
+
+   function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Entity_Class_Entry_Chain;
+
+   procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target)));
+      Set_Field1 (Target, Chain);
+   end Set_Entity_Class_Entry_Chain;
+
+   function Get_Group_Constituent_List (Group : Iir) return Iir_List is
+   begin
+      pragma Assert (Group /= Null_Iir);
+      pragma Assert (Has_Group_Constituent_List (Get_Kind (Group)));
+      return Iir_To_Iir_List (Get_Field1 (Group));
+   end Get_Group_Constituent_List;
+
+   procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Group /= Null_Iir);
+      pragma Assert (Has_Group_Constituent_List (Get_Kind (Group)));
+      Set_Field1 (Group, Iir_List_To_Iir (List));
+   end Set_Group_Constituent_List;
+
+   function Get_Unit_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Unit_Chain (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Unit_Chain;
+
+   procedure Set_Unit_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Unit_Chain (Get_Kind (Target)));
+      Set_Field1 (Target, Chain);
+   end Set_Unit_Chain;
+
+   function Get_Primary_Unit (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Primary_Unit (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Primary_Unit;
+
+   procedure Set_Primary_Unit (Target : Iir; Unit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Primary_Unit (Get_Kind (Target)));
+      Set_Field1 (Target, Unit);
+   end Set_Primary_Unit;
+
+   function Get_Identifier (Target : Iir) return Name_Id is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Identifier (Get_Kind (Target)));
+      return Iir_To_Name_Id (Get_Field3 (Target));
+   end Get_Identifier;
+
+   procedure Set_Identifier (Target : Iir; Identifier : Name_Id) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Identifier (Get_Kind (Target)));
+      Set_Field3 (Target, Name_Id_To_Iir (Identifier));
+   end Set_Identifier;
+
+   function Get_Label (Target : Iir) return Name_Id is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Label (Get_Kind (Target)));
+      return Iir_To_Name_Id (Get_Field3 (Target));
+   end Get_Label;
+
+   procedure Set_Label (Target : Iir; Label : Name_Id) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Label (Get_Kind (Target)));
+      Set_Field3 (Target, Name_Id_To_Iir (Label));
+   end Set_Label;
+
+   function Get_Visible_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Visible_Flag (Get_Kind (Target)));
+      return Get_Flag4 (Target);
+   end Get_Visible_Flag;
+
+   procedure Set_Visible_Flag (Target : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Visible_Flag (Get_Kind (Target)));
+      Set_Flag4 (Target, Flag);
+   end Set_Visible_Flag;
+
+   function Get_Range_Constraint (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Range_Constraint (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Range_Constraint;
+
+   procedure Set_Range_Constraint (Target : Iir; Constraint : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Range_Constraint (Get_Kind (Target)));
+      Set_Field1 (Target, Constraint);
+   end Set_Range_Constraint;
+
+   function Get_Direction (Decl : Iir) return Iir_Direction is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Direction (Get_Kind (Decl)));
+      return Iir_Direction'Val (Get_State2 (Decl));
+   end Get_Direction;
+
+   procedure Set_Direction (Decl : Iir; Dir : Iir_Direction) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Direction (Get_Kind (Decl)));
+      Set_State2 (Decl, Iir_Direction'Pos (Dir));
+   end Set_Direction;
+
+   function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Left_Limit (Get_Kind (Decl)));
+      return Get_Field2 (Decl);
+   end Get_Left_Limit;
+
+   procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Left_Limit (Get_Kind (Decl)));
+      Set_Field2 (Decl, Limit);
+   end Set_Left_Limit;
+
+   function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Right_Limit (Get_Kind (Decl)));
+      return Get_Field3 (Decl);
+   end Get_Right_Limit;
+
+   procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Right_Limit (Get_Kind (Decl)));
+      Set_Field3 (Decl, Limit);
+   end Set_Right_Limit;
+
+   function Get_Base_Type (Decl : Iir) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Base_Type (Get_Kind (Decl)));
+      return Get_Field4 (Decl);
+   end Get_Base_Type;
+
+   procedure Set_Base_Type (Decl : Iir; Base_Type : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Base_Type (Get_Kind (Decl)));
+      Set_Field4 (Decl, Base_Type);
+   end Set_Base_Type;
+
+   function Get_Resolution_Indication (Decl : Iir) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Resolution_Indication (Get_Kind (Decl)));
+      return Get_Field5 (Decl);
+   end Get_Resolution_Indication;
+
+   procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Resolution_Indication (Get_Kind (Decl)));
+      Set_Field5 (Decl, Ind);
+   end Set_Resolution_Indication;
+
+   function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir is
+   begin
+      pragma Assert (Res /= Null_Iir);
+      pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res)));
+      return Get_Field1 (Res);
+   end Get_Record_Element_Resolution_Chain;
+
+   procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Res /= Null_Iir);
+      pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res)));
+      Set_Field1 (Res, Chain);
+   end Set_Record_Element_Resolution_Chain;
+
+   function Get_Tolerance (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Tolerance (Get_Kind (Def)));
+      return Get_Field7 (Def);
+   end Get_Tolerance;
+
+   procedure Set_Tolerance (Def : Iir; Tol : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Tolerance (Get_Kind (Def)));
+      Set_Field7 (Def, Tol);
+   end Set_Tolerance;
+
+   function Get_Plus_Terminal (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Plus_Terminal (Get_Kind (Def)));
+      return Get_Field8 (Def);
+   end Get_Plus_Terminal;
+
+   procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Plus_Terminal (Get_Kind (Def)));
+      Set_Field8 (Def, Terminal);
+   end Set_Plus_Terminal;
+
+   function Get_Minus_Terminal (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Minus_Terminal (Get_Kind (Def)));
+      return Get_Field9 (Def);
+   end Get_Minus_Terminal;
+
+   procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Minus_Terminal (Get_Kind (Def)));
+      Set_Field9 (Def, Terminal);
+   end Set_Minus_Terminal;
+
+   function Get_Simultaneous_Left (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Simultaneous_Left (Get_Kind (Def)));
+      return Get_Field5 (Def);
+   end Get_Simultaneous_Left;
+
+   procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Simultaneous_Left (Get_Kind (Def)));
+      Set_Field5 (Def, Expr);
+   end Set_Simultaneous_Left;
+
+   function Get_Simultaneous_Right (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Simultaneous_Right (Get_Kind (Def)));
+      return Get_Field6 (Def);
+   end Get_Simultaneous_Right;
+
+   procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Simultaneous_Right (Get_Kind (Def)));
+      Set_Field6 (Def, Expr);
+   end Set_Simultaneous_Right;
+
+   function Get_Text_File_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Text_File_Flag (Get_Kind (Atype)));
+      return Get_Flag4 (Atype);
+   end Get_Text_File_Flag;
+
+   procedure Set_Text_File_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Text_File_Flag (Get_Kind (Atype)));
+      Set_Flag4 (Atype, Flag);
+   end Set_Text_File_Flag;
+
+   function Get_Only_Characters_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype)));
+      return Get_Flag4 (Atype);
+   end Get_Only_Characters_Flag;
+
+   procedure Set_Only_Characters_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype)));
+      Set_Flag4 (Atype, Flag);
+   end Set_Only_Characters_Flag;
+
+   function Get_Type_Staticness (Atype : Iir) return Iir_Staticness is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Type_Staticness (Get_Kind (Atype)));
+      return Iir_Staticness'Val (Get_State1 (Atype));
+   end Get_Type_Staticness;
+
+   procedure Set_Type_Staticness (Atype : Iir; Static : Iir_Staticness) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Type_Staticness (Get_Kind (Atype)));
+      Set_State1 (Atype, Iir_Staticness'Pos (Static));
+   end Set_Type_Staticness;
+
+   function Get_Constraint_State (Atype : Iir) return Iir_Constraint is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Constraint_State (Get_Kind (Atype)));
+      return Iir_Constraint'Val (Get_State2 (Atype));
+   end Get_Constraint_State;
+
+   procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Constraint_State (Get_Kind (Atype)));
+      Set_State2 (Atype, Iir_Constraint'Pos (State));
+   end Set_Constraint_State;
+
+   function Get_Index_Subtype_List (Decl : Iir) return Iir_List is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl)));
+      return Iir_To_Iir_List (Get_Field9 (Decl));
+   end Get_Index_Subtype_List;
+
+   procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl)));
+      Set_Field9 (Decl, Iir_List_To_Iir (List));
+   end Set_Index_Subtype_List;
+
+   function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def)));
+      return Iir_To_Iir_List (Get_Field6 (Def));
+   end Get_Index_Subtype_Definition_List;
+
+   procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def)));
+      Set_Field6 (Def, Iir_List_To_Iir (Idx));
+   end Set_Index_Subtype_Definition_List;
+
+   function Get_Element_Subtype_Indication (Decl : Iir) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl)));
+      return Get_Field2 (Decl);
+   end Get_Element_Subtype_Indication;
+
+   procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl)));
+      Set_Field2 (Decl, Sub_Type);
+   end Set_Element_Subtype_Indication;
+
+   function Get_Element_Subtype (Decl : Iir) return Iir is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Element_Subtype (Get_Kind (Decl)));
+      return Get_Field1 (Decl);
+   end Get_Element_Subtype;
+
+   procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Element_Subtype (Get_Kind (Decl)));
+      Set_Field1 (Decl, Sub_Type);
+   end Set_Element_Subtype;
+
+   function Get_Index_Constraint_List (Def : Iir) return Iir_List is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Index_Constraint_List (Get_Kind (Def)));
+      return Iir_To_Iir_List (Get_Field6 (Def));
+   end Get_Index_Constraint_List;
+
+   procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Index_Constraint_List (Get_Kind (Def)));
+      Set_Field6 (Def, Iir_List_To_Iir (List));
+   end Set_Index_Constraint_List;
+
+   function Get_Array_Element_Constraint (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def)));
+      return Get_Field8 (Def);
+   end Get_Array_Element_Constraint;
+
+   procedure Set_Array_Element_Constraint (Def : Iir; El : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def)));
+      Set_Field8 (Def, El);
+   end Set_Array_Element_Constraint;
+
+   function Get_Elements_Declaration_List (Decl : Iir) return Iir_List is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl)));
+      return Iir_To_Iir_List (Get_Field1 (Decl));
+   end Get_Elements_Declaration_List;
+
+   procedure Set_Elements_Declaration_List (Decl : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl)));
+      Set_Field1 (Decl, Iir_List_To_Iir (List));
+   end Set_Elements_Declaration_List;
+
+   function Get_Designated_Type (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Designated_Type (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Designated_Type;
+
+   procedure Set_Designated_Type (Target : Iir; Dtype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Designated_Type (Get_Kind (Target)));
+      Set_Field1 (Target, Dtype);
+   end Set_Designated_Type;
+
+   function Get_Designated_Subtype_Indication (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Designated_Subtype_Indication;
+
+   procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target)));
+      Set_Field5 (Target, Dtype);
+   end Set_Designated_Subtype_Indication;
+
+   function Get_Index_List (Decl : Iir) return Iir_List is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Index_List (Get_Kind (Decl)));
+      return Iir_To_Iir_List (Get_Field2 (Decl));
+   end Get_Index_List;
+
+   procedure Set_Index_List (Decl : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Index_List (Get_Kind (Decl)));
+      Set_Field2 (Decl, Iir_List_To_Iir (List));
+   end Set_Index_List;
+
+   function Get_Reference (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Reference (Get_Kind (Def)));
+      return Get_Field2 (Def);
+   end Get_Reference;
+
+   procedure Set_Reference (Def : Iir; Ref : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Reference (Get_Kind (Def)));
+      Set_Field2 (Def, Ref);
+   end Set_Reference;
+
+   function Get_Nature_Declarator (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Nature_Declarator (Get_Kind (Def)));
+      return Get_Field3 (Def);
+   end Get_Nature_Declarator;
+
+   procedure Set_Nature_Declarator (Def : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Nature_Declarator (Get_Kind (Def)));
+      Set_Field3 (Def, Decl);
+   end Set_Nature_Declarator;
+
+   function Get_Across_Type (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Across_Type (Get_Kind (Def)));
+      return Get_Field7 (Def);
+   end Get_Across_Type;
+
+   procedure Set_Across_Type (Def : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Across_Type (Get_Kind (Def)));
+      Set_Field7 (Def, Atype);
+   end Set_Across_Type;
+
+   function Get_Through_Type (Def : Iir) return Iir is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Through_Type (Get_Kind (Def)));
+      return Get_Field8 (Def);
+   end Get_Through_Type;
+
+   procedure Set_Through_Type (Def : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Def /= Null_Iir);
+      pragma Assert (Has_Through_Type (Get_Kind (Def)));
+      Set_Field8 (Def, Atype);
+   end Set_Through_Type;
+
+   function Get_Target (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Target (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Target;
+
+   procedure Set_Target (Target : Iir; Atarget : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Target (Get_Kind (Target)));
+      Set_Field1 (Target, Atarget);
+   end Set_Target;
+
+   function Get_Waveform_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Waveform_Chain (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Waveform_Chain;
+
+   procedure Set_Waveform_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Waveform_Chain (Get_Kind (Target)));
+      Set_Field5 (Target, Chain);
+   end Set_Waveform_Chain;
+
+   function Get_Guard (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard (Get_Kind (Target)));
+      return Get_Field8 (Target);
+   end Get_Guard;
+
+   procedure Set_Guard (Target : Iir; Guard : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard (Get_Kind (Target)));
+      Set_Field8 (Target, Guard);
+   end Set_Guard;
+
+   function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Delay_Mechanism (Get_Kind (Target)));
+      return Iir_Delay_Mechanism'Val (Get_Field12 (Target));
+   end Get_Delay_Mechanism;
+
+   procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Delay_Mechanism (Get_Kind (Target)));
+      Set_Field12 (Target, Iir_Delay_Mechanism'Pos (Kind));
+   end Set_Delay_Mechanism;
+
+   function Get_Reject_Time_Expression (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Reject_Time_Expression;
+
+   procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target)));
+      Set_Field6 (Target, Expr);
+   end Set_Reject_Time_Expression;
+
+   function Get_Sensitivity_List (Wait : Iir) return Iir_List is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Sensitivity_List (Get_Kind (Wait)));
+      return Iir_To_Iir_List (Get_Field6 (Wait));
+   end Get_Sensitivity_List;
+
+   procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Sensitivity_List (Get_Kind (Wait)));
+      Set_Field6 (Wait, Iir_List_To_Iir (List));
+   end Set_Sensitivity_List;
+
+   function Get_Process_Origin (Proc : Iir) return Iir is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Process_Origin (Get_Kind (Proc)));
+      return Get_Field8 (Proc);
+   end Get_Process_Origin;
+
+   procedure Set_Process_Origin (Proc : Iir; Orig : Iir) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Process_Origin (Get_Kind (Proc)));
+      Set_Field8 (Proc, Orig);
+   end Set_Process_Origin;
+
+   function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Condition_Clause (Get_Kind (Wait)));
+      return Get_Field5 (Wait);
+   end Get_Condition_Clause;
+
+   procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir) is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Condition_Clause (Get_Kind (Wait)));
+      Set_Field5 (Wait, Cond);
+   end Set_Condition_Clause;
+
+   function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Timeout_Clause (Get_Kind (Wait)));
+      return Get_Field1 (Wait);
+   end Get_Timeout_Clause;
+
+   procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir) is
+   begin
+      pragma Assert (Wait /= Null_Iir);
+      pragma Assert (Has_Timeout_Clause (Get_Kind (Wait)));
+      Set_Field1 (Wait, Timeout);
+   end Set_Timeout_Clause;
+
+   function Get_Postponed_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Postponed_Flag (Get_Kind (Target)));
+      return Get_Flag3 (Target);
+   end Get_Postponed_Flag;
+
+   procedure Set_Postponed_Flag (Target : Iir; Value : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Postponed_Flag (Get_Kind (Target)));
+      Set_Flag3 (Target, Value);
+   end Set_Postponed_Flag;
+
+   function Get_Callees_List (Proc : Iir) return Iir_List is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Callees_List (Get_Kind (Proc)));
+      return Iir_To_Iir_List (Get_Field7 (Proc));
+   end Get_Callees_List;
+
+   procedure Set_Callees_List (Proc : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Callees_List (Get_Kind (Proc)));
+      Set_Field7 (Proc, Iir_List_To_Iir (List));
+   end Set_Callees_List;
+
+   function Get_Passive_Flag (Proc : Iir) return Boolean is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Passive_Flag (Get_Kind (Proc)));
+      return Get_Flag2 (Proc);
+   end Get_Passive_Flag;
+
+   procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Passive_Flag (Get_Kind (Proc)));
+      Set_Flag2 (Proc, Flag);
+   end Set_Passive_Flag;
+
+   function Get_Resolution_Function_Flag (Func : Iir) return Boolean is
+   begin
+      pragma Assert (Func /= Null_Iir);
+      pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func)));
+      return Get_Flag7 (Func);
+   end Get_Resolution_Function_Flag;
+
+   procedure Set_Resolution_Function_Flag (Func : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Func /= Null_Iir);
+      pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func)));
+      Set_Flag7 (Func, Flag);
+   end Set_Resolution_Function_Flag;
+
+   function Get_Wait_State (Proc : Iir) return Tri_State_Type is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Wait_State (Get_Kind (Proc)));
+      return Tri_State_Type'Val (Get_State1 (Proc));
+   end Get_Wait_State;
+
+   procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Wait_State (Get_Kind (Proc)));
+      Set_State1 (Proc, Tri_State_Type'Pos (State));
+   end Set_Wait_State;
+
+   function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc)));
+      return Iir_All_Sensitized'Val (Get_State3 (Proc));
+   end Get_All_Sensitized_State;
+
+   procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized)
+   is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc)));
+      Set_State3 (Proc, Iir_All_Sensitized'Pos (State));
+   end Set_All_Sensitized_State;
+
+   function Get_Seen_Flag (Proc : Iir) return Boolean is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Seen_Flag (Get_Kind (Proc)));
+      return Get_Flag1 (Proc);
+   end Get_Seen_Flag;
+
+   procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Seen_Flag (Get_Kind (Proc)));
+      Set_Flag1 (Proc, Flag);
+   end Set_Seen_Flag;
+
+   function Get_Pure_Flag (Func : Iir) return Boolean is
+   begin
+      pragma Assert (Func /= Null_Iir);
+      pragma Assert (Has_Pure_Flag (Get_Kind (Func)));
+      return Get_Flag2 (Func);
+   end Get_Pure_Flag;
+
+   procedure Set_Pure_Flag (Func : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Func /= Null_Iir);
+      pragma Assert (Has_Pure_Flag (Get_Kind (Func)));
+      Set_Flag2 (Func, Flag);
+   end Set_Pure_Flag;
+
+   function Get_Foreign_Flag (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Foreign_Flag (Get_Kind (Decl)));
+      return Get_Flag3 (Decl);
+   end Get_Foreign_Flag;
+
+   procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Foreign_Flag (Get_Kind (Decl)));
+      Set_Flag3 (Decl, Flag);
+   end Set_Foreign_Flag;
+
+   function Get_Resolved_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Resolved_Flag (Get_Kind (Atype)));
+      return Get_Flag1 (Atype);
+   end Get_Resolved_Flag;
+
+   procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Resolved_Flag (Get_Kind (Atype)));
+      Set_Flag1 (Atype, Flag);
+   end Set_Resolved_Flag;
+
+   function Get_Signal_Type_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype)));
+      return Get_Flag2 (Atype);
+   end Get_Signal_Type_Flag;
+
+   procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype)));
+      Set_Flag2 (Atype, Flag);
+   end Set_Signal_Type_Flag;
+
+   function Get_Has_Signal_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype)));
+      return Get_Flag3 (Atype);
+   end Get_Has_Signal_Flag;
+
+   procedure Set_Has_Signal_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype)));
+      Set_Flag3 (Atype, Flag);
+   end Set_Has_Signal_Flag;
+
+   function Get_Purity_State (Proc : Iir) return Iir_Pure_State is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Purity_State (Get_Kind (Proc)));
+      return Iir_Pure_State'Val (Get_State2 (Proc));
+   end Get_Purity_State;
+
+   procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State) is
+   begin
+      pragma Assert (Proc /= Null_Iir);
+      pragma Assert (Has_Purity_State (Get_Kind (Proc)));
+      Set_State2 (Proc, Iir_Pure_State'Pos (State));
+   end Set_Purity_State;
+
+   function Get_Elab_Flag (Design : Iir) return Boolean is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Elab_Flag (Get_Kind (Design)));
+      return Get_Flag3 (Design);
+   end Get_Elab_Flag;
+
+   procedure Set_Elab_Flag (Design : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Design /= Null_Iir);
+      pragma Assert (Has_Elab_Flag (Get_Kind (Design)));
+      Set_Flag3 (Design, Flag);
+   end Set_Elab_Flag;
+
+   function Get_Index_Constraint_Flag (Atype : Iir) return Boolean is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype)));
+      return Get_Flag4 (Atype);
+   end Get_Index_Constraint_Flag;
+
+   procedure Set_Index_Constraint_Flag (Atype : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Atype /= Null_Iir);
+      pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype)));
+      Set_Flag4 (Atype, Flag);
+   end Set_Index_Constraint_Flag;
+
+   function Get_Assertion_Condition (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Assertion_Condition (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Assertion_Condition;
+
+   procedure Set_Assertion_Condition (Target : Iir; Cond : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Assertion_Condition (Get_Kind (Target)));
+      Set_Field1 (Target, Cond);
+   end Set_Assertion_Condition;
+
+   function Get_Report_Expression (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Report_Expression (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Report_Expression;
+
+   procedure Set_Report_Expression (Target : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Report_Expression (Get_Kind (Target)));
+      Set_Field6 (Target, Expr);
+   end Set_Report_Expression;
+
+   function Get_Severity_Expression (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Severity_Expression (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Severity_Expression;
+
+   procedure Set_Severity_Expression (Target : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Severity_Expression (Get_Kind (Target)));
+      Set_Field5 (Target, Expr);
+   end Set_Severity_Expression;
+
+   function Get_Instantiated_Unit (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Instantiated_Unit (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Instantiated_Unit;
+
+   procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Instantiated_Unit (Get_Kind (Target)));
+      Set_Field1 (Target, Unit);
+   end Set_Instantiated_Unit;
+
+   function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target)));
+      return Get_Field8 (Target);
+   end Get_Generic_Map_Aspect_Chain;
+
+   procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target)));
+      Set_Field8 (Target, Generics);
+   end Set_Generic_Map_Aspect_Chain;
+
+   function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target)));
+      return Get_Field9 (Target);
+   end Get_Port_Map_Aspect_Chain;
+
+   procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target)));
+      Set_Field9 (Target, Port);
+   end Set_Port_Map_Aspect_Chain;
+
+   function Get_Configuration_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Name (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Configuration_Name;
+
+   procedure Set_Configuration_Name (Target : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Name (Get_Kind (Target)));
+      Set_Field1 (Target, Conf);
+   end Set_Configuration_Name;
+
+   function Get_Component_Configuration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Component_Configuration (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Component_Configuration;
+
+   procedure Set_Component_Configuration (Target : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Component_Configuration (Get_Kind (Target)));
+      Set_Field6 (Target, Conf);
+   end Set_Component_Configuration;
+
+   function Get_Configuration_Specification (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Specification (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Configuration_Specification;
+
+   procedure Set_Configuration_Specification (Target : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Configuration_Specification (Get_Kind (Target)));
+      Set_Field7 (Target, Conf);
+   end Set_Configuration_Specification;
+
+   function Get_Default_Binding_Indication (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Default_Binding_Indication;
+
+   procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target)));
+      Set_Field5 (Target, Conf);
+   end Set_Default_Binding_Indication;
+
+   function Get_Default_Configuration_Declaration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert
+         (Has_Default_Configuration_Declaration (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Default_Configuration_Declaration;
+
+   procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert
+         (Has_Default_Configuration_Declaration (Get_Kind (Target)));
+      Set_Field6 (Target, Conf);
+   end Set_Default_Configuration_Declaration;
+
+   function Get_Expression (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Expression (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Expression;
+
+   procedure Set_Expression (Target : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Expression (Get_Kind (Target)));
+      Set_Field5 (Target, Expr);
+   end Set_Expression;
+
+   function Get_Allocator_Designated_Type (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Allocator_Designated_Type;
+
+   procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target)));
+      Set_Field2 (Target, A_Type);
+   end Set_Allocator_Designated_Type;
+
+   function Get_Selected_Waveform_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Selected_Waveform_Chain;
+
+   procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target)));
+      Set_Field7 (Target, Chain);
+   end Set_Selected_Waveform_Chain;
+
+   function Get_Conditional_Waveform_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Conditional_Waveform_Chain;
+
+   procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target)));
+      Set_Field7 (Target, Chain);
+   end Set_Conditional_Waveform_Chain;
+
+   function Get_Guard_Expression (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard_Expression (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Guard_Expression;
+
+   procedure Set_Guard_Expression (Target : Iir; Expr : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard_Expression (Get_Kind (Target)));
+      Set_Field2 (Target, Expr);
+   end Set_Guard_Expression;
+
+   function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard_Decl (Get_Kind (Target)));
+      return Get_Field8 (Target);
+   end Get_Guard_Decl;
+
+   procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Guard_Decl (Get_Kind (Target)));
+      Set_Field8 (Target, Decl);
+   end Set_Guard_Decl;
+
+   function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List is
+   begin
+      pragma Assert (Guard /= Null_Iir);
+      pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard)));
+      return Iir_To_Iir_List (Get_Field6 (Guard));
+   end Get_Guard_Sensitivity_List;
+
+   procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Guard /= Null_Iir);
+      pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard)));
+      Set_Field6 (Guard, Iir_List_To_Iir (List));
+   end Set_Guard_Sensitivity_List;
+
+   function Get_Block_Block_Configuration (Block : Iir) return Iir is
+   begin
+      pragma Assert (Block /= Null_Iir);
+      pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block)));
+      return Get_Field6 (Block);
+   end Get_Block_Block_Configuration;
+
+   procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Block /= Null_Iir);
+      pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block)));
+      Set_Field6 (Block, Conf);
+   end Set_Block_Block_Configuration;
+
+   function Get_Package_Header (Pkg : Iir) return Iir is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Header (Get_Kind (Pkg)));
+      return Get_Field5 (Pkg);
+   end Get_Package_Header;
+
+   procedure Set_Package_Header (Pkg : Iir; Header : Iir) is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Header (Get_Kind (Pkg)));
+      Set_Field5 (Pkg, Header);
+   end Set_Package_Header;
+
+   function Get_Block_Header (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Header (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Block_Header;
+
+   procedure Set_Block_Header (Target : Iir; Header : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Block_Header (Get_Kind (Target)));
+      Set_Field7 (Target, Header);
+   end Set_Block_Header;
+
+   function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir is
+   begin
+      pragma Assert (Inst /= Null_Iir);
+      pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst)));
+      return Get_Field5 (Inst);
+   end Get_Uninstantiated_Package_Name;
+
+   procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir) is
+   begin
+      pragma Assert (Inst /= Null_Iir);
+      pragma Assert (Has_Uninstantiated_Package_Name (Get_Kind (Inst)));
+      Set_Field5 (Inst, Name);
+   end Set_Uninstantiated_Package_Name;
+
+   function Get_Generate_Block_Configuration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Generate_Block_Configuration;
+
+   procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target)));
+      Set_Field7 (Target, Conf);
+   end Set_Generate_Block_Configuration;
+
+   function Get_Generation_Scheme (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generation_Scheme (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Generation_Scheme;
+
+   procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Generation_Scheme (Get_Kind (Target)));
+      Set_Field6 (Target, Scheme);
+   end Set_Generation_Scheme;
+
+   function Get_Condition (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Condition (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Condition;
+
+   procedure Set_Condition (Target : Iir; Condition : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Condition (Get_Kind (Target)));
+      Set_Field1 (Target, Condition);
+   end Set_Condition;
+
+   function Get_Else_Clause (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Else_Clause (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Else_Clause;
+
+   procedure Set_Else_Clause (Target : Iir; Clause : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Else_Clause (Get_Kind (Target)));
+      Set_Field6 (Target, Clause);
+   end Set_Else_Clause;
+
+   function Get_Parameter_Specification (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter_Specification (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Parameter_Specification;
+
+   procedure Set_Parameter_Specification (Target : Iir; Param : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter_Specification (Get_Kind (Target)));
+      Set_Field1 (Target, Param);
+   end Set_Parameter_Specification;
+
+   function Get_Parent (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parent (Get_Kind (Target)));
+      return Get_Field0 (Target);
+   end Get_Parent;
+
+   procedure Set_Parent (Target : Iir; Parent : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parent (Get_Kind (Target)));
+      Set_Field0 (Target, Parent);
+   end Set_Parent;
+
+   function Get_Loop_Label (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Loop_Label (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Loop_Label;
+
+   procedure Set_Loop_Label (Target : Iir; Stmt : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Loop_Label (Get_Kind (Target)));
+      Set_Field5 (Target, Stmt);
+   end Set_Loop_Label;
+
+   function Get_Component_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Component_Name (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Component_Name;
+
+   procedure Set_Component_Name (Target : Iir; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Component_Name (Get_Kind (Target)));
+      Set_Field4 (Target, Name);
+   end Set_Component_Name;
+
+   function Get_Instantiation_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Instantiation_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field1 (Target));
+   end Get_Instantiation_List;
+
+   procedure Set_Instantiation_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Instantiation_List (Get_Kind (Target)));
+      Set_Field1 (Target, Iir_List_To_Iir (List));
+   end Set_Instantiation_List;
+
+   function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Aspect (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Entity_Aspect;
+
+   procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Entity_Aspect (Get_Kind (Target)));
+      Set_Field3 (Target, Entity);
+   end Set_Entity_Aspect;
+
+   function Get_Default_Entity_Aspect (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Default_Entity_Aspect;
+
+   procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target)));
+      Set_Field1 (Target, Aspect);
+   end Set_Default_Entity_Aspect;
+
+   function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target)));
+      return Get_Field6 (Target);
+   end Get_Default_Generic_Map_Aspect_Chain;
+
+   procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target)));
+      Set_Field6 (Target, Chain);
+   end Set_Default_Generic_Map_Aspect_Chain;
+
+   function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target)));
+      return Get_Field7 (Target);
+   end Get_Default_Port_Map_Aspect_Chain;
+
+   procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target)));
+      Set_Field7 (Target, Chain);
+   end Set_Default_Port_Map_Aspect_Chain;
+
+   function Get_Binding_Indication (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Binding_Indication (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Binding_Indication;
+
+   procedure Set_Binding_Indication (Target : Iir; Binding : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Binding_Indication (Get_Kind (Target)));
+      Set_Field3 (Target, Binding);
+   end Set_Binding_Indication;
+
+   function Get_Named_Entity (Name : Iir) return Iir is
+   begin
+      pragma Assert (Name /= Null_Iir);
+      pragma Assert (Has_Named_Entity (Get_Kind (Name)));
+      return Get_Field4 (Name);
+   end Get_Named_Entity;
+
+   procedure Set_Named_Entity (Name : Iir; Val : Iir) is
+   begin
+      pragma Assert (Name /= Null_Iir);
+      pragma Assert (Has_Named_Entity (Get_Kind (Name)));
+      Set_Field4 (Name, Val);
+   end Set_Named_Entity;
+
+   function Get_Alias_Declaration (Name : Iir) return Iir is
+   begin
+      pragma Assert (Name /= Null_Iir);
+      pragma Assert (Has_Alias_Declaration (Get_Kind (Name)));
+      return Get_Field2 (Name);
+   end Get_Alias_Declaration;
+
+   procedure Set_Alias_Declaration (Name : Iir; Val : Iir) is
+   begin
+      pragma Assert (Name /= Null_Iir);
+      pragma Assert (Has_Alias_Declaration (Get_Kind (Name)));
+      Set_Field2 (Name, Val);
+   end Set_Alias_Declaration;
+
+   function Get_Expr_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Expr_Staticness (Get_Kind (Target)));
+      return Iir_Staticness'Val (Get_State1 (Target));
+   end Get_Expr_Staticness;
+
+   procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Expr_Staticness (Get_Kind (Target)));
+      Set_State1 (Target, Iir_Staticness'Pos (Static));
+   end Set_Expr_Staticness;
+
+   function Get_Error_Origin (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Error_Origin (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Error_Origin;
+
+   procedure Set_Error_Origin (Target : Iir; Origin : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Error_Origin (Get_Kind (Target)));
+      Set_Field2 (Target, Origin);
+   end Set_Error_Origin;
+
+   function Get_Operand (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Operand (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Operand;
+
+   procedure Set_Operand (Target : Iir; An_Iir : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Operand (Get_Kind (Target)));
+      Set_Field2 (Target, An_Iir);
+   end Set_Operand;
+
+   function Get_Left (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Left (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Left;
+
+   procedure Set_Left (Target : Iir; An_Iir : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Left (Get_Kind (Target)));
+      Set_Field2 (Target, An_Iir);
+   end Set_Left;
+
+   function Get_Right (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Right (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Right;
+
+   procedure Set_Right (Target : Iir; An_Iir : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Right (Get_Kind (Target)));
+      Set_Field4 (Target, An_Iir);
+   end Set_Right;
+
+   function Get_Unit_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Unit_Name (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Unit_Name;
+
+   procedure Set_Unit_Name (Target : Iir; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Unit_Name (Get_Kind (Target)));
+      Set_Field3 (Target, Name);
+   end Set_Unit_Name;
+
+   function Get_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Name (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Name;
+
+   procedure Set_Name (Target : Iir; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Name (Get_Kind (Target)));
+      Set_Field4 (Target, Name);
+   end Set_Name;
+
+   function Get_Group_Template_Name (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Group_Template_Name (Get_Kind (Target)));
+      return Get_Field5 (Target);
+   end Get_Group_Template_Name;
+
+   procedure Set_Group_Template_Name (Target : Iir; Name : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Group_Template_Name (Get_Kind (Target)));
+      Set_Field5 (Target, Name);
+   end Set_Group_Template_Name;
+
+   function Get_Name_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Name_Staticness (Get_Kind (Target)));
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Name_Staticness;
+
+   procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Name_Staticness (Get_Kind (Target)));
+      Set_State2 (Target, Iir_Staticness'Pos (Static));
+   end Set_Name_Staticness;
+
+   function Get_Prefix (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Prefix (Get_Kind (Target)));
+      return Get_Field0 (Target);
+   end Get_Prefix;
+
+   procedure Set_Prefix (Target : Iir; Prefix : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Prefix (Get_Kind (Target)));
+      Set_Field0 (Target, Prefix);
+   end Set_Prefix;
+
+   function Get_Signature_Prefix (Sign : Iir) return Iir is
+   begin
+      pragma Assert (Sign /= Null_Iir);
+      pragma Assert (Has_Signature_Prefix (Get_Kind (Sign)));
+      return Get_Field1 (Sign);
+   end Get_Signature_Prefix;
+
+   procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir) is
+   begin
+      pragma Assert (Sign /= Null_Iir);
+      pragma Assert (Has_Signature_Prefix (Get_Kind (Sign)));
+      Set_Field1 (Sign, Prefix);
+   end Set_Signature_Prefix;
+
+   function Get_Slice_Subtype (Slice : Iir) return Iir is
+   begin
+      pragma Assert (Slice /= Null_Iir);
+      pragma Assert (Has_Slice_Subtype (Get_Kind (Slice)));
+      return Get_Field3 (Slice);
+   end Get_Slice_Subtype;
+
+   procedure Set_Slice_Subtype (Slice : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Slice /= Null_Iir);
+      pragma Assert (Has_Slice_Subtype (Get_Kind (Slice)));
+      Set_Field3 (Slice, Atype);
+   end Set_Slice_Subtype;
+
+   function Get_Suffix (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Suffix (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Suffix;
+
+   procedure Set_Suffix (Target : Iir; Suffix : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Suffix (Get_Kind (Target)));
+      Set_Field2 (Target, Suffix);
+   end Set_Suffix;
+
+   function Get_Index_Subtype (Attr : Iir) return Iir is
+   begin
+      pragma Assert (Attr /= Null_Iir);
+      pragma Assert (Has_Index_Subtype (Get_Kind (Attr)));
+      return Get_Field2 (Attr);
+   end Get_Index_Subtype;
+
+   procedure Set_Index_Subtype (Attr : Iir; St : Iir) is
+   begin
+      pragma Assert (Attr /= Null_Iir);
+      pragma Assert (Has_Index_Subtype (Get_Kind (Attr)));
+      Set_Field2 (Attr, St);
+   end Set_Index_Subtype;
+
+   function Get_Parameter (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Parameter;
+
+   procedure Set_Parameter (Target : Iir; Param : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter (Get_Kind (Target)));
+      Set_Field4 (Target, Param);
+   end Set_Parameter;
+
+   function Get_Actual_Type (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Actual_Type (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Actual_Type;
+
+   procedure Set_Actual_Type (Target : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Actual_Type (Get_Kind (Target)));
+      Set_Field3 (Target, Atype);
+   end Set_Actual_Type;
+
+   function Get_Associated_Interface (Assoc : Iir) return Iir is
+   begin
+      pragma Assert (Assoc /= Null_Iir);
+      pragma Assert (Has_Associated_Interface (Get_Kind (Assoc)));
+      return Get_Field4 (Assoc);
+   end Get_Associated_Interface;
+
+   procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir) is
+   begin
+      pragma Assert (Assoc /= Null_Iir);
+      pragma Assert (Has_Associated_Interface (Get_Kind (Assoc)));
+      Set_Field4 (Assoc, Inter);
+   end Set_Associated_Interface;
+
+   function Get_Association_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Association_Chain (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Association_Chain;
+
+   procedure Set_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Association_Chain (Get_Kind (Target)));
+      Set_Field2 (Target, Chain);
+   end Set_Association_Chain;
+
+   function Get_Individual_Association_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Individual_Association_Chain;
+
+   procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target)));
+      Set_Field4 (Target, Chain);
+   end Set_Individual_Association_Chain;
+
+   function Get_Aggregate_Info (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggregate_Info (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Aggregate_Info;
+
+   procedure Set_Aggregate_Info (Target : Iir; Info : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggregate_Info (Get_Kind (Target)));
+      Set_Field2 (Target, Info);
+   end Set_Aggregate_Info;
+
+   function Get_Sub_Aggregate_Info (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Sub_Aggregate_Info;
+
+   procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target)));
+      Set_Field1 (Target, Info);
+   end Set_Sub_Aggregate_Info;
+
+   function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target)));
+      return Get_Flag3 (Target);
+   end Get_Aggr_Dynamic_Flag;
+
+   procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target)));
+      Set_Flag3 (Target, Val);
+   end Set_Aggr_Dynamic_Flag;
+
+   function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32
+   is
+   begin
+      pragma Assert (Info /= Null_Iir);
+      pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info)));
+      return Iir_To_Iir_Int32 (Get_Field4 (Info));
+   end Get_Aggr_Min_Length;
+
+   procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32)
+   is
+   begin
+      pragma Assert (Info /= Null_Iir);
+      pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info)));
+      Set_Field4 (Info, Iir_Int32_To_Iir (Nbr));
+   end Set_Aggr_Min_Length;
+
+   function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Aggr_Low_Limit;
+
+   procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target)));
+      Set_Field2 (Target, Limit);
+   end Set_Aggr_Low_Limit;
+
+   function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Aggr_High_Limit;
+
+   procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target)));
+      Set_Field3 (Target, Limit);
+   end Set_Aggr_High_Limit;
+
+   function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target)));
+      return Get_Flag2 (Target);
+   end Get_Aggr_Others_Flag;
+
+   procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target)));
+      Set_Flag2 (Target, Val);
+   end Set_Aggr_Others_Flag;
+
+   function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target)));
+      return Get_Flag4 (Target);
+   end Get_Aggr_Named_Flag;
+
+   procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target)));
+      Set_Flag4 (Target, Val);
+   end Set_Aggr_Named_Flag;
+
+   function Get_Value_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Value_Staticness (Get_Kind (Target)));
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Value_Staticness;
+
+   procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Value_Staticness (Get_Kind (Target)));
+      Set_State2 (Target, Iir_Staticness'Pos (Staticness));
+   end Set_Value_Staticness;
+
+   function Get_Association_Choices_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Association_Choices_Chain;
+
+   procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target)));
+      Set_Field4 (Target, Chain);
+   end Set_Association_Choices_Chain;
+
+   function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target)));
+      return Get_Field1 (Target);
+   end Get_Case_Statement_Alternative_Chain;
+
+   procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target)));
+      Set_Field1 (Target, Chain);
+   end Set_Case_Statement_Alternative_Chain;
+
+   function Get_Choice_Staticness (Target : Iir) return Iir_Staticness is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Choice_Staticness (Get_Kind (Target)));
+      return Iir_Staticness'Val (Get_State2 (Target));
+   end Get_Choice_Staticness;
+
+   procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness)
+   is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Choice_Staticness (Get_Kind (Target)));
+      Set_State2 (Target, Iir_Staticness'Pos (Staticness));
+   end Set_Choice_Staticness;
+
+   function Get_Procedure_Call (Stmt : Iir) return Iir is
+   begin
+      pragma Assert (Stmt /= Null_Iir);
+      pragma Assert (Has_Procedure_Call (Get_Kind (Stmt)));
+      return Get_Field1 (Stmt);
+   end Get_Procedure_Call;
+
+   procedure Set_Procedure_Call (Stmt : Iir; Call : Iir) is
+   begin
+      pragma Assert (Stmt /= Null_Iir);
+      pragma Assert (Has_Procedure_Call (Get_Kind (Stmt)));
+      Set_Field1 (Stmt, Call);
+   end Set_Procedure_Call;
+
+   function Get_Implementation (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Implementation (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Implementation;
+
+   procedure Set_Implementation (Target : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Implementation (Get_Kind (Target)));
+      Set_Field3 (Target, Decl);
+   end Set_Implementation;
+
+   function Get_Parameter_Association_Chain (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Parameter_Association_Chain;
+
+   procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target)));
+      Set_Field2 (Target, Chain);
+   end Set_Parameter_Association_Chain;
+
+   function Get_Method_Object (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Method_Object (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Method_Object;
+
+   procedure Set_Method_Object (Target : Iir; Object : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Method_Object (Get_Kind (Target)));
+      Set_Field4 (Target, Object);
+   end Set_Method_Object;
+
+   function Get_Subtype_Type_Mark (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Subtype_Type_Mark;
+
+   procedure Set_Subtype_Type_Mark (Target : Iir; Mark : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target)));
+      Set_Field2 (Target, Mark);
+   end Set_Subtype_Type_Mark;
+
+   function Get_Type_Conversion_Subtype (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target)));
+      return Get_Field3 (Target);
+   end Get_Type_Conversion_Subtype;
+
+   procedure Set_Type_Conversion_Subtype (Target : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target)));
+      Set_Field3 (Target, Atype);
+   end Set_Type_Conversion_Subtype;
+
+   function Get_Type_Mark (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Mark (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Type_Mark;
+
+   procedure Set_Type_Mark (Target : Iir; Mark : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Mark (Get_Kind (Target)));
+      Set_Field4 (Target, Mark);
+   end Set_Type_Mark;
+
+   function Get_File_Type_Mark (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Type_Mark (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_File_Type_Mark;
+
+   procedure Set_File_Type_Mark (Target : Iir; Mark : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_File_Type_Mark (Get_Kind (Target)));
+      Set_Field2 (Target, Mark);
+   end Set_File_Type_Mark;
+
+   function Get_Return_Type_Mark (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Return_Type_Mark (Get_Kind (Target)));
+      return Get_Field8 (Target);
+   end Get_Return_Type_Mark;
+
+   procedure Set_Return_Type_Mark (Target : Iir; Mark : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Return_Type_Mark (Get_Kind (Target)));
+      Set_Field8 (Target, Mark);
+   end Set_Return_Type_Mark;
+
+   function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Lexical_Layout (Get_Kind (Decl)));
+      return Iir_Lexical_Layout_Type'Val (Get_Odigit2 (Decl));
+   end Get_Lexical_Layout;
+
+   procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Lexical_Layout (Get_Kind (Decl)));
+      Set_Odigit2 (Decl, Iir_Lexical_Layout_Type'Pos (Lay));
+   end Set_Lexical_Layout;
+
+   function Get_Incomplete_Type_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field2 (Target));
+   end Get_Incomplete_Type_List;
+
+   procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target)));
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Incomplete_Type_List;
+
+   function Get_Has_Disconnect_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target)));
+      return Get_Flag1 (Target);
+   end Get_Has_Disconnect_Flag;
+
+   procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target)));
+      Set_Flag1 (Target, Val);
+   end Set_Has_Disconnect_Flag;
+
+   function Get_Has_Active_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Has_Active_Flag (Get_Kind (Target)));
+      return Get_Flag2 (Target);
+   end Get_Has_Active_Flag;
+
+   procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Has_Active_Flag (Get_Kind (Target)));
+      Set_Flag2 (Target, Val);
+   end Set_Has_Active_Flag;
+
+   function Get_Is_Within_Flag (Target : Iir) return Boolean is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Is_Within_Flag (Get_Kind (Target)));
+      return Get_Flag5 (Target);
+   end Get_Is_Within_Flag;
+
+   procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Is_Within_Flag (Get_Kind (Target)));
+      Set_Flag5 (Target, Val);
+   end Set_Is_Within_Flag;
+
+   function Get_Type_Marks_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Marks_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field2 (Target));
+   end Get_Type_Marks_List;
+
+   procedure Set_Type_Marks_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Type_Marks_List (Get_Kind (Target)));
+      Set_Field2 (Target, Iir_List_To_Iir (List));
+   end Set_Type_Marks_List;
+
+   function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl)));
+      return Get_Flag1 (Decl);
+   end Get_Implicit_Alias_Flag;
+
+   procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl)));
+      Set_Flag1 (Decl, Flag);
+   end Set_Implicit_Alias_Flag;
+
+   function Get_Alias_Signature (Alias : Iir) return Iir is
+   begin
+      pragma Assert (Alias /= Null_Iir);
+      pragma Assert (Has_Alias_Signature (Get_Kind (Alias)));
+      return Get_Field5 (Alias);
+   end Get_Alias_Signature;
+
+   procedure Set_Alias_Signature (Alias : Iir; Signature : Iir) is
+   begin
+      pragma Assert (Alias /= Null_Iir);
+      pragma Assert (Has_Alias_Signature (Get_Kind (Alias)));
+      Set_Field5 (Alias, Signature);
+   end Set_Alias_Signature;
+
+   function Get_Attribute_Signature (Attr : Iir) return Iir is
+   begin
+      pragma Assert (Attr /= Null_Iir);
+      pragma Assert (Has_Attribute_Signature (Get_Kind (Attr)));
+      return Get_Field2 (Attr);
+   end Get_Attribute_Signature;
+
+   procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir) is
+   begin
+      pragma Assert (Attr /= Null_Iir);
+      pragma Assert (Has_Attribute_Signature (Get_Kind (Attr)));
+      Set_Field2 (Attr, Signature);
+   end Set_Attribute_Signature;
+
+   function Get_Overload_List (Target : Iir) return Iir_List is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Overload_List (Get_Kind (Target)));
+      return Iir_To_Iir_List (Get_Field1 (Target));
+   end Get_Overload_List;
+
+   procedure Set_Overload_List (Target : Iir; List : Iir_List) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Overload_List (Get_Kind (Target)));
+      Set_Field1 (Target, Iir_List_To_Iir (List));
+   end Set_Overload_List;
+
+   function Get_Simple_Name_Identifier (Target : Iir) return Name_Id is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target)));
+      return Iir_To_Name_Id (Get_Field3 (Target));
+   end Get_Simple_Name_Identifier;
+
+   procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target)));
+      Set_Field3 (Target, Name_Id_To_Iir (Ident));
+   end Set_Simple_Name_Identifier;
+
+   function Get_Simple_Name_Subtype (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Simple_Name_Subtype;
+
+   procedure Set_Simple_Name_Subtype (Target : Iir; Atype : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target)));
+      Set_Field4 (Target, Atype);
+   end Set_Simple_Name_Subtype;
+
+   function Get_Protected_Type_Body (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Protected_Type_Body (Get_Kind (Target)));
+      return Get_Field2 (Target);
+   end Get_Protected_Type_Body;
+
+   procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Protected_Type_Body (Get_Kind (Target)));
+      Set_Field2 (Target, Bod);
+   end Set_Protected_Type_Body;
+
+   function Get_Protected_Type_Declaration (Target : Iir) return Iir is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target)));
+      return Get_Field4 (Target);
+   end Get_Protected_Type_Declaration;
+
+   procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target)));
+      Set_Field4 (Target, Decl);
+   end Set_Protected_Type_Declaration;
+
+   function Get_End_Location (Target : Iir) return Location_Type is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_End_Location (Get_Kind (Target)));
+      return Iir_To_Location_Type (Get_Field6 (Target));
+   end Get_End_Location;
+
+   procedure Set_End_Location (Target : Iir; Loc : Location_Type) is
+   begin
+      pragma Assert (Target /= Null_Iir);
+      pragma Assert (Has_End_Location (Get_Kind (Target)));
+      Set_Field6 (Target, Location_Type_To_Iir (Loc));
+   end Set_End_Location;
+
+   function Get_String_Id (Lit : Iir) return String_Id is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_String_Id (Get_Kind (Lit)));
+      return Iir_To_String_Id (Get_Field3 (Lit));
+   end Get_String_Id;
+
+   procedure Set_String_Id (Lit : Iir; Id : String_Id) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_String_Id (Get_Kind (Lit)));
+      Set_Field3 (Lit, String_Id_To_Iir (Id));
+   end Set_String_Id;
+
+   function Get_String_Length (Lit : Iir) return Int32 is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_String_Length (Get_Kind (Lit)));
+      return Iir_To_Int32 (Get_Field4 (Lit));
+   end Get_String_Length;
+
+   procedure Set_String_Length (Lit : Iir; Len : Int32) is
+   begin
+      pragma Assert (Lit /= Null_Iir);
+      pragma Assert (Has_String_Length (Get_Kind (Lit)));
+      Set_Field4 (Lit, Int32_To_Iir (Len));
+   end Set_String_Length;
+
+   function Get_Use_Flag (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Use_Flag (Get_Kind (Decl)));
+      return Get_Flag6 (Decl);
+   end Get_Use_Flag;
+
+   procedure Set_Use_Flag (Decl : Iir; Val : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Use_Flag (Get_Kind (Decl)));
+      Set_Flag6 (Decl, Val);
+   end Set_Use_Flag;
+
+   function Get_End_Has_Reserved_Id (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl)));
+      return Get_Flag8 (Decl);
+   end Get_End_Has_Reserved_Id;
+
+   procedure Set_End_Has_Reserved_Id (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl)));
+      Set_Flag8 (Decl, Flag);
+   end Set_End_Has_Reserved_Id;
+
+   function Get_End_Has_Identifier (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl)));
+      return Get_Flag9 (Decl);
+   end Get_End_Has_Identifier;
+
+   procedure Set_End_Has_Identifier (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl)));
+      Set_Flag9 (Decl, Flag);
+   end Set_End_Has_Identifier;
+
+   function Get_End_Has_Postponed (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl)));
+      return Get_Flag10 (Decl);
+   end Get_End_Has_Postponed;
+
+   procedure Set_End_Has_Postponed (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl)));
+      Set_Flag10 (Decl, Flag);
+   end Set_End_Has_Postponed;
+
+   function Get_Has_Begin (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Begin (Get_Kind (Decl)));
+      return Get_Flag10 (Decl);
+   end Get_Has_Begin;
+
+   procedure Set_Has_Begin (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Begin (Get_Kind (Decl)));
+      Set_Flag10 (Decl, Flag);
+   end Set_Has_Begin;
+
+   function Get_Has_Is (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Is (Get_Kind (Decl)));
+      return Get_Flag7 (Decl);
+   end Get_Has_Is;
+
+   procedure Set_Has_Is (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Is (Get_Kind (Decl)));
+      Set_Flag7 (Decl, Flag);
+   end Set_Has_Is;
+
+   function Get_Has_Pure (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Pure (Get_Kind (Decl)));
+      return Get_Flag8 (Decl);
+   end Get_Has_Pure;
+
+   procedure Set_Has_Pure (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Pure (Get_Kind (Decl)));
+      Set_Flag8 (Decl, Flag);
+   end Set_Has_Pure;
+
+   function Get_Has_Body (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Body (Get_Kind (Decl)));
+      return Get_Flag9 (Decl);
+   end Get_Has_Body;
+
+   procedure Set_Has_Body (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Body (Get_Kind (Decl)));
+      Set_Flag9 (Decl, Flag);
+   end Set_Has_Body;
+
+   function Get_Has_Identifier_List (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl)));
+      return Get_Flag3 (Decl);
+   end Get_Has_Identifier_List;
+
+   procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl)));
+      Set_Flag3 (Decl, Flag);
+   end Set_Has_Identifier_List;
+
+   function Get_Has_Mode (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Mode (Get_Kind (Decl)));
+      return Get_Flag8 (Decl);
+   end Get_Has_Mode;
+
+   procedure Set_Has_Mode (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Mode (Get_Kind (Decl)));
+      Set_Flag8 (Decl, Flag);
+   end Set_Has_Mode;
+
+   function Get_Is_Ref (N : Iir) return Boolean is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Is_Ref (Get_Kind (N)));
+      return Get_Flag7 (N);
+   end Get_Is_Ref;
+
+   procedure Set_Is_Ref (N : Iir; Ref : Boolean) is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Is_Ref (Get_Kind (N)));
+      Set_Flag7 (N, Ref);
+   end Set_Is_Ref;
+
+   function Get_Psl_Property (Decl : Iir) return PSL_Node is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Property (Get_Kind (Decl)));
+      return Iir_To_PSL_Node (Get_Field1 (Decl));
+   end Get_Psl_Property;
+
+   procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Property (Get_Kind (Decl)));
+      Set_Field1 (Decl, PSL_Node_To_Iir (Prop));
+   end Set_Psl_Property;
+
+   function Get_Psl_Declaration (Decl : Iir) return PSL_Node is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Declaration (Get_Kind (Decl)));
+      return Iir_To_PSL_Node (Get_Field1 (Decl));
+   end Get_Psl_Declaration;
+
+   procedure Set_Psl_Declaration (Decl : Iir; Prop : PSL_Node) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Declaration (Get_Kind (Decl)));
+      Set_Field1 (Decl, PSL_Node_To_Iir (Prop));
+   end Set_Psl_Declaration;
+
+   function Get_Psl_Expression (Decl : Iir) return PSL_Node is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Expression (Get_Kind (Decl)));
+      return Iir_To_PSL_Node (Get_Field3 (Decl));
+   end Get_Psl_Expression;
+
+   procedure Set_Psl_Expression (Decl : Iir; Prop : PSL_Node) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Psl_Expression (Get_Kind (Decl)));
+      Set_Field3 (Decl, PSL_Node_To_Iir (Prop));
+   end Set_Psl_Expression;
+
+   function Get_Psl_Boolean (N : Iir) return PSL_Node is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Psl_Boolean (Get_Kind (N)));
+      return Iir_To_PSL_Node (Get_Field1 (N));
+   end Get_Psl_Boolean;
+
+   procedure Set_Psl_Boolean (N : Iir; Bool : PSL_Node) is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_Psl_Boolean (Get_Kind (N)));
+      Set_Field1 (N, PSL_Node_To_Iir (Bool));
+   end Set_Psl_Boolean;
+
+   function Get_PSL_Clock (N : Iir) return PSL_Node is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_PSL_Clock (Get_Kind (N)));
+      return Iir_To_PSL_Node (Get_Field7 (N));
+   end Get_PSL_Clock;
+
+   procedure Set_PSL_Clock (N : Iir; Clock : PSL_Node) is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_PSL_Clock (Get_Kind (N)));
+      Set_Field7 (N, PSL_Node_To_Iir (Clock));
+   end Set_PSL_Clock;
+
+   function Get_PSL_NFA (N : Iir) return PSL_NFA is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_PSL_NFA (Get_Kind (N)));
+      return Iir_To_PSL_NFA (Get_Field8 (N));
+   end Get_PSL_NFA;
+
+   procedure Set_PSL_NFA (N : Iir; Fa : PSL_NFA) is
+   begin
+      pragma Assert (N /= Null_Iir);
+      pragma Assert (Has_PSL_NFA (Get_Kind (N)));
+      Set_Field8 (N, PSL_NFA_To_Iir (Fa));
+   end Set_PSL_NFA;
+
+end Iirs;
diff --git a/src/iirs.adb.in b/src/iirs.adb.in
new file mode 100644
index 000000000..04511bb67
--- /dev/null
+++ b/src/iirs.adb.in
@@ -0,0 +1,229 @@
+--  Tree node definitions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO;
+with Nodes; use Nodes;
+with Lists; use Lists;
+with Nodes_Meta; use Nodes_Meta;
+
+package body Iirs is
+   function Is_Null (Node : Iir) return Boolean is
+   begin
+      return Node = Null_Iir;
+   end Is_Null;
+
+   function Is_Null_List (Node : Iir_List) return Boolean is
+   begin
+      return Node = Null_Iir_List;
+   end Is_Null_List;
+
+   ---------------------------------------------------
+   -- General subprograms that operate on every iir --
+   ---------------------------------------------------
+
+   function Get_Format (Kind : Iir_Kind) return Format_Type;
+
+   function Create_Iir (Kind : Iir_Kind) return Iir
+   is
+      Res : Iir;
+      Format : Format_Type;
+   begin
+      Format := Get_Format (Kind);
+      Res := Create_Node (Format);
+      Set_Nkind (Res, Iir_Kind'Pos (Kind));
+      return Res;
+   end Create_Iir;
+
+   --  Statistics.
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+      type Num_Array is array (Iir_Kind) of Natural;
+      Num : Num_Array := (others => 0);
+      type Format_Array is array (Format_Type) of Natural;
+      Formats : Format_Array := (others => 0);
+      Kind : Iir_Kind;
+      I : Iir;
+      Last_I : Iir;
+      Format : Format_Type;
+   begin
+      I := Error_Node + 1;
+      Last_I := Get_Last_Node;
+      while I < Last_I loop
+         Kind := Get_Kind (I);
+         Num (Kind) := Num (Kind) + 1;
+         Format := Get_Format (Kind);
+         Formats (Format) := Formats (Format) + 1;
+         case Format is
+            when Format_Medium =>
+               I := I + 2;
+            when Format_Short
+              | Format_Fp
+              | Format_Int =>
+               I := I + 1;
+         end case;
+      end loop;
+
+      Put_Line ("Stats per iir_kind:");
+      for J in Iir_Kind loop
+         if Num (J) /= 0 then
+            Put_Line (' ' & Iir_Kind'Image (J) & ':'
+                      & Natural'Image (Num (J)));
+         end if;
+      end loop;
+      Put_Line ("Stats per formats:");
+      for J in Format_Type loop
+         Put_Line (' ' & Format_Type'Image (J) & ':'
+                   & Natural'Image (Formats (J)));
+      end loop;
+   end Disp_Stats;
+
+   function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions)
+     return Boolean is
+   begin
+      case Func is
+         when Iir_Predefined_Bit_And
+           | Iir_Predefined_Bit_Or
+           | Iir_Predefined_Bit_Nand
+           | Iir_Predefined_Bit_Nor
+           | Iir_Predefined_Boolean_And
+           | Iir_Predefined_Boolean_Or
+           | Iir_Predefined_Boolean_Nand
+           | Iir_Predefined_Boolean_Nor =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Iir_Predefined_Shortcut_P;
+
+   function Create_Iir_Error return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Node (Format_Short);
+      Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error));
+      Set_Base_Type (Res, Res);
+      return Res;
+   end Create_Iir_Error;
+
+   procedure Location_Copy (Target: Iir; Src: Iir) is
+   begin
+      Set_Location (Target, Get_Location (Src));
+   end Location_Copy;
+
+   -- Get kind
+   function Get_Kind (An_Iir: Iir) return Iir_Kind
+   is
+      --  Speed up: avoid to check that nkind is in the bounds of Iir_Kind.
+      pragma Suppress (Range_Check);
+   begin
+      return Iir_Kind'Val (Get_Nkind (An_Iir));
+   end Get_Kind;
+
+   function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Time_Stamp_Id, Target => Iir);
+
+   function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Time_Stamp_Id);
+
+   function Iir_To_Iir_List is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Iir_List);
+   function Iir_List_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Iir_List, Target => Iir);
+
+   function Iir_To_Token_Type (N : Iir) return Token_Type is
+   begin
+      return Token_Type'Val (N);
+   end Iir_To_Token_Type;
+
+   function Token_Type_To_Iir (T : Token_Type) return Iir is
+   begin
+      return Token_Type'Pos (T);
+   end Token_Type_To_Iir;
+
+--     function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is
+--     begin
+--        return Iir_Index32 (N);
+--     end Iir_To_Iir_Index32;
+
+--     function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is
+--     begin
+--        return Iir_Index32'Pos (V);
+--     end Iir_Index32_To_Iir;
+
+   function Iir_To_Name_Id (N : Iir) return Name_Id is
+   begin
+      return Iir'Pos (N);
+   end Iir_To_Name_Id;
+   pragma Inline (Iir_To_Name_Id);
+
+   function Name_Id_To_Iir (V : Name_Id) return Iir is
+   begin
+      return Name_Id'Pos (V);
+   end Name_Id_To_Iir;
+
+   function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Iir_Int32);
+
+   function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Iir_Int32, Target => Iir);
+
+   function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is
+   begin
+      return Source_Ptr (N);
+   end Iir_To_Source_Ptr;
+
+   function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is
+   begin
+      return Iir (P);
+   end Source_Ptr_To_Iir;
+
+   function Iir_To_Location_Type (N : Iir) return Location_Type is
+   begin
+      return Location_Type (N);
+   end Iir_To_Location_Type;
+
+   function Location_Type_To_Iir (L : Location_Type) return Iir is
+   begin
+      return Iir (L);
+   end Location_Type_To_Iir;
+
+   function Iir_To_String_Id is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => String_Id);
+   function String_Id_To_Iir is new Ada.Unchecked_Conversion
+     (Source => String_Id, Target => Iir);
+
+   function Iir_To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => Int32);
+   function Int32_To_Iir is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Iir);
+
+   function Iir_To_PSL_Node is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => PSL_Node);
+
+   function PSL_Node_To_Iir is new Ada.Unchecked_Conversion
+     (Source => PSL_Node, Target => Iir);
+
+   function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion
+     (Source => Iir, Target => PSL_NFA);
+
+   function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion
+     (Source => PSL_NFA, Target => Iir);
+
+   --  Subprograms
+end Iirs;
diff --git a/src/iirs.ads b/src/iirs.ads
new file mode 100644
index 000000000..cd58daa56
--- /dev/null
+++ b/src/iirs.ads
@@ -0,0 +1,6445 @@
+--  Tree node definitions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Deallocation;
+with Types; use Types;
+with Tokens; use Tokens;
+with Nodes;
+with Lists;
+
+package Iirs is
+   --  This package defines the semantic tree and functions to handle it.
+   --  The tree is roughly based on IIR (Internal Intermediate Representation),
+   --  [AIRE/CE Advanced Intermediate Representation with Extensibility,
+   --   Common Environment.  http://www.vhdl.org/aire/index.html ]
+   --  but oriented object features are not used, and sometimes, functions
+   --  or fields have changed.
+
+   --  Note: this tree is also used during syntaxic analysis, but with
+   --  a little bit different meanings for the fields.
+   --  The parser (parse package) build the tree.
+   --  The semantic pass (sem, sem_expr, sem_name) transforms it into a
+   --  semantic tree.
+
+   --  Documentation:
+   --  Only the semantic aspect is to be fully documented.
+   --  The syntaxic aspect is only used between parse and sem.
+
+   --  Each node of the tree is a record of type iir.  The record has only
+   --  one discriminent, which contains the kind of the node.  There is
+   --  currenlty no variant (but this can change, this is not public).
+
+   --  The root of a semantic tree is a library_declaration.
+   --  All the library_declarations are kept in a private list, held by
+   --  package libraries.
+   --  Exemple of a tree:
+   --   library_declaration
+   --   +-- design_file
+   --       +-- design_unit
+   --       |   +-- entity_declaration
+   --       +-- design_unit
+   --           +-- architecture_body
+   --  ...
+
+   --  Since the tree can represent all the libraries and their contents, it
+   --  is not always loaded into memory.
+   --  When a library is loaded, only library_declaration, design_file,
+   --  design_unit and library_unit nodes are created.  When a design_unit is
+   --  really loaded, the design_unit node is not replaced but modified (ie,
+   --  access to this node are still valid).
+
+   --  To add a new kind of node:
+   --   the name should be of the form iir_kind_NAME
+   --   add iir_kind_NAME in the definition of type iir_kind_type
+   --   document the node below: grammar, methods.
+   --   for each methods, add the name if the case statement in the body
+   --     (this enables the methods)
+   --   add an entry in disp_tree (debugging)
+   --   handle this node in Errorout.Disp_Node
+
+   --  Meta-grammar
+   --  This file is processed by a tool to automatically generate the body, so
+   --  it must follow a meta-grammar.
+   --
+   --  The low level representation is described in nodes.ads.
+   --
+   --  The literals for the nodes must be declared in this file like this:
+   --   type Iir_Kind is
+   --      (
+   --       Iir_Kind_AAA,
+   --   ...
+   --       Iir_Kind_ZZZ
+   --      );
+   --  The tool doesn't check for uniqness as this is done by the compiler.
+   --
+   --  It is possible to declare ranges of kinds like this:
+   --   subtype Iir_Kinds_RANGE is Iir_Kind range
+   --     Iir_Kind_FIRST ..
+   --   --Iir_Kind_MID
+   --     Iir_Kind_LAST;
+   --  Literals Iir_Kind_MID are optionnal (FIXME: make them required ?), but
+   --  if present all the values between FIRST and LAST must be present.
+   --
+   --  The methods appear after the comment: '   -- General methods.'
+   --  They have the following format:
+   --    --  Field: FIELD ATTR (CONV)
+   --   function Get_NAME (PNAME : PTYPE) return RTYPE;
+   --   procedure Set_NAME (PNAME : PTYPE; RNAME : RTYPE);
+   --  'FIELD' indicate which field of the node is used to store the value.
+   --  ATTR is optional and if present must be one of:
+   --     Ref: the field is a reference to an existing node
+   --     Chain: the field contains a chain of nodes
+   --     Chain_Next: the field contains the next element of a chain (present
+   --      only on one field: Set/Get_Chain).
+   --  ' (CONV)' is present if the type of the value (indicated by RTYPE) is
+   --  different from the type of the field.  CONV can be either 'uc' or 'pos'.
+   --  'uc' indicates an unchecked conversion while 'pos' a pos/val conversion.
+   --
+   --  Nodes content is described between '   -- Start of Iir_Kind.' and
+   --  '   -- End of Iir_Kind.' like this:
+   --   -- Iir_Kind_NODE1 (FORMAT1)
+   --   -- Iir_Kind_NODE2 (FORMAT2)
+   --   --
+   --   --   Get/Set_NAME1 (FIELD1)
+   --   --
+   --   --   Get/Set_NAME2 (FIELD2)
+   --   --   Get/Set_NAME3 (Alias FIELD2)
+   --   --
+   --   -- Only for Iir_Kind_NODE1:
+   --   --   Get/Set_NAME4 (FIELD3)
+   --  Severals nodes can be described at once; at least one must be described.
+   --  Fields FIELD1, FIELD2, FIELD3 must be different, unless 'Alias ' is
+   --  present.  The number of spaces is significant.  The 'Only for ' lines
+   --  are optionnal and there may be severals of them.
+
+   -------------------------------------------------
+   -- General methods (can be used on all nodes): --
+   -------------------------------------------------
+
+   --  Create a node of kind KIND.
+   --    function Create_Iir (Kind: Iir_Kind) return Iir;
+   --
+   --  Deallocate a node.  Deallocate fields that where allocated by
+   --  create_iir.
+   --   procedure Free_Iir (Target: in out Iir);
+   --
+   --  Get the kind of the iir.
+   --  See below for the (public) list of kinds.
+   --   function Get_Kind (An_Iir: Iir) return Iir_Kind;
+
+   --  Get the location of the node: ie the current position in the source
+   --  file when the node was created.  This is a little bit fuzzy.
+   --
+   --   procedure Set_Location (Target: in out Iir; Location: Location_Type);
+   --   function Get_Location (Target: in out Iir) return Location_Type;
+   --
+   --  Copy a location from a node to another one.
+   --   procedure Location_Copy (Target: in out Iir; Src: in Iir);
+
+   --  The next line marks the start of the node description.
+   -- Start of Iir_Kind.
+
+   --------------------------------------------------
+   --  A set of methods are associed with a kind.  --
+   --------------------------------------------------
+
+   -- Iir_Kind_Design_File (Medium)
+   --  LRM93 11
+   --  design_file ::= design_unit { design_unit }
+   --
+   --  The library containing this design file.
+   --   Get/Set_Library (Field0)
+   --   Get/Set_Parent (Alias Field0)
+   --
+   --   Get/Set_File_Dependence_List (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Analysis_Time_Stamp (Field3)
+   --
+   --   Get/Set_File_Time_Stamp (Field4)
+   --
+   --  Get the chain of unit contained in the file.  This is a simply linked
+   --  chain, but the tail is kept to speed-up appending operation.
+   --   Get/Set_First_Design_Unit (Field5)
+   --
+   --   Get/Set_Last_Design_Unit (Field6)
+   --
+   --  Identifier for the design file file name and dirname.
+   --   Get/Set_Design_File_Filename (Field12)
+   --   Get/Set_Design_File_Directory (Field11)
+   --
+   --  Flag used during elaboration.  Set when the file was already seen.
+   --   Get/Set_Elab_Flag (Flag3)
+
+   -- Iir_Kind_Design_Unit (Medium)
+   --  LRM93 11
+   --  design_unit ::= context_clause library_unit
+   --
+   --  The design_file containing this design unit.
+   --   Get/Set_Design_File (Field0)
+   --   Get/Set_Parent (Alias Field0)
+   --
+   --  Get the chain of context clause.
+   --   Get/Set_Context_Items (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --  Get/Set the library unit, which can be an entity, an architecture,
+   --  a package, a package body or a configuration.
+   --   Get/Set_Library_Unit (Field5)
+   --
+   --   Get/Set_End_Location (Field6)
+   --
+   --  Collision chain for units.
+   --   Get/Set_Hash_Chain (Field7)
+   --
+   --  Get the list of design units that must be analysed before this unit.
+   --  See LRM93 11.4 for the rules defining the order of analysis.
+   --   Get/Set_Dependence_List (Field8)
+   --
+   --  FIXME: this field can be put in the library_unit, since it is only used
+   --  when the units have been analyzed.
+   --   Get/Set_Analysis_Checks_List (Field9)
+   --
+   --  This is a symbolic date, only used as a order of analysis of design
+   --  units.
+   --   Get/Set_Date (Field10)
+   --
+   --  Set the line and the offset in the line, only for the library manager.
+   --  This is valid until the file is really loaded in memory.  On loading,
+   --  location will contain all this informations.
+   --   Get/Set_Design_Unit_Source_Pos (Field4)
+   --
+   --   Get/Set_Design_Unit_Source_Line (Field11)
+   --
+   --   Get/Set_Design_Unit_Source_Col (Field12)
+   --
+   --  Get/Set the date state, which indicates whether this design unit is in
+   --  memory or not.
+   --   Get/Set_Date_State (State1)
+   --
+   --  Flag used during elaboration.  Set when the file was already seen.
+   --   Get/Set_Elab_Flag (Flag3)
+
+   -- Iir_Kind_Library_Clause (Short)
+   --
+   --  LRM08 13.2 Design libraries
+   --
+   --  library_clause ::= LIBRARY logical_name_list ;
+   --
+   --  logical_name_list ::= logical_name { , logical_name }
+   --
+   --  logical_name ::= identifier
+   --
+   --  Note: a library_clause node is created for every logical_name.
+   --  As a consequence, the scope of the library starts after the logical_name
+   --  and not after the library_clause.  However, since an identifier
+   --  can only be used as a logical_name, and since the second occurence has
+   --  no effect, this is correct.
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Library_Declaration (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+
+   ---------------
+   --  Literals --
+   ---------------
+
+   -- Iir_Kind_String_Literal (Short)
+   -- Iir_Kind_Bit_String_Literal (Medium)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  Used for computed literals.  Literal_Origin contains the expression
+   --  whose value was computed during analysis and replaces the expression.
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_String_Id (Field3)
+   --
+   --  As bit-strings are expanded to '0'/'1' strings, this is the number of
+   --  characters.
+   --   Get/Set_String_Length (Field4)
+   --
+   --  Same as Type, but marked as property of that node.
+   --   Get/Set_Literal_Subtype (Field5)
+   --
+   --  For bit string only:
+   --  Enumeration literal which correspond to '0' and '1'.
+   --  This cannot be defined only in the enumeration type definition, due to
+   --  possible aliases.
+   -- Only for Iir_Kind_Bit_String_Literal:
+   --   Get/Set_Bit_String_0 (Field6)
+   -- Only for Iir_Kind_Bit_String_Literal:
+   --   Get/Set_Bit_String_1 (Field7)
+   --
+   -- Only for Iir_Kind_Bit_String_Literal:
+   --   Get/Set_Bit_String_Base (Field8)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Integer_Literal (Int)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  Get/Set the value of the integer.
+   --   Get/Set_Value (Int64)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Floating_Point_Literal (Fp)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  The value of the literal.
+   --   Get/Set_Fp_Value (Fp64)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Null_Literal (Short)
+   --  The null literal, which can be a disconnection or a null access.
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Physical_Int_Literal (Int)
+   -- Iir_Kind_Physical_Fp_Literal (Fp)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --  The physical unit of the literal.
+   --   Get/Set_Unit_Name (Field3)
+   --
+   --  Must be set to locally except for time literal, which is globally.
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   -- Only for Iir_Kind_Physical_Int_Literal:
+   --  The multiplicand.
+   --   Get/Set_Value (Int64)
+   --
+   -- Only for Iir_Kind_Physical_Fp_Literal:
+   --  The multiplicand.
+   --   Get/Set_Fp_Value (Fp64)
+
+   -- Iir_Kind_Simple_Aggregate (Short)
+   --  This node can only be generated by evaluation: it is an unidimentional
+   --  positional aggregate.
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --  List of elements
+   --   Get/Set_Simple_Aggregate_List (Field3)
+   --
+   --  Same as Type, but marked as property of that node.
+   --   Get/Set_Literal_Subtype (Field5)
+
+   -- Iir_Kind_Overflow_Literal (Short)
+   --  This node can only be generated by evaluation to represent an error: out
+   --  of range, division by zero...
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -------------
+   --  Tuples --
+   -------------
+
+   -- Iir_Kind_Association_Element_By_Expression (Short)
+   -- Iir_Kind_Association_Element_Open (Short)
+   -- Iir_Kind_Association_Element_By_Individual (Short)
+   -- Iir_Kind_Association_Element_Package (Short)
+   --  These are used for association element of an association list with
+   --  an interface (ie subprogram call, port map, generic map).
+   --
+   --   Get/Set_Formal (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   -- Only for Iir_Kind_Association_Element_By_Expression:
+   -- Only for Iir_Kind_Association_Element_Package:
+   --   Get/Set_Actual (Field3)
+   --
+   -- Only for Iir_Kind_Association_Element_By_Individual:
+   --   Get/Set_Actual_Type (Field3)
+   --
+   -- Only for Iir_Kind_Association_Element_By_Individual:
+   --   Get/Set_Individual_Association_Chain (Field4)
+   --
+   -- Only for Iir_Kind_Association_Element_Package:
+   --   Get/Set_Associated_Interface (Field4)
+   --
+   --  A function call or a type conversion for the association.
+   --  FIXME: should be a name ?
+   -- Only for Iir_Kind_Association_Element_By_Expression:
+   --   Get/Set_In_Conversion (Field4)
+   --
+   -- Only for Iir_Kind_Association_Element_By_Expression:
+   --   Get/Set_Out_Conversion (Field5)
+   --
+   --  Get/Set the whole association flag (true if the formal is associated in
+   --  whole and not individually, see LRM93 4.3.2.2)
+   --   Get/Set_Whole_Association_Flag (Flag1)
+   --
+   --   Get/Set_Collapse_Signal_Flag (Flag2)
+   --
+   -- Only for Iir_Kind_Association_Element_Open:
+   --   Get/Set_Artificial_Flag (Flag3)
+
+   -- Iir_Kind_Waveform_Element (Short)
+   --
+   --   Get/Set_We_Value (Field1)
+   --
+   --   Get/Set_Time (Field3)
+   --
+   --   Get/Set_Chain (Field2)
+
+   -- Iir_Kind_Conditional_Waveform (Short)
+   --
+   --   Get/Set_Condition (Field1)
+   --
+   --   Get/Set_Waveform_Chain (Field5)
+   --
+   --   Get/Set_Chain (Field2)
+
+   -- Iir_Kind_Choice_By_Others (Short)
+   -- Iir_Kind_Choice_By_None (Short)
+   -- Iir_Kind_Choice_By_Range (Short)
+   -- Iir_Kind_Choice_By_Name (Short)
+   -- Iir_Kind_Choice_By_Expression (Short)
+   --  (Iir_Kinds_Choice)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  For a list of choices, only the first one is associated, the following
+   --  associations have the same_alternative_flag set.
+   --   Get/Set_Chain (Field2)
+   --
+   --  These are elements of an choice chain, which is used for
+   --  case_statement, concurrent_select_signal_assignment, aggregates.
+   --
+   --  Get/Set what is associated with the choice.  There are two different
+   --  nodes, one for simple association and the other for chain association.
+   --  This simplifies walkers.  But both nodes are never used at the same
+   --  time.
+   --
+   --  For:
+   --  * an expression for an aggregate
+   --  * an individual association
+   --   Get/Set_Associated_Expr (Field3)
+   --
+   --  For
+   --  * a waveform_chain for a concurrent_select_signal_assignment,
+   --  * a sequential statement chain for a case_statement.
+   --   Get/Set_Associated_Chain (Field4)
+   --
+   -- Only for Iir_Kind_Choice_By_Name:
+   --   Get/Set_Choice_Name (Field5)
+   --
+   -- Only for Iir_Kind_Choice_By_Expression:
+   --   Get/Set_Choice_Expression (Field5)
+   --
+   -- Only for Iir_Kind_Choice_By_Range:
+   --   Get/Set_Choice_Range (Field5)
+   --
+   --   Get/Set_Same_Alternative_Flag (Flag1)
+   --
+   -- Only for Iir_Kind_Choice_By_Range:
+   -- Only for Iir_Kind_Choice_By_Expression:
+   --   Get/Set_Choice_Staticness (State2)
+
+   -- Iir_Kind_Entity_Aspect_Entity (Short)
+   --
+   --   Get/Set_Entity_Name (Field2)
+   --
+   --  parse: a simple name.
+   --  sem: an architecture declaration or NULL_IIR.
+   --   Get/Set_Architecture (Field3)
+
+   -- Iir_Kind_Entity_Aspect_Open (Short)
+
+   -- Iir_Kind_Entity_Aspect_Configuration (Short)
+   --
+   --   Get/Set_Configuration_Name (Field1)
+
+   -- Iir_Kind_Block_Configuration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Configuration_Item_Chain (Field3)
+   --
+   --  Note: for default block configurations of iterative generate statement,
+   --  the block specification is an indexed_name, whose index_list is others.
+   --   Get/Set_Block_Specification (Field5)
+   --
+   --  Single linked list of block configuration that apply to the same
+   --  for scheme generate block.
+   --   Get/Set_Prev_Block_Configuration (Field4)
+
+   -- Iir_Kind_Binding_Indication (Medium)
+   --
+   --   Get/Set_Default_Entity_Aspect (Field1)
+   --
+   --  The entity aspect.
+   --  It is a iir_kind_entity_aspect_entity, iir_kind_entity_aspect_open or
+   --  iir_kind_entity_aspect_configuration.  This may be transformed into a
+   --  declaration by semantic.
+   --   Get/Set_Entity_Aspect (Field3)
+   --
+   --   Get/Set_Default_Generic_Map_Aspect_Chain (Field6)
+   --
+   --   Get/Set_Default_Port_Map_Aspect_Chain (Field7)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Port_Map_Aspect_Chain (Field9)
+
+   -- Iir_Kind_Component_Configuration (Short)
+   -- Iir_Kind_Configuration_Specification (Short)
+   --
+   --  LRM08 7.3 Configuration specification
+   --
+   --  configuration_specification ::=
+   --     simple_configuration_specification
+   --   | compound_configuration_specification
+   --
+   --  simple_configuration_specification ::=
+   --     FOR component_specification binding_indication ;
+   --     [ END FOR ; ]
+   --
+   --  compound_configuration_specification ::=
+   --     FOR component_specification binding_indication ;
+   --        verification_unit_binding_indication ;
+   --        { verification_unit_binding_indication ; }
+   --     END FOR ;
+   --
+   --  component_specification ::=
+   --     instantiation_list : component_name
+   --
+   --  instantiation_list ::=
+   --     instantiation_label { , instantiation_label }
+   --   | OTHERS
+   --   | ALL
+   --
+   --  The declaration containing this type declaration.
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Component_Name (Field4)
+   --
+   --  Must be one of designator_list, designator_by_others or
+   --  designator_by_all.
+   --   Get/Set_Instantiation_List (Field1)
+   --
+   -- Only for Iir_Kind_Component_Configuration:
+   --   Get/Set_Block_Configuration (Field5)
+   --
+   --   Get/Set_Binding_Indication (Field3)
+   --
+   --   Get/Set_Chain (Field2)
+
+   -- Iir_Kind_Disconnection_Specification (Short)
+   --
+   --  LRM08 7.4 Disconnection specification
+   --
+   --  disconnection_specification ::=
+   --    DISCONNECT guarded_signal_specification AFTER time_expression ;
+   --
+   --  guarded_signal_specification ::=
+   --    guarded_signal_list : type_mark
+   --
+   --  signal_list ::=
+   --       signal_name { , signal_name }
+   --     | OTHERS
+   --     | ALL
+   --
+   --  The declaration containing this type declaration.
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Signal_List (Field3)
+   --
+   --   Get/Set_Type_Mark (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+
+   -- Iir_Kind_Block_Header (Medium)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Port_Chain (Field7)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Port_Map_Aspect_Chain (Field9)
+
+   -- Iir_Kind_Entity_Class (Short)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Entity_Class (Field3)
+
+   -- Iir_Kind_Attribute_Specification (Medium)
+   --
+   --  LRM08 7.2 Attribute specification
+   --
+   --  attribute_specification ::=
+   --     ATTRIBUTE attribute_designator OF entity_specification
+   --        IS expression ;
+   --
+   --  entity_specification ::= entity_name_list : entity_class
+   --
+   --  entity_name_list ::=
+   --       entity_designator { , entity_designator }
+   --     | OTHERS
+   --     | ALL
+   --
+   --  entity_designator ::= entity_tag [ signature ]
+   --
+   --  entity_tag ::= simple_name | character_literal | operator_symbol
+   --
+   --  LRM08 8.6 Attribute names
+   --
+   --  attribute_designator ::= /attribute/_simple_name
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Entity_Name_List (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Entity_Class (Field3)
+   --
+   --   Get/Set_Attribute_Value_Spec_Chain (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --  Always a simple name.
+   --   Get/Set_Attribute_Designator (Field6)
+   --
+   --   Get/Set_Attribute_Specification_Chain (Field7)
+
+   -- Iir_Kind_Attribute_Value (Short)
+   --  An attribute value is the element of the chain of attribute of an
+   --  entity, marking the entity as decorated by the attribute.
+   --  This node is built only by sem.
+   --  In fact, the node is member of the chain of attribute of an entity, and
+   --  of the chain of entity of the attribute specification.
+   --  This makes elaboration (and more precisely, expression evaluation)
+   --  easier.
+   --
+   --   Get/Set_Spec_Chain (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Designated_Entity (Field3)
+   --
+   --   Get/Set_Attribute_Specification (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Psl_Expression (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Psl_Expression (Field3)
+
+   -- Iir_Kind_Signature (Medium)
+   --
+   --  LRM08 4.5.3 Signatures
+   --
+   --  signature ::= '[' [ type_mark { , type_mark } ] [ RETURN type_mark ] ']'
+   --
+   --   Get/Set_Signature_Prefix (Field1)
+   --
+   --   Get/Set_Type_Marks_List (Field2)
+   --
+   --   Get/Set_Return_Type_Mark (Field8)
+
+   -- Iir_Kind_Overload_List (Short)
+   --
+   --   Get/Set_Overload_List (Field1)
+
+   -------------------
+   --  Declarations --
+   -------------------
+
+   -- Iir_Kind_Entity_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Concurrent_Statement_Chain (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Port_Chain (Field7)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+   --
+   --   Get/Set_Has_Begin (Flag10)
+
+   -- Iir_Kind_Architecture_Body (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --  Name of the entity declaration for the architecture.
+   --   Get/Set_Entity_Name (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Concurrent_Statement_Chain (Field5)
+   --
+   --  The default configuration created by canon.  This is a design unit.
+   --   Get/Set_Default_Configuration_Declaration (Field6)
+   --
+   --   Get/Set_Foreign_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Configuration_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --  Name of the entity of a configuration.
+   --   Get/Set_Entity_Name (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Block_Configuration (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Package_Header (Medium)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+
+   -- Iir_Kind_Package_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Package_Body (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Package_Header (Field5)
+   --
+   --   Get/Set_Need_Body (Flag1)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Package_Body (Short)
+   --  Note: a body is not a declaration, that's the reason why there is no
+   --  _declaration suffix in the name.
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --  The corresponding package declaration.
+   --   Get/Set_Package (Field4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Package_Instantiation_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --   Get/Set_Design_Unit (Alias Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Package_Body (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Uninstantiated_Package_Name (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Library_Declaration (Medium)
+   --
+   --  Design files in the library.
+   --   Get/Set_Design_File_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --  This node is used to contain all a library.  Only internaly used.
+   --  Name (identifier) of the library.
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Date (Field10)
+   --
+   --   Get/Set_Library_Directory (Field11)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Component_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Port_Chain (Field7)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Has_Is (Flag7)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   --  LRM08 6.6 Alias declarations
+   --
+   --  alias_declaration ::=
+   --     ALIAS alias_designator [ : subtype_indication ] IS
+   --        name [ signature ] ;
+   --
+   --  alias_designator ::= identifier | character_literal | operator_symbol
+   --
+   --  Object aliases and non-object aliases are represented by two different
+   --  nodes, as their semantic is different.  The parser only creates object
+   --  alias declaration nodes, but sem_decl replaces the node for non-object
+   --  alias declarations.
+
+   -- Iir_Kind_Object_Alias_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  The type can be deduced from the subtype indication, but this field is
+   --  present for uniformity (and speed).
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Name (Field4)
+   --
+   --  The subtype indication may not be present.
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_After_Drivers_Flag (Flag5)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+
+   -- Iir_Kind_Non_Object_Alias_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Name (Field4)
+   --
+   --   Get/Set_Alias_Signature (Field5)
+   --
+   --  Set when the alias was implicitely created (by Sem) because of an
+   --  explicit alias of a type.
+   --   Get/Set_Implicit_Alias_Flag (Flag1)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Anonymous_Type_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type_Definition (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --  Used for informative purpose only.
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Subtype_Definition (Field4)
+
+   -- Iir_Kind_Type_Declaration (Short)
+   --
+   --  LRM08 6.3 Type declarations
+   --
+   --  type_declaration ::=
+   --       full_type_declaration
+   --     | incomplete_type_declaration
+   --
+   --  full_type_declaration ::=
+   --     TYPE identifier IS type_definition ;
+   --
+   --  type_definition ::=
+   --       scalar_type_definition
+   --     | composite_type_definition
+   --     | access_type_definition
+   --     | file_type_definition
+   --     | protected_type_definition
+   --
+   --  LRM08 5.4.2 Incomplete type declarations
+   --
+   --  incomplete_type_declaration ::=
+   --       TYPE identifier ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  Definition of the type.
+   --  Note: the type definition can be a real type (unconstrained array,
+   --  enumeration, file, record, access) or a subtype (integer, floating
+   --  point).
+   --  The parser set this field to null_iir for an incomplete type
+   --  declaration.  This field is set to an incomplete_type_definition node
+   --  when first semantized.
+   --   Get/Set_Type_Definition (Field1)
+   --   Get/Set_Type (Alias Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Subtype_Declaration (Short)
+   --
+   --  LRM08 6.3 Subtype declarations
+   --
+   --  subtype_declaration ::=
+   --     SUBTYPE identifier IS subtype_indication ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+
+   -- Iir_Kind_Nature_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Nature (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Subnature_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Nature (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Interface_Signal_Declaration (Medium)
+   -- Iir_Kind_Interface_Constant_Declaration (Medium)
+   -- Iir_Kind_Interface_Variable_Declaration (Medium)
+   -- Iir_Kind_Interface_File_Declaration (Medium)
+   --
+   --  Get/Set the parent of an interface declaration.
+   --  The parent is an entity declaration, a subprogram specification, a
+   --  component declaration, a loop statement, a block declaration or ??
+   --  Useful to distinguish a port and an interface.
+   --   Get/Set_Parent (Field0)
+   --
+   --  The type can be deduced from the subtype indication, but this field is
+   --  present for uniformity (and speed).
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --  Must always be null_iir for iir_kind_interface_file_declaration.
+   --   Get/Set_Default_Value (Field6)
+   --
+   --   Get/Set_Mode (Odigit1)
+   --
+   --   Get/Set_Lexical_Layout (Odigit2)
+   --
+   -- Only for Iir_Kind_Interface_Signal_Declaration:
+   --   Get/Set_Has_Disconnect_Flag (Flag1)
+   --
+   -- Only for Iir_Kind_Interface_Signal_Declaration:
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   -- Only for Iir_Kind_Interface_Signal_Declaration:
+   --   Get/Set_Open_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_After_Drivers_Flag (Flag5)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   -- Only for Iir_Kind_Interface_Signal_Declaration:
+   --   Get/Set_Signal_Kind (State3)
+
+   -- Iir_Kind_Interface_Package_Declaration (Medium)
+   --
+   --  LRM08 6.5.5 Interface package declarations
+   --
+   --  interface_package_declaration ::=
+   --     PACKAGE identifier IS NEW /uninstantiated_package/_name
+   --        interface_package_generic_map_aspect
+   --
+   --  interface_package_generic_map_aspect ::=
+   --       generic_map_aspect
+   --     | GENERIC MAP ( <> )                  --  Represented by Null_Iir
+   --     | GENERIC MAP ( DEFAULT )             --  Not yet implemented
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Uninstantiated_Package_Name (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Function_Declaration (Medium)
+   -- Iir_Kind_Procedure_Declaration (Medium)
+   --
+   --  LRM08 4.2 Subprogram declarations
+   --
+   --  subprogram_declaration ::= subprogram_specification ;
+   --
+   --  subprogram_specification ::=
+   --     procedure_specification | function_specification
+   --
+   --  procedure_specification ::=
+   --     PROCEDURE designator
+   --        subprogram_header
+   --        [ [ PARAMETER ] ( formal_parameter_list ) ]
+   --
+   --  function_specification ::=
+   --     [ PURE | IMPURE ] FUNCTION designator
+   --        subprogram_header
+   --        [ [ PARAMETER ] ( formal_parameter_list ) ] return type_mark
+   --
+   --  designator ::= identifier | operator_symbol
+   --
+   --  operator_symbol ::= string_literal
+   --
+   --  Note: the subprogram specification of a body is kept, but should be
+   --  ignored if there is a subprogram declaration.  The function
+   --  Is_Second_Subprogram_Specification returns True on such specification.
+   --
+   --  The declaration containing this subrogram declaration.
+   --   Get/Set_Parent (Field0)
+   --
+   -- Only for Iir_Kind_Function_Declaration:
+   --   Get/Set_Return_Type (Field1)
+   --
+   -- Only for Iir_Kind_Function_Declaration:
+   --   Get/Set_Type (Alias Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Interface_Declaration_Chain (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   --Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Return_Type_Mark (Field8)
+   --
+   --   Get/Set_Subprogram_Body (Field9)
+   --
+   --   Get/Set_Subprogram_Depth (Field10)
+   --
+   --   Get/Set_Subprogram_Hash (Field11)
+   --
+   --   Get/Set_Overload_Number (Field12)
+   --
+   --   Get/Set_Seen_Flag (Flag1)
+   --
+   -- Only for Iir_Kind_Function_Declaration:
+   --   Get/Set_Pure_Flag (Flag2)
+   --
+   -- Only for Iir_Kind_Procedure_Declaration:
+   --   Get/Set_Passive_Flag (Flag2)
+   --
+   --   Get/Set_Foreign_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   -- Only for Iir_Kind_Function_Declaration:
+   --   Get/Set_Resolution_Function_Flag (Flag7)
+   --
+   -- Only for Iir_Kind_Function_Declaration:
+   --   Get/Set_Has_Pure (Flag8)
+   --
+   --  True is the specification is immediately followed by a body.
+   --   Get/Set_Has_Body (Flag9)
+   --
+   --   Get/Set_Wait_State (State1)
+   --
+   -- Only for Iir_Kind_Procedure_Declaration:
+   --   Get/Set_Purity_State (State2)
+   --
+   --   Get/Set_All_Sensitized_State (State3)
+
+   -- Iir_Kind_Function_Body (Medium)
+   -- Iir_Kind_Procedure_Body (Medium)
+   --
+   --  LRM08 4.3 Subprogram bodies
+   --
+   --  subprogram_body ::=
+   --     subprogram_specification IS
+   --        subprogram_declarative_part
+   --     BEGIN
+   --        subprogram_statement_part
+   --     END [ subprogram_kind ] [ designator ] ;
+   --
+   --  subprogram_kind ::= PROCEDURE | FUNCTION
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  The parse stage always puts a declaration before a body.
+   --  Sem will remove the declaration if there is a forward declaration.
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Impure_Depth (Field3)
+   --
+   --   Get/Set_Subprogram_Specification (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+   --
+   --   Get/Set_Callees_List (Field7)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Implicit_Procedure_Declaration (Medium)
+   -- Iir_Kind_Implicit_Function_Declaration (Medium)
+   --
+   --  This node contains a subprogram_declaration that was implicitly defined
+   --  just after a type declaration.
+   --  This declaration is inserted by sem.
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   -- Only for Iir_Kind_Implicit_Function_Declaration:
+   --   Get/Set_Return_Type (Field1)
+   --
+   -- Only for Iir_Kind_Implicit_Function_Declaration:
+   --   Get/Set_Type (Alias Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Interface_Declaration_Chain (Field5)
+   --
+   --   Get/Set_Generic_Chain (Field6)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Implicit_Definition (Field9)
+   --
+   --   Get/Set_Type_Reference (Field10)
+   --
+   --   Get/Set_Subprogram_Hash (Field11)
+   --
+   --   Get/Set_Overload_Number (Field12)
+   --
+   --   Get/Set_Wait_State (State1)
+   --
+   --   Get/Set_Seen_Flag (Flag1)
+   --
+   -- Only for Iir_Kind_Implicit_Function_Declaration:
+   --   Get/Set_Pure_Flag (Flag2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Signal_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Default_Value (Field6)
+   --
+   --  For a non-resolved signal: null_iir if the signal has no driver, or
+   --  a process/concurrent_statement for which the signal should have a
+   --  driver.  This is used to catch at analyse time unresolved signals with
+   --  several drivers.
+   --   Get/Set_Signal_Driver (Field7)
+   --
+   --   Get/Set_Has_Disconnect_Flag (Flag1)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+   --
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_After_Drivers_Flag (Flag5)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Signal_Kind (State3)
+
+   -- Iir_Kind_Guard_Signal_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Guard_Expression (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Guard_Sensitivity_List (Field6)
+   --
+   --   Get/Set_Block_Statement (Field7)
+   --
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Signal_Kind (State3)
+
+   -- Iir_Kind_Constant_Declaration (Medium)
+   -- Iir_Kind_Iterator_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --  For iterator, this is the reconstructed subtype indication.
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   -- Only for Iir_Kind_Iterator_Declaration:
+   --   Get/Set_Discrete_Range (Field6)
+   --
+   -- Only for Iir_Kind_Constant_Declaration:
+   --  Default value of a deferred constant points to the full constant
+   --  declaration.
+   --   Get/Set_Default_Value (Field6)
+   --
+   -- Only for Iir_Kind_Constant_Declaration:
+   --  Summary:
+   --  | constant C1 : integer;          -- Deferred declaration (in a package)
+   --  |  constant C2 : integer := 4;     -- Declaration
+   --  |  constant C1 : integer := 3;     -- Full declaration (in a body)
+   --  | NAME   Deferred_declaration  Deferred_declaration_flag
+   --  |  C1      Null_iir or C1' (*)     True
+   --  |  C2      Null_Iir                False
+   --  |  C1'     C1                      False
+   --  |(*): Deferred_declaration is Null_Iir as long as the full declaration
+   --  |   has not been analyzed.
+   --   Get/Set_Deferred_Declaration (Field7)
+   --
+   -- Only for Iir_Kind_Constant_Declaration:
+   --   Get/Set_Deferred_Declaration_Flag (Flag1)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Variable_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Default_Value (Field6)
+   --
+   --  True if the variable is a shared variable.
+   --   Get/Set_Shared_Flag (Flag2)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_File_Declaration (Medium)
+   --
+   --  LRM08 6.4.2.5 File declarations
+   --
+   --  file_declaration ::=
+   --     FILE identifier_list : subtype_indication [ file_open_information ] ;
+   --
+   --  file_open_information ::=
+   --     [ OPEN file_open_kind_expression ] IS file_logical_name
+   --
+   --  file_logical_name ::= string_expression
+   --
+   --  LRM87
+   --
+   --  file_declaration ::=
+   --     FILE identifier : subtype_indication IS [ mode ] file_logical_name ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_File_Logical_Name (Field6)
+   --
+   --  This is not used in vhdl 87.
+   --   Get/Set_File_Open_Kind (Field7)
+   --
+   --  This is used only in vhdl 87.
+   --   Get/Set_Mode (Odigit1)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Has_Mode (Flag8)
+
+   -- Iir_Kind_Element_Declaration (Short)
+   --
+   --  LRM08 5.3.3 Record types
+   --
+   --  element_declaration ::=
+   --     identifier_list : element_subtype_definition ;
+   --
+   --  identifier_list ::= identifier { , identifier }
+   --
+   --  element_subtype_definition ::= subtype_indication
+   --
+   --  The type can be deduced from the subtype indication, but this field is
+   --  present for uniformity (and speed).
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --  Return the position of the element in the record, starting from 0 for
+   --  the first record element, increasing by one for each successive element.
+   --   Get/Set_Element_Position (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Has_Identifier_List (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Ref (Flag7)
+
+   -- Iir_Kind_Record_Element_Constraint (Short)
+   --
+   --  Record subtype definition which defines this constraint.
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Element_Declaration (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --  Return the position of the element in the record, starting from 0 for
+   --  the first record element, increasing by one for each successive element.
+   --   Get/Set_Element_Position (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Attribute_Declaration (Short)
+   --
+   --  LRM08 6.7 Attribute declarations
+   --
+   --  attribute_declaration ::=
+   --     ATTRIBUTE identifier : type_mark ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Type_Mark (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Group_Template_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  List of entity class entry.
+   --  To handle `<>', the last element of the list can be an entity_class of
+   --  kind tok_box.
+   --   Get/Set_Entity_Class_Entry_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Group_Declaration (Short)
+   --
+   --  The declaration containing this type declaration.
+   --   Get/Set_Parent (Field0)
+   --
+   --  List of constituents.
+   --   Get/Set_Group_Constituent_List (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Group_Template_Name (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Psl_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Psl_Declaration (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --  Valid only for property declaration.
+   --   Get/Set_PSL_Clock (Field7)
+   --
+   --  Valid only for property declaration without parameters.
+   --   Get/Set_PSL_NFA (Field8)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Terminal_Declaration (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Nature (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+
+   -- Iir_Kind_Free_Quantity_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Default_Value (Field6)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Across_Quantity_Declaration (Medium)
+   -- Iir_Kind_Through_Quantity_Declaration (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Default_Value (Field6)
+   --
+   --   Get/Set_Tolerance (Field7)
+   --
+   --   Get/Set_Plus_Terminal (Field8)
+   --
+   --   Get/Set_Minus_Terminal (Field9)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Use_Flag (Flag6)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Use_Clause (Short)
+   --
+   --  LRM08 12.4 Use clauses
+   --
+   --  use_clause ::=
+   --     USE selected_name { , selected_name } ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Selected_Name (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Use_Clause_Chain (Field3)
+
+
+   -----------------------
+   --  type definitions --
+   -----------------------
+
+   --  For Iir_Kinds_Type_And_Subtype_Definition:
+   --
+   --  Type_Declarator:
+   --  Points to the type declaration or subtype declaration that has created
+   --  this definition. For some types, such as integer and floating point
+   --  types, both type and subtype points to the declaration.
+   --  However, there are cases where a type definition doesn't point to
+   --  a declarator: anonymous subtype created by index contraints, or
+   --  anonymous subtype created by an object declaration.
+   --  Note: a type definition cannot be anoynymous.
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --  The base type.
+   --  For a subtype, it returns the type.
+   --  For a type, it must return the type itself.
+   --   Get/Set_Base_Type (Field4)
+   --
+   --  The staticness of a type, according to LRM93 7.4.1.
+   --  Note: These types definition are always locally static:
+   --  enumeration, integer, floating.
+   --  However, their subtype are not necessary locally static.
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --  The resolved flag of a subtype, according to LRM93 2.4
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --  The signal_type flag of a type definition.
+   --  It is true when the type can be used for a signal.
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+
+   -- Iir_Kind_Enumeration_Type_Definition (Short)
+   --
+   --  Get the range of the type (This is just an ascending range from the
+   --  first literal to the last declared literal).
+   --   Get/Set_Range_Constraint (Field1)
+   --
+   --  Return the list of literals.  This list is created when the node is
+   --  created.
+   --   Get/Set_Enumeration_Literal_List (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Only_Characters_Flag (Flag4)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Enumeration_Literal (Medium)
+   --
+   --  Nota: two literals of the same type are equal iff their value is the
+   --  same; in other words, there may be severals literals with the same
+   --  value.
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --   Get/Set_Return_Type (Alias Field1)
+   --
+   --   Get/Set_Literal_Origin (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --  The declaration of the literal.  If LITERAL_ORIGIN is not set, then this
+   --  is the node itself, else this is the literal defined.
+   --   Get/Set_Enumeration_Decl (Field6)
+   --
+   --  The value of an enumeration literal is the position.
+   --   Get/Set_Enum_Pos (Field10)
+   --
+   --   Get/Set_Subprogram_Hash (Field11)
+   --
+   --   Get/Set_Seen_Flag (Flag1)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --  Never set to true, but possible when used as a prefix of an expanded
+   --  name in a overloaded subprogram.
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Physical_Type_Definition (Short)
+   --
+   --   Get/Set_Unit_Chain (Field1)
+   --   Get/Set_Primary_Unit (Alias Field1)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Unit_Declaration (Medium)
+   --
+   --  LRM08 5.2.4 Physical types
+   --
+   --  primary_unit_declaration ::= identifier ;
+   --
+   --  secondary_unit_declaration ::= identifier = physical_literal ;
+   --
+   --  physical_literal ::= [ abstract_literal ] /unit/_name
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --  The Physical_Literal is the expression that appear in the sources, so
+   --  this is Null_Iir for a primary unit.
+   --   Get/Set_Physical_Literal (Field6)
+   --
+   --  The value of the unit, computed from the primary unit.  This is always
+   --  a physical integer literal.
+   --   Get/Set_Physical_Unit_Value (Field7)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   --  LRM08 5.2 Scalar types
+   --
+   --  range_constraint ::= RANGE range
+   --
+   --  range ::=
+   --       range_attribute_name
+   --     | simple_expression direction simple_expression
+   --
+   --  direction ::= to | downto
+
+   -- Iir_Kind_Integer_Type_Definition (Short)
+   -- Iir_Kind_Floating_Type_Definition (Short)
+   --
+   --  The type declarator that has created this type.
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --  Type staticness is always locally.
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+
+   -- Iir_Kind_Array_Type_Definition (Medium)
+   --
+   --  LRM08 5.3.2 Array types / LRM93 3.2.1
+   --
+   --  unbounded_array_definition ::=
+   --     ARRAY ( index_subtype_definition { , index_subtype_definition } )
+   --       OF element_subtype_indication
+   --
+   --  index_subtype_definition ::= type_mark RANGE <>
+   --
+   --   Get/Set_Element_Subtype (Field1)
+   --
+   --   Get/Set_Element_Subtype_Indication (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --  This is a list of type marks.
+   --   Get/Set_Index_Subtype_Definition_List (Field6)
+   --
+   --  Same as the index_subtype_definition_list.
+   --   Get/Set_Index_Subtype_List (Field9)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Constraint_State (State2)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Index_Constraint_Flag (Flag4)
+
+   -- Iir_Kind_Record_Type_Definition (Short)
+   --
+   --  LRM08 5.3.3 Record types / LRM93 3.2.2 Record types
+   --
+   --  record_type_definition ::=
+   --     RECORD
+   --        element_declaration
+   --        { element_declaration }
+   --     END RECORD [ /record_type/_simple_name ]
+   --
+   --   Get/Set_Elements_Declaration_List (Field1)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Constraint_State (State2)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Access_Type_Definition (Short)
+   --
+   --  LRM08 5.4 Access types
+   --
+   --  access_type_definition ::= ACCESS subtype_indication
+   --
+   --   Get/Set_Designated_Type (Field1)
+   --
+   --   Get/Set_Designated_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_File_Type_Definition (Short)
+   --
+   --   Get/Set_File_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --  True if this is the std.textio.text file type, which may require special
+   --  handling.
+   --   Get/Set_Text_File_Flag (Flag4)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Incomplete_Type_Definition (Short)
+   --  Type definition for an incomplete type.  This is created during the
+   --  semantisation of the incomplete type declaration.
+   --
+   --   Get/Set_Incomplete_Type_List (Field2)
+   --
+   --  Set to the incomplete type declaration when semantized, and set to the
+   --  complete type declaration when the latter one is semantized.
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+
+   -- Iir_Kind_Protected_Type_Declaration (Short)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Protected_Type_Body (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Protected_Type_Body (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Protected_Type_Declaration (Field4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   --------------------------
+   --  subtype definitions --
+   --------------------------
+
+   --  LRM08 6.3 Subtype declarations
+   --
+   --  subtype_indication ::=
+   --    [ resolution_indication ] type_mark [ constraint ]
+   --
+   --  There is no uniq representation for a subtype indication.  If there is
+   --  only a type_mark, then a subtype indication is represented by a name
+   --  (a simple name or an expanded name); otherwise it is represented by one
+   --  of the subtype definition node.
+   --
+   --  resolution_indication ::=
+   --     resolution_function_name | ( element_resolution )
+   --
+   --  element_resolution ::= array_element_resolution | record_resolution
+   --
+   --  If there is no constraint but a resolution function name, the subtype
+   --  indication is represented by a subtype_definition (which will be
+   --  replaced by the correct subtype definition).  If there is an array
+   --  element resolution the subtype indication is represented by an array
+   --  subtype definition, and if there is a record resolution, it is
+   --  represented by a record subtype definition.
+   --
+   --  constraint ::=
+   --     range_constraint
+   --   | index_constraint
+   --   | array_constraint
+   --   | record_constraint
+   --
+   --  There is no node for constraint, it is directly represented by one of
+   --  the rhs.
+   --
+   --  element_constraint ::=
+   --     array_constraint
+   --   | record_constraint
+   --
+   --  Likewise, there is no node for element_constraint.
+   --
+   --  index_constraint ::= ( discrete_range { , discrete_range } )
+   --
+   --  An index_constraint is represented by an array_subtype_definition.
+   --
+   --  discrete_range ::= /discrete/_subtype_indication | range
+   --
+   --  array_constraint ::=
+   --     index_constraint [ array_element_constraint ]
+   --   | ( OPEN ) [ array_element_constraint ]
+   --
+   --  An array_constraint is also represented by an array_subtype_definition.
+   --
+   --  array_element_constraint ::= element_constraint
+   --
+   --  There is no node for array_element_constraint.
+   --
+   --  record_constraint ::=
+   --     ( record_element_constraint { , record_element_constraint } )
+   --
+   --  A record_constraint is represented by a record_subtype_definition.
+   --
+   --  record_element_constraint ::=
+   --     record_element_simple_name element_constraint
+   --
+   --  Represented by Record_Element_Constraint.
+
+   -- Iir_Kind_Enumeration_Subtype_Definition (Short)
+   -- Iir_Kind_Integer_Subtype_Definition (Short)
+   -- Iir_Kind_Physical_Subtype_Definition (Short)
+   --
+   --   Get/Set_Range_Constraint (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Floating_Subtype_Definition (Medium)
+   --
+   --   Get/Set_Range_Constraint (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+   --
+   --   Get/Set_Tolerance (Field7)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Type_Staticness (State1)
+
+   -- Iir_Kind_Access_Subtype_Definition (Short)
+   --
+   --   Get/Set_Designated_Type (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Designated_Subtype_Indication (Field5)
+   --
+   --  Note: no resolution function for access subtype.
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+
+   -- Iir_Kind_Array_Element_Resolution (Short)
+   --
+   --  LRM08 6.3 Subtype declarations
+   --
+   --  array_element_resolution ::= resolution_indication
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+
+   -- Iir_Kind_Record_Resolution (Short)
+   --
+   --  LRM08 6.3 Subtype declarations
+   --
+   --  record_resolution ::=
+   --     record_element_resolution { , record_element_resolution }
+   --
+   --   Get/Set_Record_Element_Resolution_Chain (Field1)
+
+   -- Iir_Kind_Record_Element_Resolution (Short)
+   --
+   --  LRM08 6.3 Subtype declarations
+   --
+   --  record_element_resolution ::=
+   --     /record_element/_simple_name resolution_indication
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+
+   -- Iir_Kind_Record_Subtype_Definition (Medium)
+   --
+   --   Get/Set_Elements_Declaration_List (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+   --
+   --   Get/Set_Tolerance (Field7)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Constraint_State (State2)
+
+   -- Iir_Kind_Array_Subtype_Definition (Medium)
+   --
+   --   Get/Set_Element_Subtype (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+   --
+   --  The index_constraint list as it appears in the subtype indication (if
+   --  present). This is a list of subtype indication.
+   --   Get/Set_Index_Constraint_List (Field6)
+   --
+   --   Get/Set_Tolerance (Field7)
+   --
+   --   Get/Set_Array_Element_Constraint (Field8)
+   --
+   --  The type of the index.  This is either the index_constraint list or the
+   --  index subtypes of the type_mark.
+   --   Get/Set_Index_Subtype_List (Field9)
+   --
+   --   Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Constraint_State (State2)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+   --
+   --   Get/Set_Index_Constraint_Flag (Flag4)
+
+   -- Iir_Kind_Range_Expression (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Left_Limit (Field2)
+   --
+   --   Get/Set_Right_Limit (Field3)
+   --
+   --   Get/Set_Range_Origin (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Direction (State2)
+
+   -- Iir_Kind_Subtype_Definition (Medium)
+   --  Such a node is only created by parse and transformed into the correct
+   --  kind (enumeration_subtype, integer_subtype...) by sem.
+   --
+   --   Get/Set_Range_Constraint (Field1)
+   --
+   --   Get/Set_Subtype_Type_Mark (Field2)
+   --
+   --   Get/Set_Resolution_Indication (Field5)
+   --
+   --   Get/Set_Tolerance (Field7)
+
+   -------------------------
+   --  Nature definitions --
+   -------------------------
+
+   -- Iir_Kind_Scalar_Nature_Definition (Medium)
+   --
+   --   Get/Set_Reference (Field2)
+   --
+   --  The declarator that has created this nature type.
+   --   Get/Set_Nature_Declarator (Field3)
+   --
+   --  C--  Get/Set_Base_Type (Field4)
+   --
+   --  Type staticness is always locally.
+   --  C--  Get/Set_Type_Staticness (State1)
+   --
+   --   Get/Set_Across_Type (Field7)
+   --
+   --   Get/Set_Through_Type (Field8)
+
+   ----------------------------
+   --  concurrent statements --
+   ----------------------------
+
+   -- Iir_Kind_Concurrent_Conditional_Signal_Assignment (Medium)
+   -- Iir_Kind_Concurrent_Selected_Signal_Assignment (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Target (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment:
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Reject_Time_Expression (Field6)
+   --
+   -- Only for Iir_Kind_Concurrent_Conditional_Signal_Assignment:
+   --   Get/Set_Conditional_Waveform_Chain (Field7)
+   --
+   -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment:
+   --   Get/Set_Selected_Waveform_Chain (Field7)
+   --
+   --  If the assignment is guarded, then get_guard must return the
+   --  declaration of the signal guard, otherwise, null_iir.
+   --  If the guard signal decl is not known, as a kludge and only to mark this
+   --  assignment guarded, the guard can be this assignment.
+   --   Get/Set_Guard (Field8)
+   --
+   --   Get/Set_Delay_Mechanism (Field12)
+   --
+   --   Get/Set_Postponed_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --  True if the target of the assignment is guarded
+   --   Get/Set_Guarded_Target_State (State3)
+
+   -- Iir_Kind_Sensitized_Process_Statement (Medium)
+   -- Iir_Kind_Process_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+   --
+   -- Only for Iir_Kind_Sensitized_Process_Statement:
+   --   Get/Set_Sensitivity_List (Field6)
+   --
+   --   Get/Set_Callees_List (Field7)
+   --
+   --  The concurrent statement at the origin of that process.  This is
+   --  Null_Iir for a user process.
+   --   Get/Set_Process_Origin (Field8)
+   --
+   --   Get/Set_Wait_State (State1)
+   --
+   --   Get/Set_Seen_Flag (Flag1)
+   --
+   --   Get/Set_Passive_Flag (Flag2)
+   --
+   --   Get/Set_Postponed_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_Has_Is (Flag7)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+   --
+   --   Get/Set_End_Has_Postponed (Flag10)
+
+   -- Iir_Kind_Concurrent_Assertion_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Assertion_Condition (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Severity_Expression (Field5)
+   --
+   --   Get/Set_Report_Expression (Field6)
+   --
+   --   Get/Set_Postponed_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Psl_Default_Clock (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Psl_Boolean (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+
+   -- Iir_Kind_Psl_Assert_Statement (Medium)
+   -- Iir_Kind_Psl_Cover_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Psl_Property (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Severity_Expression (Field5)
+   --
+   --   Get/Set_Report_Expression (Field6)
+   --
+   --   Get/Set_PSL_Clock (Field7)
+   --
+   --   Get/Set_PSL_NFA (Field8)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Component_Instantiation_Statement (Medium)
+   --
+   --  LRM08 11.7 Component instantiation statements
+   --
+   --  component_instantiation_statement ::=
+   --     instantiation_label :
+   --        instantiated_unit
+   --           [ generic_map_aspect ]
+   --           [ port_map_aspect ] ;
+   --
+   --  instantiated_unit ::=
+   --       [ COMPONENT ] component_name
+   --     | ENTITY entity_name [ ( architecture_identifier ) ]
+   --     | CONFIGURATION configuration_name
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  Unit instantiated.  This is a name, an entity_aspect_entity or an
+   --  entity_aspect_configuration.
+   --   Get/Set_Instantiated_Unit (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Default_Binding_Indication (Field5)
+   --
+   --   Get/Set_Generic_Map_Aspect_Chain (Field8)
+   --
+   --   Get/Set_Port_Map_Aspect_Chain (Field9)
+   --
+   --  Configuration:
+   --  In case of a configuration specification, the node is put into
+   --  default configuration.  In the absence of a specification, the
+   --  default entity aspect, if any; if none, this field is null_iir.
+   --   Get/Set_Configuration_Specification (Field7)
+   --
+   --  During Sem and elaboration, the configuration field can be filled by
+   --  a component configuration declaration.
+   --
+   --  Configuration for this component.
+   --  FIXME: must be get/set_binding_indication.
+   --   Get/Set_Component_Configuration (Field6)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Block_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Concurrent_Statement_Chain (Field5)
+   --
+   --   Get/Set_Block_Block_Configuration (Field6)
+   --
+   --   Get/Set_Block_Header (Field7)
+   --
+   --  get/set_guard_decl is used for semantic analysis, in order to add
+   --  a signal declaration.
+   --   Get/Set_Guard_Decl (Field8)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Generate_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Declaration_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Concurrent_Statement_Chain (Field5)
+   --
+   --  The generation scheme.
+   --  A (boolean) expression for a conditionnal elaboration (if).
+   --  A (iterator) declaration for an iterative elaboration (for).
+   --   Get/Set_Generation_Scheme (Field6)
+   --
+   --  The block configuration for this statement.
+   --   Get/Set_Generate_Block_Configuration (Field7)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+   --
+   --   Get/Set_Has_Begin (Flag10)
+
+   -- Iir_Kind_Simple_Simultaneous_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Simultaneous_Left (Field5)
+   --
+   --   Get/Set_Simultaneous_Right (Field6)
+   --
+   --   Get/Set_Tolerance (Field7)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   ----------------------------
+   --  sequential statements --
+   ----------------------------
+
+   -- Iir_Kind_If_Statement (Medium)
+   -- Iir_Kind_Elsif (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  May be NULL only for an iir_kind_elsif node, and then means the else
+   --  clause.
+   --   Get/Set_Condition (Field1)
+   --
+   -- Only for Iir_Kind_If_Statement:
+   --   Get/Set_Chain (Field2)
+   --
+   -- Only for Iir_Kind_If_Statement:
+   --   Get/Set_Label (Field3)
+   --
+   -- Only for Iir_Kind_If_Statement:
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   -- Only for Iir_Kind_If_Statement:
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+   --
+   --  Must be an Iir_kind_elsif node, or NULL for no more elsif clauses.
+   --   Get/Set_Else_Clause (Field6)
+   --
+   -- Only for Iir_Kind_If_Statement:
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   --  LRM08 10.10 Loop statement / LRM93 8.9
+   --
+   --  loop_statement ::=
+   --     [ loop_label : ]
+   --        [ iteration_scheme ] LOOP
+   --           sequence_of_statements
+   --        END LOOP [ loop_label ] ;
+   --
+   --  iteration_scheme ::=
+   --       WHILE condition
+   --     | FOR loop_parameter_specification
+   --
+   --  parameter_specification ::=
+   --     identifier IN discrete_range
+
+   -- Iir_Kind_For_Loop_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  The parameters specification is represented by an Iterator_Declaration.
+   --   Get/Set_Parameter_Specification (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_While_Loop_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Condition (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Sequential_Statement_Chain (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Exit_Statement (Short)
+   -- Iir_Kind_Next_Statement (Short)
+   --
+   --  LRM08 10.11 Next statement
+   --
+   --  next_statement ::=
+   --     [ label : ] NEXT [ loop_label ] [ WHEN condition ] ;
+   --
+   --  LRM08 10.12 Exit statement
+   --
+   --  exit_statement ::=
+   --     [ label : ] exit [ loop_label ] [ when condition ] ;
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Condition (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Loop_Label (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Signal_Assignment_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Target (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --  The waveform.
+   --  If the waveform_chain is null_iir, then the signal assignment is a
+   --  disconnection statement, ie TARGET <= null_iir after disconection_time,
+   --  where disconnection_time is specified by a disconnection specification.
+   --   Get/Set_Waveform_Chain (Field5)
+   --
+   --   Get/Set_Reject_Time_Expression (Field6)
+   --
+   --   Get/Set_Delay_Mechanism (Field12)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --  True if the target of the assignment is guarded
+   --   Get/Set_Guarded_Target_State (State3)
+
+   -- Iir_Kind_Variable_Assignment_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Target (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Assertion_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Assertion_Condition (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Severity_Expression (Field5)
+   --
+   --   Get/Set_Report_Expression (Field6)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Report_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Severity_Expression (Field5)
+   --
+   --   Get/Set_Report_Expression (Field6)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Wait_Statement (Medium)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Timeout_Clause (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Condition_Clause (Field5)
+   --
+   --   Get/Set_Sensitivity_List (Field6)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Return_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  Type of the return value of the function.  This is a copy of
+   --  return_type.
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Case_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  Chain is compose of Iir_Kind_Choice_By_XXX.
+   --   Get/Set_Case_Statement_Alternative_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
+   -- Iir_Kind_Procedure_Call_Statement (Short)
+   -- Iir_Kind_Concurrent_Procedure_Call_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Procedure_Call (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   -- Only for Iir_Kind_Concurrent_Procedure_Call_Statement:
+   --   Get/Set_Postponed_Flag (Flag3)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   -- Iir_Kind_Procedure_Call (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Parameter_Association_Chain (Field2)
+   --
+   --  Procedure declaration corresponding to the procedure to call.
+   --   Get/Set_Implementation (Field3)
+   --
+   --   Get/Set_Method_Object (Field4)
+
+   -- Iir_Kind_Null_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Attribute_Value_Chain (Field4)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+
+   ----------------
+   --  operators --
+   ----------------
+
+   -- Iir_Kinds_Monadic_Operator (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Operand (Field2)
+   --
+   --  Function declaration corresponding to the function to call.
+   --   Get/Set_Implementation (Field3)
+   --
+   --  Expr_staticness is defined by §7.4
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kinds_Dyadic_Operator (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  Left and Right operands.
+   --   Get/Set_Left (Field2)
+   --
+   --  Function declaration corresponding to the function to call.
+   --   Get/Set_Implementation (Field3)
+   --
+   --   Get/Set_Right (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Function_Call (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Parameter_Association_Chain (Field2)
+   --
+   --  Function declaration corresponding to the function to call.
+   --   Get/Set_Implementation (Field3)
+   --
+   --   Get/Set_Method_Object (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Aggregate (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Aggregate_Info (Field2)
+   --
+   --   Get/Set_Association_Choices_Chain (Field4)
+   --
+   --  Same as Type, but marked as property of that node.
+   --   Get/Set_Literal_Subtype (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Value_Staticness (State2)
+
+   -- Iir_Kind_Aggregate_Info (Short)
+   --
+   --  Get info for the next dimension.  NULL_IIR terminated.
+   --   Get/Set_Sub_Aggregate_Info (Field1)
+   --
+   --  For array aggregate only:
+   --  If TRUE, the choices are not locally static.
+   --  This flag is only valid when the array aggregate is constrained, ie
+   --  has no 'others' choice.
+   --   Get/Set_Aggr_Dynamic_Flag (Flag3)
+   --
+   --  If TRUE, the aggregate is named, else it is positionnal.
+   --   Get/Set_Aggr_Named_Flag (Flag4)
+   --
+   --  The following three fields are used to check bounds of an array
+   --  aggregate.
+   --  For named aggregate, low and high bounds are computed, for positionnal
+   --  aggregate, the (minimum) number of elements is computed.
+   --  Note there may be elements beyond the bounds, due to other choice.
+   --  These fields may apply for the aggregate or for the aggregate and its
+   --  brothers if the node is for a sub-aggregate.
+   --
+   --  The low and high index choice, if any.
+   --   Get/Set_Aggr_Low_Limit (Field2)
+   --
+   --   Get/Set_Aggr_High_Limit (Field3)
+   --
+   --  The minimum number of elements, if any.  This is a minimax.
+   --   Get/Set_Aggr_Min_Length (Field4)
+   --
+   --  True if the choice list has an 'others' choice.
+   --   Get/Set_Aggr_Others_Flag (Flag2)
+
+   -- Iir_Kind_Parenthesis_Expression (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Qualified_Expression (Short)
+   --
+   --  LRM08 9.3.5 Qualified expressions
+   --
+   --  qualified_expression ::=
+   --       type_mark ' ( expression )
+   --     | type_mark ' aggregate
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Type_Mark (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Type_Conversion (Short)
+   --
+   --  LRM08 9.3.6 Type conversions
+   --
+   --  type_conversion ::= type_mark ( expression )
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  If the type mark denotes an unconstrained array and the expression is
+   --  locally static, the result should be locally static according to vhdl93
+   --  (which is not clear on that point).  As a subtype is created, it is
+   --  referenced by this field.
+   --   Get/Set_Type_Conversion_Subtype (Field3)
+   --
+   --   Get/Set_Type_Mark (Field4)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Allocator_By_Expression (Short)
+   -- Iir_Kind_Allocator_By_Subtype (Short)
+   --
+   --  LRM08 9.3.7 Allocators
+   --
+   --  allocator ::=
+   --     NEW subtype_indication
+   --   | NEW qualified_expression
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --  To ease analysis: set to the designated type (either the type of the
+   --  expression or the subtype)
+   --   Get/Set_Allocator_Designated_Type (Field2)
+   --
+   -- Only for Iir_Kind_Allocator_By_Expression:
+   --  Contains the expression for a by expression allocator.
+   --   Get/Set_Expression (Field5)
+   --
+   -- Only for Iir_Kind_Allocator_By_Subtype:
+   --  Contains the subtype indication for a by subtype allocator.
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   ------------
+   --  Names --
+   ------------
+
+   -- Iir_Kind_Simple_Name (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Alias_Declaration (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Character_Literal (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Alias_Declaration (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Operator_Symbol (Short)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Alias_Declaration (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+
+   -- Iir_Kind_Selected_Name (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Alias_Declaration (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Selected_By_All_Name (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+
+   -- Iir_Kind_Indexed_Name (Short)
+   --  Select the element designed with the INDEX_LIST from array PREFIX.
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Index_List (Field2)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Slice_Name (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Suffix (Field2)
+   --
+   --   Get/Set_Slice_Subtype (Field3)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Parenthesis_Name (Short)
+   --  Created by the parser, and mutated into the correct iir node: it can be
+   --  either a function call, an indexed array, a type conversion or a slice
+   --  name.
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --  Always returns null_iir.
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Association_Chain (Field2)
+   --
+   --   Get/Set_Named_Entity (Field4)
+
+   -- Iir_Kind_Selected_Element (Short)
+   --  A record element selection.  This corresponds to a reffined selected
+   --  names.  The production doesn't exist in the VHDL grammar.
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Selected_Element (Field2)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Implicit_Dereference (Short)
+   -- Iir_Kind_Dereference (Short)
+   --  An implicit access dereference.
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -----------------
+   --  Attributes --
+   -----------------
+
+   -- Iir_Kind_Attribute_Name (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Attribute_Signature (Field2)
+   --
+   --   Get/Set_Identifier (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Base_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+
+   -- Iir_Kind_Left_Type_Attribute (Short)
+   -- Iir_Kind_Right_Type_Attribute (Short)
+   -- Iir_Kind_High_Type_Attribute (Short)
+   -- Iir_Kind_Low_Type_Attribute (Short)
+   -- Iir_Kind_Ascending_Type_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Range_Array_Attribute (Short)
+   -- Iir_Kind_Reverse_Range_Array_Attribute (Short)
+   -- Iir_Kind_Left_Array_Attribute (Short)
+   -- Iir_Kind_Right_Array_Attribute (Short)
+   -- Iir_Kind_High_Array_Attribute (Short)
+   -- Iir_Kind_Low_Array_Attribute (Short)
+   -- Iir_Kind_Ascending_Array_Attribute (Short)
+   -- Iir_Kind_Length_Array_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Index_Subtype (Field2)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Stable_Attribute (Short)
+   -- Iir_Kind_Delayed_Attribute (Short)
+   -- Iir_Kind_Quiet_Attribute (Short)
+   -- Iir_Kind_Transaction_Attribute (Short)
+   --  (Iir_Kinds_Signal_Attribute)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --  Not used by Iir_Kind_Transaction_Attribute
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Has_Active_Flag (Flag2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Event_Attribute (Short)
+   -- Iir_Kind_Last_Event_Attribute (Short)
+   -- Iir_Kind_Last_Value_Attribute (Short)
+   -- Iir_Kind_Active_Attribute (Short)
+   -- Iir_Kind_Last_Active_Attribute (Short)
+   -- Iir_Kind_Driving_Attribute (Short)
+   -- Iir_Kind_Driving_Value_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Pos_Attribute (Short)
+   -- Iir_Kind_Val_Attribute (Short)
+   -- Iir_Kind_Succ_Attribute (Short)
+   -- Iir_Kind_Pred_Attribute (Short)
+   -- Iir_Kind_Leftof_Attribute (Short)
+   -- Iir_Kind_Rightof_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Image_Attribute (Short)
+   -- Iir_Kind_Value_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Parameter (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Simple_Name_Attribute (Short)
+   -- Iir_Kind_Instance_Name_Attribute (Short)
+   -- Iir_Kind_Path_Name_Attribute (Short)
+   --
+   --   Get/Set_Prefix (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   -- Only for Iir_Kind_Simple_Name_Attribute:
+   --   Get/Set_Simple_Name_Identifier (Field3)
+   --
+   -- Only for Iir_Kind_Simple_Name_Attribute:
+   --   Get/Set_Simple_Name_Subtype (Field4)
+   --
+   --   Get/Set_Base_Name (Field5)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
+   -- Iir_Kind_Behavior_Attribute (Short)
+   -- Iir_Kind_Structure_Attribute (Short)
+   --  FIXME: to describe (Short)
+
+   -- Iir_Kind_Error (Short)
+   --  Can be used instead of an expression or a type.
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Error_Origin (Field2)
+   --
+   --   Get/Set_Type_Declarator (Field3)
+   --
+   --   Get/Set_Base_Type (Field4)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Type_Staticness (Alias State1)
+   --
+   --   Get/Set_Resolved_Flag (Flag1)
+   --
+   --   Get/Set_Signal_Type_Flag (Flag2)
+   --
+   --   Get/Set_Has_Signal_Flag (Flag3)
+
+   -- Iir_Kind_Unused (Short)
+
+   -- End of Iir_Kind.
+
+
+   type Iir_Kind is
+      (
+       Iir_Kind_Unused,
+       Iir_Kind_Error,
+
+       Iir_Kind_Design_File,
+       Iir_Kind_Design_Unit,
+       Iir_Kind_Library_Clause,
+       Iir_Kind_Use_Clause,
+
+   -- Literals.
+       Iir_Kind_Integer_Literal,
+       Iir_Kind_Floating_Point_Literal,
+       Iir_Kind_Null_Literal,
+       Iir_Kind_String_Literal,
+       Iir_Kind_Physical_Int_Literal,
+       Iir_Kind_Physical_Fp_Literal,
+       Iir_Kind_Bit_String_Literal,
+       Iir_Kind_Simple_Aggregate,
+       Iir_Kind_Overflow_Literal,
+
+   -- Tuple,
+       Iir_Kind_Waveform_Element,
+       Iir_Kind_Conditional_Waveform,
+       Iir_Kind_Association_Element_By_Expression,
+       Iir_Kind_Association_Element_By_Individual,
+       Iir_Kind_Association_Element_Open,
+       Iir_Kind_Association_Element_Package,
+       Iir_Kind_Choice_By_Others,
+       Iir_Kind_Choice_By_Expression,
+       Iir_Kind_Choice_By_Range,
+       Iir_Kind_Choice_By_None,
+       Iir_Kind_Choice_By_Name,
+       Iir_Kind_Entity_Aspect_Entity,
+       Iir_Kind_Entity_Aspect_Configuration,
+       Iir_Kind_Entity_Aspect_Open,
+       Iir_Kind_Block_Configuration,
+       Iir_Kind_Block_Header,
+       Iir_Kind_Component_Configuration,
+       Iir_Kind_Binding_Indication,
+       Iir_Kind_Entity_Class,
+       Iir_Kind_Attribute_Value,
+       Iir_Kind_Signature,
+       Iir_Kind_Aggregate_Info,
+       Iir_Kind_Procedure_Call,
+       Iir_Kind_Record_Element_Constraint,
+       Iir_Kind_Array_Element_Resolution,
+       Iir_Kind_Record_Resolution,
+       Iir_Kind_Record_Element_Resolution,
+
+       Iir_Kind_Attribute_Specification,
+       Iir_Kind_Disconnection_Specification,
+       Iir_Kind_Configuration_Specification,
+
+   -- Type definitions.
+   -- iir_kinds_type_and_subtype_definition
+   -- kinds: disc: discrete, st: subtype.
+       Iir_Kind_Access_Type_Definition,
+       Iir_Kind_Incomplete_Type_Definition,
+       Iir_Kind_File_Type_Definition,
+       Iir_Kind_Protected_Type_Declaration,
+       Iir_Kind_Record_Type_Definition,           -- composite
+       Iir_Kind_Array_Type_Definition,            -- composite, array
+       Iir_Kind_Array_Subtype_Definition,         -- composite, array, st
+       Iir_Kind_Record_Subtype_Definition,        -- composite, st
+       Iir_Kind_Access_Subtype_Definition,        -- st
+       Iir_Kind_Physical_Subtype_Definition,      -- scalar, st, rng
+       Iir_Kind_Floating_Subtype_Definition,      -- scalar, st, rng
+       Iir_Kind_Integer_Subtype_Definition,       -- scalar, disc, st, rng
+       Iir_Kind_Enumeration_Subtype_Definition,   -- scalar, disc, st, rng
+       Iir_Kind_Enumeration_Type_Definition,      -- scalar, disc, rng
+       Iir_Kind_Integer_Type_Definition,          -- scalar, disc
+       Iir_Kind_Floating_Type_Definition,         -- scalar
+       Iir_Kind_Physical_Type_Definition,         -- scalar
+       Iir_Kind_Range_Expression,
+       Iir_Kind_Protected_Type_Body,
+       Iir_Kind_Subtype_Definition,  -- temporary (must not appear after sem).
+
+   -- Nature definition
+       Iir_Kind_Scalar_Nature_Definition,
+
+   -- Lists.
+       Iir_Kind_Overload_List,  -- used internally by sem_expr.
+
+   -- Declarations.
+       Iir_Kind_Type_Declaration,
+       Iir_Kind_Anonymous_Type_Declaration,
+       Iir_Kind_Subtype_Declaration,
+       Iir_Kind_Nature_Declaration,
+       Iir_Kind_Subnature_Declaration,
+       Iir_Kind_Package_Declaration,
+       Iir_Kind_Package_Instantiation_Declaration,
+       Iir_Kind_Package_Body,
+       Iir_Kind_Configuration_Declaration,
+       Iir_Kind_Entity_Declaration,
+       Iir_Kind_Architecture_Body,
+       Iir_Kind_Package_Header,
+       Iir_Kind_Unit_Declaration,
+       Iir_Kind_Library_Declaration,
+       Iir_Kind_Component_Declaration,
+       Iir_Kind_Attribute_Declaration,
+       Iir_Kind_Group_Template_Declaration,
+       Iir_Kind_Group_Declaration,
+       Iir_Kind_Element_Declaration,
+       Iir_Kind_Non_Object_Alias_Declaration,
+
+       Iir_Kind_Psl_Declaration,
+       Iir_Kind_Terminal_Declaration,
+       Iir_Kind_Free_Quantity_Declaration,
+       Iir_Kind_Across_Quantity_Declaration,
+       Iir_Kind_Through_Quantity_Declaration,
+
+       Iir_Kind_Enumeration_Literal,
+       Iir_Kind_Function_Declaration,            --  Subprg, Func
+       Iir_Kind_Implicit_Function_Declaration,   --  Subprg, Func, Imp_Subprg
+       Iir_Kind_Implicit_Procedure_Declaration,  --  Subprg, Proc, Imp_Subprg
+       Iir_Kind_Procedure_Declaration,           --  Subprg, Proc
+       Iir_Kind_Function_Body,
+       Iir_Kind_Procedure_Body,
+
+       Iir_Kind_Object_Alias_Declaration,       -- object
+       Iir_Kind_File_Declaration,               -- object
+       Iir_Kind_Guard_Signal_Declaration,       -- object
+       Iir_Kind_Signal_Declaration,             -- object
+       Iir_Kind_Variable_Declaration,           -- object
+       Iir_Kind_Constant_Declaration,           -- object
+       Iir_Kind_Iterator_Declaration,           -- object
+       Iir_Kind_Interface_Constant_Declaration, -- object, interface
+       Iir_Kind_Interface_Variable_Declaration, -- object, interface
+       Iir_Kind_Interface_Signal_Declaration,   -- object, interface
+       Iir_Kind_Interface_File_Declaration,     -- object, interface
+       Iir_Kind_Interface_Package_Declaration,
+
+   -- Expressions.
+       Iir_Kind_Identity_Operator,
+       Iir_Kind_Negation_Operator,
+       Iir_Kind_Absolute_Operator,
+       Iir_Kind_Not_Operator,
+       Iir_Kind_Condition_Operator,
+       Iir_Kind_Reduction_And_Operator,
+       Iir_Kind_Reduction_Or_Operator,
+       Iir_Kind_Reduction_Nand_Operator,
+       Iir_Kind_Reduction_Nor_Operator,
+       Iir_Kind_Reduction_Xor_Operator,
+       Iir_Kind_Reduction_Xnor_Operator,
+       Iir_Kind_And_Operator,
+       Iir_Kind_Or_Operator,
+       Iir_Kind_Nand_Operator,
+       Iir_Kind_Nor_Operator,
+       Iir_Kind_Xor_Operator,
+       Iir_Kind_Xnor_Operator,
+       Iir_Kind_Equality_Operator,
+       Iir_Kind_Inequality_Operator,
+       Iir_Kind_Less_Than_Operator,
+       Iir_Kind_Less_Than_Or_Equal_Operator,
+       Iir_Kind_Greater_Than_Operator,
+       Iir_Kind_Greater_Than_Or_Equal_Operator,
+       Iir_Kind_Match_Equality_Operator,
+       Iir_Kind_Match_Inequality_Operator,
+       Iir_Kind_Match_Less_Than_Operator,
+       Iir_Kind_Match_Less_Than_Or_Equal_Operator,
+       Iir_Kind_Match_Greater_Than_Operator,
+       Iir_Kind_Match_Greater_Than_Or_Equal_Operator,
+       Iir_Kind_Sll_Operator,
+       Iir_Kind_Sla_Operator,
+       Iir_Kind_Srl_Operator,
+       Iir_Kind_Sra_Operator,
+       Iir_Kind_Rol_Operator,
+       Iir_Kind_Ror_Operator,
+       Iir_Kind_Addition_Operator,
+       Iir_Kind_Substraction_Operator,
+       Iir_Kind_Concatenation_Operator,
+       Iir_Kind_Multiplication_Operator,
+       Iir_Kind_Division_Operator,
+       Iir_Kind_Modulus_Operator,
+       Iir_Kind_Remainder_Operator,
+       Iir_Kind_Exponentiation_Operator,
+       Iir_Kind_Function_Call,
+       Iir_Kind_Aggregate,
+       Iir_Kind_Parenthesis_Expression,
+       Iir_Kind_Qualified_Expression,
+       Iir_Kind_Type_Conversion,
+       Iir_Kind_Allocator_By_Expression,
+       Iir_Kind_Allocator_By_Subtype,
+       Iir_Kind_Selected_Element,
+       Iir_Kind_Dereference,
+       Iir_Kind_Implicit_Dereference,
+       Iir_Kind_Slice_Name,
+       Iir_Kind_Indexed_Name,
+       Iir_Kind_Psl_Expression,
+
+   -- Concurrent statements.
+       Iir_Kind_Sensitized_Process_Statement,
+       Iir_Kind_Process_Statement,
+       Iir_Kind_Concurrent_Conditional_Signal_Assignment,
+       Iir_Kind_Concurrent_Selected_Signal_Assignment,
+       Iir_Kind_Concurrent_Assertion_Statement,
+       Iir_Kind_Psl_Default_Clock,
+       Iir_Kind_Psl_Assert_Statement,
+       Iir_Kind_Psl_Cover_Statement,
+       Iir_Kind_Concurrent_Procedure_Call_Statement,
+       Iir_Kind_Block_Statement,
+       Iir_Kind_Generate_Statement,
+       Iir_Kind_Component_Instantiation_Statement,
+
+       Iir_Kind_Simple_Simultaneous_Statement,
+
+   -- Iir_Kind_Sequential_Statement
+       Iir_Kind_Signal_Assignment_Statement,
+       Iir_Kind_Null_Statement,
+       Iir_Kind_Assertion_Statement,
+       Iir_Kind_Report_Statement,
+       Iir_Kind_Wait_Statement,
+       Iir_Kind_Variable_Assignment_Statement,
+       Iir_Kind_Return_Statement,
+       Iir_Kind_For_Loop_Statement,
+       Iir_Kind_While_Loop_Statement,
+       Iir_Kind_Next_Statement,
+       Iir_Kind_Exit_Statement,
+       Iir_Kind_Case_Statement,
+       Iir_Kind_Procedure_Call_Statement,
+       Iir_Kind_If_Statement,
+       Iir_Kind_Elsif,
+
+   -- Names
+       Iir_Kind_Character_Literal,              --  denoting_name
+       Iir_Kind_Simple_Name,                    --  denoting_name
+       Iir_Kind_Selected_Name,                  --  denoting_name
+       Iir_Kind_Operator_Symbol,                --  denoting_name
+
+       Iir_Kind_Selected_By_All_Name,
+       Iir_Kind_Parenthesis_Name,
+
+   -- Attributes
+       Iir_Kind_Base_Attribute,
+       Iir_Kind_Left_Type_Attribute,            --  type_attribute
+       Iir_Kind_Right_Type_Attribute,           --  type_attribute
+       Iir_Kind_High_Type_Attribute,            --  type_attribute
+       Iir_Kind_Low_Type_Attribute,             --  type_attribute
+       Iir_Kind_Ascending_Type_Attribute,       --  type_attribute
+       Iir_Kind_Image_Attribute,
+       Iir_Kind_Value_Attribute,
+       Iir_Kind_Pos_Attribute,                  --  scalar_type_attribute
+       Iir_Kind_Val_Attribute,                  --  scalar_type_attribute
+       Iir_Kind_Succ_Attribute,                 --  scalar_type_attribute
+       Iir_Kind_Pred_Attribute,                 --  scalar_type_attribute
+       Iir_Kind_Leftof_Attribute,               --  scalar_type_attribute
+       Iir_Kind_Rightof_Attribute,              --  scalar_type_attribute
+       Iir_Kind_Delayed_Attribute,              --  signal_attribute
+       Iir_Kind_Stable_Attribute,               --  signal_attribute
+       Iir_Kind_Quiet_Attribute,                --  signal_attribute
+       Iir_Kind_Transaction_Attribute,          --  signal_attribute
+       Iir_Kind_Event_Attribute,                --  signal_value_attribute
+       Iir_Kind_Active_Attribute,               --  signal_value_attribute
+       Iir_Kind_Last_Event_Attribute,           --  signal_value_attribute
+       Iir_Kind_Last_Active_Attribute,          --  signal_value_attribute
+       Iir_Kind_Last_Value_Attribute,           --  signal_value_attribute
+       Iir_Kind_Driving_Attribute,              --  signal_value_attribute
+       Iir_Kind_Driving_Value_Attribute,        --  signal_value_attribute
+       Iir_Kind_Behavior_Attribute,
+       Iir_Kind_Structure_Attribute,
+       Iir_Kind_Simple_Name_Attribute,
+       Iir_Kind_Instance_Name_Attribute,
+       Iir_Kind_Path_Name_Attribute,
+       Iir_Kind_Left_Array_Attribute,           --  array_attribute
+       Iir_Kind_Right_Array_Attribute,          --  array_attribute
+       Iir_Kind_High_Array_Attribute,           --  array_attribute
+       Iir_Kind_Low_Array_Attribute,            --  array_attribute
+       Iir_Kind_Length_Array_Attribute,         --  array_attribute
+       Iir_Kind_Ascending_Array_Attribute,      --  array_attribute
+       Iir_Kind_Range_Array_Attribute,          --  array_attribute
+       Iir_Kind_Reverse_Range_Array_Attribute,  --  array_attribute
+
+       Iir_Kind_Attribute_Name
+      );
+
+   type Iir_Signal_Kind is
+      (
+       Iir_No_Signal_Kind,
+       Iir_Register_Kind,
+       Iir_Bus_Kind
+       );
+
+   --  If the order of elements in IIR_MODE is modified, also modify the
+   --  order in GRT (types and rtis).
+   type Iir_Mode is
+      (
+       Iir_Unknown_Mode,
+       Iir_Linkage_Mode,
+       Iir_Buffer_Mode,
+       Iir_Out_Mode,
+       Iir_Inout_Mode,
+       Iir_In_Mode
+      );
+
+   subtype Iir_In_Modes is Iir_Mode range Iir_Inout_Mode .. Iir_In_Mode;
+   subtype Iir_Out_Modes is Iir_Mode range Iir_Out_Mode .. Iir_Inout_Mode;
+
+   type Iir_Delay_Mechanism is (Iir_Inertial_Delay, Iir_Transport_Delay);
+
+   type Iir_Direction is (Iir_To, Iir_Downto);
+
+   --  Iir_Lexical_Layout_type describe the lexical token used to describe
+   --  an interface declaration.  This has no semantics meaning, but it is
+   --  necessary to keep how lexically an interface was declared due to
+   --  LRM93 2.7 (conformance rules).
+   --  To keep this simple, the layout is stored as a bit-string.
+   --  Fields are:
+   --  Has_type: set if the interface is the last of a list.
+   --  has_mode: set if mode is explicit
+   --  has_class: set if class (constant, signal, variable or file) is explicit
+   --
+   --  Exemple:
+   --  procedure P (         A, B:       integer;
+   --               constant C:    in    bit;
+   --                        D:    inout bit;
+   --               variable E:          bit;
+   --                        F, G: in    bit;
+   --               constant H, I:       bit;
+   --               constant J, K: in    bit);
+   --  A:
+   --  B:                      has_type
+   --  C, has_class, has_mode, has_type
+   --  D:            has_mode, has_type
+   --  E, has_class,           has_type
+   --  F:            has_mode
+   --  G:            has_mode, has_type
+   --  H: has_class
+   --  I: has_class,           has_type
+   --  J: has_class, has_mode
+   --  K: has_class, has_mode, has_type
+   type Iir_Lexical_Layout_Type is mod 2 ** 3;
+   Iir_Lexical_Has_Mode  : constant Iir_Lexical_Layout_Type := 2 ** 0;
+   Iir_Lexical_Has_Class : constant Iir_Lexical_Layout_Type := 2 ** 1;
+   Iir_Lexical_Has_Type  : constant Iir_Lexical_Layout_Type := 2 ** 2;
+
+   --  List of predefined operators and functions.
+   type Iir_Predefined_Functions is
+      (
+       Iir_Predefined_Error,
+
+   --  Predefined operators for BOOLEAN type.
+       Iir_Predefined_Boolean_And,
+       Iir_Predefined_Boolean_Or,
+       Iir_Predefined_Boolean_Nand,
+       Iir_Predefined_Boolean_Nor,
+       Iir_Predefined_Boolean_Xor,
+       Iir_Predefined_Boolean_Xnor,
+       Iir_Predefined_Boolean_Not,
+
+       Iir_Predefined_Boolean_Rising_Edge,
+       Iir_Predefined_Boolean_Falling_Edge,
+
+   --  Predefined operators for any enumeration type.
+       Iir_Predefined_Enum_Equality,
+       Iir_Predefined_Enum_Inequality,
+       Iir_Predefined_Enum_Less,
+       Iir_Predefined_Enum_Less_Equal,
+       Iir_Predefined_Enum_Greater,
+       Iir_Predefined_Enum_Greater_Equal,
+
+       Iir_Predefined_Enum_Minimum,
+       Iir_Predefined_Enum_Maximum,
+       Iir_Predefined_Enum_To_String,
+
+   --  Predefined operators for BIT type.
+       Iir_Predefined_Bit_And,
+       Iir_Predefined_Bit_Or,
+       Iir_Predefined_Bit_Nand,
+       Iir_Predefined_Bit_Nor,
+       Iir_Predefined_Bit_Xor,
+       Iir_Predefined_Bit_Xnor,
+       Iir_Predefined_Bit_Not,
+
+       Iir_Predefined_Bit_Match_Equality,
+       Iir_Predefined_Bit_Match_Inequality,
+       Iir_Predefined_Bit_Match_Less,
+       Iir_Predefined_Bit_Match_Less_Equal,
+       Iir_Predefined_Bit_Match_Greater,
+       Iir_Predefined_Bit_Match_Greater_Equal,
+
+       Iir_Predefined_Bit_Condition,
+
+       Iir_Predefined_Bit_Rising_Edge,
+       Iir_Predefined_Bit_Falling_Edge,
+
+   --  Predefined operators for any integer type.
+       Iir_Predefined_Integer_Equality,
+       Iir_Predefined_Integer_Inequality,
+       Iir_Predefined_Integer_Less,
+       Iir_Predefined_Integer_Less_Equal,
+       Iir_Predefined_Integer_Greater,
+       Iir_Predefined_Integer_Greater_Equal,
+
+       Iir_Predefined_Integer_Identity,
+       Iir_Predefined_Integer_Negation,
+       Iir_Predefined_Integer_Absolute,
+
+       Iir_Predefined_Integer_Plus,
+       Iir_Predefined_Integer_Minus,
+       Iir_Predefined_Integer_Mul,
+       Iir_Predefined_Integer_Div,
+       Iir_Predefined_Integer_Mod,
+       Iir_Predefined_Integer_Rem,
+
+       Iir_Predefined_Integer_Exp,
+
+       Iir_Predefined_Integer_Minimum,
+       Iir_Predefined_Integer_Maximum,
+       Iir_Predefined_Integer_To_String,
+
+   --  Predefined operators for any floating type.
+       Iir_Predefined_Floating_Equality,
+       Iir_Predefined_Floating_Inequality,
+       Iir_Predefined_Floating_Less,
+       Iir_Predefined_Floating_Less_Equal,
+       Iir_Predefined_Floating_Greater,
+       Iir_Predefined_Floating_Greater_Equal,
+
+       Iir_Predefined_Floating_Identity,
+       Iir_Predefined_Floating_Negation,
+       Iir_Predefined_Floating_Absolute,
+
+       Iir_Predefined_Floating_Plus,
+       Iir_Predefined_Floating_Minus,
+       Iir_Predefined_Floating_Mul,
+       Iir_Predefined_Floating_Div,
+
+       Iir_Predefined_Floating_Exp,
+
+       Iir_Predefined_Floating_Minimum,
+       Iir_Predefined_Floating_Maximum,
+       Iir_Predefined_Floating_To_String,
+
+       Iir_Predefined_Real_To_String_Digits,
+       Iir_Predefined_Real_To_String_Format,
+
+   --  Predefined operator for universal types.
+       Iir_Predefined_Universal_R_I_Mul,
+       Iir_Predefined_Universal_I_R_Mul,
+       Iir_Predefined_Universal_R_I_Div,
+
+   --  Predefined operators for physical types.
+       Iir_Predefined_Physical_Equality,
+       Iir_Predefined_Physical_Inequality,
+       Iir_Predefined_Physical_Less,
+       Iir_Predefined_Physical_Less_Equal,
+       Iir_Predefined_Physical_Greater,
+       Iir_Predefined_Physical_Greater_Equal,
+
+       Iir_Predefined_Physical_Identity,
+       Iir_Predefined_Physical_Negation,
+       Iir_Predefined_Physical_Absolute,
+
+       Iir_Predefined_Physical_Plus,
+       Iir_Predefined_Physical_Minus,
+
+       Iir_Predefined_Physical_Integer_Mul,
+       Iir_Predefined_Physical_Real_Mul,
+       Iir_Predefined_Integer_Physical_Mul,
+       Iir_Predefined_Real_Physical_Mul,
+       Iir_Predefined_Physical_Integer_Div,
+       Iir_Predefined_Physical_Real_Div,
+       Iir_Predefined_Physical_Physical_Div,
+
+       Iir_Predefined_Physical_Minimum,
+       Iir_Predefined_Physical_Maximum,
+       Iir_Predefined_Physical_To_String,
+
+       Iir_Predefined_Time_To_String_Unit,
+
+   --  Predefined operators for access.
+       Iir_Predefined_Access_Equality,
+       Iir_Predefined_Access_Inequality,
+
+   --  Predefined operators for record.
+       Iir_Predefined_Record_Equality,
+       Iir_Predefined_Record_Inequality,
+
+   --  Predefined operators for array.
+       Iir_Predefined_Array_Equality,
+       Iir_Predefined_Array_Inequality,
+       Iir_Predefined_Array_Less,
+       Iir_Predefined_Array_Less_Equal,
+       Iir_Predefined_Array_Greater,
+       Iir_Predefined_Array_Greater_Equal,
+
+       Iir_Predefined_Array_Array_Concat,
+       Iir_Predefined_Array_Element_Concat,
+       Iir_Predefined_Element_Array_Concat,
+       Iir_Predefined_Element_Element_Concat,
+
+       Iir_Predefined_Array_Minimum,
+       Iir_Predefined_Array_Maximum,
+       Iir_Predefined_Vector_Minimum,
+       Iir_Predefined_Vector_Maximum,
+
+   --  Predefined shift operators.
+       Iir_Predefined_Array_Sll,
+       Iir_Predefined_Array_Srl,
+       Iir_Predefined_Array_Sla,
+       Iir_Predefined_Array_Sra,
+       Iir_Predefined_Array_Rol,
+       Iir_Predefined_Array_Ror,
+
+   --  Predefined operators for one dimensional array.
+   --  For bit and boolean type, the operations are the same.  For a neutral
+   --  noun, we use TF (for True/False) instead of Bit, Boolean or Logic.
+       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_TF_Reduction_And,
+       Iir_Predefined_TF_Reduction_Or,
+       Iir_Predefined_TF_Reduction_Nand,
+       Iir_Predefined_TF_Reduction_Nor,
+       Iir_Predefined_TF_Reduction_Xor,
+       Iir_Predefined_TF_Reduction_Xnor,
+       Iir_Predefined_TF_Reduction_Not,
+
+       Iir_Predefined_TF_Array_Element_And,
+       Iir_Predefined_TF_Element_Array_And,
+       Iir_Predefined_TF_Array_Element_Or,
+       Iir_Predefined_TF_Element_Array_Or,
+       Iir_Predefined_TF_Array_Element_Nand,
+       Iir_Predefined_TF_Element_Array_Nand,
+       Iir_Predefined_TF_Array_Element_Nor,
+       Iir_Predefined_TF_Element_Array_Nor,
+       Iir_Predefined_TF_Array_Element_Xor,
+       Iir_Predefined_TF_Element_Array_Xor,
+       Iir_Predefined_TF_Array_Element_Xnor,
+       Iir_Predefined_TF_Element_Array_Xnor,
+
+       Iir_Predefined_Bit_Array_Match_Equality,
+       Iir_Predefined_Bit_Array_Match_Inequality,
+
+   --  Predefined attribute functions.
+       Iir_Predefined_Attribute_Image,
+       Iir_Predefined_Attribute_Value,
+       Iir_Predefined_Attribute_Pos,
+       Iir_Predefined_Attribute_Val,
+       Iir_Predefined_Attribute_Succ,
+       Iir_Predefined_Attribute_Pred,
+       Iir_Predefined_Attribute_Leftof,
+       Iir_Predefined_Attribute_Rightof,
+       Iir_Predefined_Attribute_Left,
+       Iir_Predefined_Attribute_Right,
+       Iir_Predefined_Attribute_Event,
+       Iir_Predefined_Attribute_Active,
+       Iir_Predefined_Attribute_Last_Event,
+       Iir_Predefined_Attribute_Last_Active,
+       Iir_Predefined_Attribute_Last_Value,
+       Iir_Predefined_Attribute_Driving,
+       Iir_Predefined_Attribute_Driving_Value,
+
+   --  Access procedure
+       Iir_Predefined_Deallocate,
+
+   --  file function / procedures.
+       Iir_Predefined_File_Open,
+       Iir_Predefined_File_Open_Status,
+       Iir_Predefined_File_Close,
+       Iir_Predefined_Read,
+       Iir_Predefined_Read_Length,
+       Iir_Predefined_Flush,
+       Iir_Predefined_Write,
+       Iir_Predefined_Endfile,
+
+   --  To_String
+       Iir_Predefined_Array_Char_To_String,
+       Iir_Predefined_Bit_Vector_To_Ostring,
+       Iir_Predefined_Bit_Vector_To_Hstring,
+
+   --  IEEE.Std_Logic_1164.Std_Ulogic
+       Iir_Predefined_Std_Ulogic_Match_Equality,
+       Iir_Predefined_Std_Ulogic_Match_Inequality,
+       Iir_Predefined_Std_Ulogic_Match_Less,
+       Iir_Predefined_Std_Ulogic_Match_Less_Equal,
+       Iir_Predefined_Std_Ulogic_Match_Greater,
+       Iir_Predefined_Std_Ulogic_Match_Greater_Equal,
+
+       Iir_Predefined_Std_Ulogic_Array_Match_Equality,
+       Iir_Predefined_Std_Ulogic_Array_Match_Inequality,
+
+   --  Predefined function.
+       Iir_Predefined_Now_Function
+       );
+
+   --  Return TRUE iff FUNC is a short-cut predefined function.
+   function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions)
+     return Boolean;
+
+   subtype Iir_Predefined_Pure_Functions is Iir_Predefined_Functions range
+     Iir_Predefined_Boolean_And .. Iir_Predefined_Attribute_Driving_Value;
+
+   subtype Iir_Predefined_Dyadic_TF_Array_Functions
+   is Iir_Predefined_Functions range
+     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;
+
+   subtype Iir_Predefined_Shift_Functions is Iir_Predefined_Functions range
+     Iir_Predefined_Array_Sll ..
+   --Iir_Predefined_Array_Srl
+   --Iir_Predefined_Array_Sla
+   --Iir_Predefined_Array_Sra
+   --Iir_Predefined_Array_Rol
+     Iir_Predefined_Array_Ror;
+
+   subtype Iir_Predefined_Concat_Functions is Iir_Predefined_Functions range
+     Iir_Predefined_Array_Array_Concat ..
+   --Iir_Predefined_Array_Element_Concat
+   --Iir_Predefined_Element_Array_Concat
+     Iir_Predefined_Element_Element_Concat;
+
+   subtype Iir_Predefined_Std_Ulogic_Match_Ordering_Functions is
+     Iir_Predefined_Functions range
+     Iir_Predefined_Std_Ulogic_Match_Less ..
+   --Iir_Predefined_Std_Ulogic_Match_Less_Equal
+   --Iir_Predefined_Std_Ulogic_Match_Greater
+     Iir_Predefined_Std_Ulogic_Match_Greater_Equal;
+
+   -- Staticness as defined by LRM93 §6.1 and §7.4
+   type Iir_Staticness is (Unknown, None, Globally, Locally);
+
+   -- Staticness as defined by LRM93 §6.1 and §7.4
+   function Min (L,R: Iir_Staticness) return Iir_Staticness renames
+     Iir_Staticness'Min;
+
+   --  Purity state of a procedure.
+   --  PURE means the procedure is pure.
+   --  IMPURE means the procedure is impure: it references a file object or
+   --    a signal or a variable declared outside a subprogram, or it calls an
+   --    impure subprogram.
+   --  MAYBE_IMPURE means the procedure references a signal or a variable
+   --    declared in a subprogram.  The relative position of a parent has to
+   --    be considered.  The list of callees must not be checked.
+   --  UNKNOWN is like MAYBE_IMPURE, but the subprogram has a list of callees
+   --    whose purity is not yet known.  As a consequence, a direct or
+   --    indirect call to such a procedure cannot be proved to be allowed
+   --    in a pure function.
+   --  Note: UNKNOWN is the default state.  At any impure call, the state is
+   --    set to IMPURE.  Only at the end of body analysis and only if the
+   --    callee list is empty, the state can be set either to MAYBE_IMPURE or
+   --    PURE.
+   type Iir_Pure_State is (Unknown, Pure, Maybe_Impure, Impure);
+
+   --  State of subprograms for validity of use in all-sensitized process.
+   --  INVALID_SIGNAL means that the subprogram is in a package and
+   --    reads a signal or that the subprogram calls (indirectly) such
+   --    a subprogram.  In this case, the subprogram cannot be called from
+   --    an all-sensitized process.
+   --  READ_SIGNAL means that the subprogram reads a signal and is defined
+   --    in an entity or an architecture or that the subprogram calls
+   --    (indirectly) such a subprogram.  In this case, the subprogram can
+   --    be called from an all-sensitized process and the reference will be
+   --    part of the sensitivity list.
+   --  NO_SIGNAL means that the subprogram doesn't read any signal and don't
+   --    call such a subprogram.  The subprogram can be called from an
+   --    all-sensitized process but there is no need to track this call.
+   --  UNKNOWN means that the state is not yet defined.
+   type Iir_All_Sensitized is
+     (Unknown, No_Signal, Read_Signal, Invalid_Signal);
+
+   --  Constraint state of a type.
+   --  See LRM08 5.1 for definition.
+   type Iir_Constraint is
+     (Unconstrained, Partially_Constrained, Fully_Constrained);
+
+   --  The kind of an inteface list.
+   type Interface_Kind_Type is (Generic_Interface_List,
+                                Port_Interface_List,
+                                Procedure_Parameter_Interface_List,
+                                Function_Parameter_Interface_List);
+   subtype Parameter_Interface_List is Interface_Kind_Type range
+     Procedure_Parameter_Interface_List ..
+     Function_Parameter_Interface_List;
+
+   ---------------
+   -- subranges --
+   ---------------
+   -- These subtypes are used for ranges, for `case' statments or for the `in'
+   -- operator.
+
+   -- In order to be correctly parsed by check_iir, the declaration must
+   -- follow these rules:
+   -- * the first line must be "subtype Iir_Kinds_NAME is Iir_Kind_range"
+   -- * the second line must be the lowest bound of the range, followed by "..
+   -- * comments line
+   -- * the last line must be the highest bound of the range, followed by ";"
+
+--   subtype Iir_Kinds_List is Iir_Kind range
+--     Iir_Kind_List ..
+--     Iir_Kind_Callees_List;
+
+   subtype Iir_Kinds_Library_Unit_Declaration is Iir_Kind range
+     Iir_Kind_Package_Declaration ..
+   --Iir_Kind_Package_Instantiation_Declaration
+   --Iir_Kind_Package_Body
+   --Iir_Kind_Configuration_Declaration
+   --Iir_Kind_Entity_Declaration
+     Iir_Kind_Architecture_Body;
+
+   subtype Iir_Kinds_Package_Declaration is Iir_Kind range
+     Iir_Kind_Package_Declaration ..
+     Iir_Kind_Package_Instantiation_Declaration;
+
+   --  Note: does not include iir_kind_enumeration_literal since it is
+   --  considered as a declaration.
+   subtype Iir_Kinds_Literal is Iir_Kind range
+     Iir_Kind_Integer_Literal ..
+   --Iir_Kind_Floating_Point_Literal
+   --Iir_Kind_Null_Literal
+   --Iir_Kind_String_Literal
+   --Iir_Kind_Physical_Int_Literal
+   --Iir_Kind_Physical_Fp_Literal
+     Iir_Kind_Bit_String_Literal;
+
+   subtype Iir_Kinds_Array_Type_Definition is Iir_Kind range
+     Iir_Kind_Array_Type_Definition ..
+     Iir_Kind_Array_Subtype_Definition;
+
+   subtype Iir_Kinds_Type_And_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Access_Type_Definition ..
+   --Iir_Kind_Incomplete_Type_Definition
+   --Iir_Kind_File_Type_Definition
+   --Iir_Kind_Protected_Type_Declaration
+   --Iir_Kind_Record_Type_Definition
+   --Iir_Kind_Array_Type_Definition
+   --Iir_Kind_Array_Subtype_Definition
+   --Iir_Kind_Record_Subtype_Definition
+   --Iir_Kind_Access_Subtype_Definition
+   --Iir_Kind_Physical_Subtype_Definition
+   --Iir_Kind_Floating_Subtype_Definition
+   --Iir_Kind_Integer_Subtype_Definition
+   --Iir_Kind_Enumeration_Subtype_Definition
+   --Iir_Kind_Enumeration_Type_Definition
+   --Iir_Kind_Integer_Type_Definition
+   --Iir_Kind_Floating_Type_Definition
+     Iir_Kind_Physical_Type_Definition;
+
+   subtype Iir_Kinds_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Array_Subtype_Definition ..
+   --Iir_Kind_Record_Subtype_Definition
+   --Iir_Kind_Access_Subtype_Definition
+   --Iir_Kind_Physical_Subtype_Definition
+   --Iir_Kind_Floating_Subtype_Definition
+   --Iir_Kind_Integer_Subtype_Definition
+     Iir_Kind_Enumeration_Subtype_Definition;
+
+   subtype Iir_Kinds_Scalar_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Physical_Subtype_Definition ..
+   --Iir_Kind_Floating_Subtype_Definition
+   --Iir_Kind_Integer_Subtype_Definition
+     Iir_Kind_Enumeration_Subtype_Definition;
+
+   subtype Iir_Kinds_Scalar_Type_Definition is Iir_Kind range
+     Iir_Kind_Physical_Subtype_Definition ..
+   --Iir_Kind_Floating_Subtype_Definition
+   --Iir_Kind_Integer_Subtype_Definition
+   --Iir_Kind_Enumeration_Subtype_Definition
+   --Iir_Kind_Enumeration_Type_Definition
+   --Iir_Kind_Integer_Type_Definition
+   --Iir_Kind_Floating_Type_Definition
+     Iir_Kind_Physical_Type_Definition;
+
+   subtype Iir_Kinds_Range_Type_Definition is Iir_Kind range
+     Iir_Kind_Physical_Subtype_Definition ..
+   --Iir_Kind_Floating_Subtype_Definition
+   --Iir_Kind_Integer_Subtype_Definition
+   --Iir_Kind_Enumeration_Subtype_Definition
+     Iir_Kind_Enumeration_Type_Definition;
+
+   subtype Iir_Kinds_Discrete_Type_Definition is Iir_Kind range
+     Iir_Kind_Integer_Subtype_Definition ..
+   --Iir_Kind_Enumeration_Subtype_Definition
+   --Iir_Kind_Enumeration_Type_Definition
+     Iir_Kind_Integer_Type_Definition;
+
+--     subtype Iir_Kinds_Discrete_Subtype_Definition is Iir_Kind range
+--       Iir_Kind_Integer_Subtype_Definition ..
+--       Iir_Kind_Enumeration_Subtype_Definition;
+
+   subtype Iir_Kinds_Composite_Type_Definition is Iir_Kind range
+     Iir_Kind_Record_Type_Definition ..
+   --Iir_Kind_Array_Type_Definition
+   --Iir_Kind_Array_Subtype_Definition
+     Iir_Kind_Record_Subtype_Definition;
+
+   subtype Iir_Kinds_Type_Declaration is Iir_Kind range
+     Iir_Kind_Type_Declaration ..
+   --Iir_Kind_Anonymous_Type_Declaration
+     Iir_Kind_Subtype_Declaration;
+
+   subtype Iir_Kinds_Nonoverloadable_Declaration is Iir_Kind range
+     Iir_Kind_Type_Declaration ..
+     Iir_Kind_Element_Declaration;
+
+   subtype Iir_Kinds_Monadic_Operator is Iir_Kind range
+     Iir_Kind_Identity_Operator ..
+   --Iir_Kind_Negation_Operator
+   --Iir_Kind_Absolute_Operator
+   --Iir_Kind_Not_Operator
+   --Iir_Kind_Condition_Operator
+   --Iir_Kind_Reduction_And_Operator
+   --Iir_Kind_Reduction_Or_Operator
+   --Iir_Kind_Reduction_Nand_Operator
+   --Iir_Kind_Reduction_Nor_Operator
+   --Iir_Kind_Reduction_Xor_Operator
+     Iir_Kind_Reduction_Xnor_Operator;
+
+   subtype Iir_Kinds_Dyadic_Operator is Iir_Kind range
+     Iir_Kind_And_Operator ..
+   --Iir_Kind_Or_Operator
+   --Iir_Kind_Nand_Operator
+   --Iir_Kind_Nor_Operator
+   --Iir_Kind_Xor_Operator
+   --Iir_Kind_Xnor_Operator
+   --Iir_Kind_Equality_Operator
+   --Iir_Kind_Inequality_Operator
+   --Iir_Kind_Less_Than_Operator
+   --Iir_Kind_Less_Than_Or_Equal_Operator
+   --Iir_Kind_Greater_Than_Operator
+   --Iir_Kind_Greater_Than_Or_Equal_Operator
+   --Iir_Kind_Match_Equality_Operator
+   --Iir_Kind_Match_Inequality_Operator
+   --Iir_Kind_Match_Less_Than_Operator
+   --Iir_Kind_Match_Less_Than_Or_Equal_Operator
+   --Iir_Kind_Match_Greater_Than_Operator
+   --Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+   --Iir_Kind_Sll_Operator
+   --Iir_Kind_Sla_Operator
+   --Iir_Kind_Srl_Operator
+   --Iir_Kind_Sra_Operator
+   --Iir_Kind_Rol_Operator
+   --Iir_Kind_Ror_Operator
+   --Iir_Kind_Addition_Operator
+   --Iir_Kind_Substraction_Operator
+   --Iir_Kind_Concatenation_Operator
+   --Iir_Kind_Multiplication_Operator
+   --Iir_Kind_Division_Operator
+   --Iir_Kind_Modulus_Operator
+   --Iir_Kind_Remainder_Operator
+     Iir_Kind_Exponentiation_Operator;
+
+   subtype Iir_Kinds_Function_Declaration is Iir_Kind range
+     Iir_Kind_Function_Declaration ..
+     Iir_Kind_Implicit_Function_Declaration;
+
+   subtype Iir_Kinds_Functions_And_Literals is Iir_Kind range
+     Iir_Kind_Enumeration_Literal ..
+   --Iir_Kind_Function_Declaration
+     Iir_Kind_Implicit_Function_Declaration;
+
+   subtype Iir_Kinds_Procedure_Declaration is Iir_Kind range
+     Iir_Kind_Implicit_Procedure_Declaration ..
+     Iir_Kind_Procedure_Declaration;
+
+   subtype Iir_Kinds_Subprogram_Declaration is Iir_Kind range
+     Iir_Kind_Function_Declaration ..
+   --Iir_Kind_Implicit_Function_Declaration
+   --Iir_Kind_Implicit_Procedure_Declaration
+     Iir_Kind_Procedure_Declaration;
+
+   subtype Iir_Kinds_Implicit_Subprogram_Declaration is Iir_Kind range
+     Iir_Kind_Implicit_Function_Declaration ..
+     Iir_Kind_Implicit_Procedure_Declaration;
+
+   subtype Iir_Kinds_Process_Statement is Iir_Kind range
+     Iir_Kind_Sensitized_Process_Statement ..
+     Iir_Kind_Process_Statement;
+
+   subtype Iir_Kinds_Interface_Object_Declaration is Iir_Kind range
+     Iir_Kind_Interface_Constant_Declaration ..
+   --Iir_Kind_Interface_Variable_Declaration
+   --Iir_Kind_Interface_Signal_Declaration
+     Iir_Kind_Interface_File_Declaration;
+
+   subtype Iir_Kinds_Object_Declaration is Iir_Kind range
+     Iir_Kind_Object_Alias_Declaration ..
+   --Iir_Kind_File_Declaration
+   --Iir_Kind_Guard_Signal_Declaration
+   --Iir_Kind_Signal_Declaration
+   --Iir_Kind_Variable_Declaration
+   --Iir_Kind_Constant_Declaration
+   --Iir_Kind_Iterator_Declaration
+   --Iir_Kind_Interface_Constant_Declaration
+   --Iir_Kind_Interface_Variable_Declaration
+   --Iir_Kind_Interface_Signal_Declaration
+     Iir_Kind_Interface_File_Declaration;
+
+   subtype Iir_Kinds_Branch_Quantity_Declaration is Iir_Kind range
+     Iir_Kind_Across_Quantity_Declaration ..
+     Iir_Kind_Through_Quantity_Declaration;
+
+   subtype Iir_Kinds_Quantity_Declaration is Iir_Kind range
+     Iir_Kind_Free_Quantity_Declaration ..
+   --Iir_Kind_Across_Quantity_Declaration
+     Iir_Kind_Through_Quantity_Declaration;
+
+   subtype Iir_Kinds_Non_Alias_Object_Declaration is Iir_Kind range
+     Iir_Kind_File_Declaration ..
+   --Iir_Kind_Guard_Signal_Declaration
+   --Iir_Kind_Signal_Declaration
+   --Iir_Kind_Variable_Declaration
+   --Iir_Kind_Constant_Declaration
+   --Iir_Kind_Iterator_Declaration
+   --Iir_Kind_Interface_Constant_Declaration
+   --Iir_Kind_Interface_Variable_Declaration
+   --Iir_Kind_Interface_Signal_Declaration
+     Iir_Kind_Interface_File_Declaration;
+
+   subtype Iir_Kinds_Association_Element is Iir_Kind range
+     Iir_Kind_Association_Element_By_Expression ..
+   --Iir_Kind_Association_Element_By_Individual
+     Iir_Kind_Association_Element_Open;
+
+   subtype Iir_Kinds_Choice is Iir_Kind range
+     Iir_Kind_Choice_By_Others ..
+   --Iir_Kind_Choice_By_Expression
+   --Iir_Kind_Choice_By_Range
+   --Iir_Kind_Choice_By_None
+     Iir_Kind_Choice_By_Name;
+
+   subtype Iir_Kinds_Denoting_Name is Iir_Kind range
+     Iir_Kind_Character_Literal ..
+   --Iir_Kind_Simple_Name
+   --Iir_Kind_Selected_Name
+     Iir_Kind_Operator_Symbol;
+
+   subtype Iir_Kinds_Name is Iir_Kind range
+     Iir_Kind_Character_Literal ..
+   --Iir_Kind_Simple_Name
+   --Iir_Kind_Selected_Name
+   --Iir_Kind_Operator_Symbol
+   --Iir_Kind_Selected_By_All_Name
+     Iir_Kind_Parenthesis_Name;
+
+   subtype Iir_Kinds_Dereference is Iir_Kind range
+     Iir_Kind_Dereference ..
+     Iir_Kind_Implicit_Dereference;
+
+   --  Any attribute that is an expression.
+   subtype Iir_Kinds_Expression_Attribute is Iir_Kind range
+     Iir_Kind_Left_Type_Attribute ..
+   --Iir_Kind_Right_Type_Attribute
+   --Iir_Kind_High_Type_Attribute
+   --Iir_Kind_Low_Type_Attribute
+   --Iir_Kind_Ascending_Type_Attribute
+   --Iir_Kind_Image_Attribute
+   --Iir_Kind_Value_Attribute
+   --Iir_Kind_Pos_Attribute
+   --Iir_Kind_Val_Attribute
+   --Iir_Kind_Succ_Attribute
+   --Iir_Kind_Pred_Attribute
+   --Iir_Kind_Leftof_Attribute
+   --Iir_Kind_Rightof_Attribute
+   --Iir_Kind_Delayed_Attribute
+   --Iir_Kind_Stable_Attribute
+   --Iir_Kind_Quiet_Attribute
+   --Iir_Kind_Transaction_Attribute
+   --Iir_Kind_Event_Attribute
+   --Iir_Kind_Active_Attribute
+   --Iir_Kind_Last_Event_Attribute
+   --Iir_Kind_Last_Active_Attribute
+   --Iir_Kind_Last_Value_Attribute
+   --Iir_Kind_Driving_Attribute
+   --Iir_Kind_Driving_Value_Attribute
+   --Iir_Kind_Behavior_Attribute
+   --Iir_Kind_Structure_Attribute
+   --Iir_Kind_Simple_Name_Attribute
+   --Iir_Kind_Instance_Name_Attribute
+   --Iir_Kind_Path_Name_Attribute
+   --Iir_Kind_Left_Array_Attribute
+   --Iir_Kind_Right_Array_Attribute
+   --Iir_Kind_High_Array_Attribute
+   --Iir_Kind_Low_Array_Attribute
+   --Iir_Kind_Length_Array_Attribute
+     Iir_Kind_Ascending_Array_Attribute;
+
+   --  All the attributes.
+   subtype Iir_Kinds_Attribute is Iir_Kind range
+     Iir_Kind_Base_Attribute ..
+     Iir_Kind_Reverse_Range_Array_Attribute;
+
+   subtype Iir_Kinds_Type_Attribute is Iir_Kind range
+     Iir_Kind_Left_Type_Attribute ..
+   --Iir_Kind_Right_Type_Attribute
+   --Iir_Kind_High_Type_Attribute
+   --Iir_Kind_Low_Type_Attribute
+     Iir_Kind_Ascending_Type_Attribute;
+
+   subtype Iir_Kinds_Scalar_Type_Attribute is Iir_Kind range
+     Iir_Kind_Pos_Attribute ..
+   --Iir_Kind_Val_Attribute
+   --Iir_Kind_Succ_Attribute
+   --Iir_Kind_Pred_Attribute
+   --Iir_Kind_Leftof_Attribute
+     Iir_Kind_Rightof_Attribute;
+
+   subtype Iir_Kinds_Array_Attribute is Iir_Kind range
+     Iir_Kind_Left_Array_Attribute ..
+   --Iir_Kind_Right_Array_Attribute
+   --Iir_Kind_High_Array_Attribute
+   --Iir_Kind_Low_Array_Attribute
+   --Iir_Kind_Length_Array_Attribute
+   --Iir_Kind_Ascending_Array_Attribute
+   --Iir_Kind_Range_Array_Attribute
+     Iir_Kind_Reverse_Range_Array_Attribute;
+
+   subtype Iir_Kinds_Signal_Attribute is Iir_Kind range
+     Iir_Kind_Delayed_Attribute ..
+   --Iir_Kind_Stable_Attribute
+   --Iir_Kind_Quiet_Attribute
+     Iir_Kind_Transaction_Attribute;
+
+   subtype Iir_Kinds_Signal_Value_Attribute is Iir_Kind range
+     Iir_Kind_Event_Attribute ..
+   --Iir_Kind_Active_Attribute
+   --Iir_Kind_Last_Event_Attribute
+   --Iir_Kind_Last_Active_Attribute
+   --Iir_Kind_Last_Value_Attribute
+   --Iir_Kind_Driving_Attribute
+     Iir_Kind_Driving_Value_Attribute;
+
+   subtype Iir_Kinds_Name_Attribute is Iir_Kind range
+     Iir_Kind_Simple_Name_Attribute ..
+   --Iir_Kind_Instance_Name_Attribute
+     Iir_Kind_Path_Name_Attribute;
+
+   subtype Iir_Kinds_Concurrent_Statement is Iir_Kind range
+     Iir_Kind_Sensitized_Process_Statement ..
+   --Iir_Kind_Process_Statement
+   --Iir_Kind_Concurrent_Conditional_Signal_Assignment
+   --Iir_Kind_Concurrent_Selected_Signal_Assignment
+   --Iir_Kind_Concurrent_Assertion_Statement
+   --Iir_Kind_Psl_Default_Clock
+   --Iir_Kind_Psl_Assert_Statement
+   --Iir_Kind_Psl_Cover_Statement
+   --Iir_Kind_Concurrent_Procedure_Call_Statement
+   --Iir_Kind_Block_Statement
+   --Iir_Kind_Generate_Statement
+     Iir_Kind_Component_Instantiation_Statement;
+
+   subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range
+     Iir_Kind_Concurrent_Conditional_Signal_Assignment ..
+     Iir_Kind_Concurrent_Selected_Signal_Assignment;
+
+   subtype Iir_Kinds_Sequential_Statement is Iir_Kind range
+     Iir_Kind_Signal_Assignment_Statement ..
+   --Iir_Kind_Null_Statement
+   --Iir_Kind_Assertion_Statement
+   --Iir_Kind_Report_Statement
+   --Iir_Kind_Wait_Statement
+   --Iir_Kind_Variable_Assignment_Statement
+   --Iir_Kind_Return_Statement
+   --Iir_Kind_For_Loop_Statement
+   --Iir_Kind_While_Loop_Statement
+   --Iir_Kind_Next_Statement
+   --Iir_Kind_Exit_Statement
+   --Iir_Kind_Case_Statement
+   --Iir_Kind_Procedure_Call_Statement
+     Iir_Kind_If_Statement;
+
+   subtype Iir_Kinds_Allocator is Iir_Kind range
+     Iir_Kind_Allocator_By_Expression ..
+     Iir_Kind_Allocator_By_Subtype;
+
+   subtype Iir_Kinds_Clause is Iir_Kind range
+     Iir_Kind_Library_Clause ..
+     Iir_Kind_Use_Clause;
+
+   subtype Iir_Kinds_Specification is Iir_Kind range
+     Iir_Kind_Attribute_Specification ..
+   --Iir_Kind_Disconnection_Specification
+     Iir_Kind_Configuration_Specification;
+
+   subtype Iir_Kinds_Declaration is Iir_Kind range
+     Iir_Kind_Type_Declaration ..
+   --Iir_Kind_Anonymous_Type_Declaration
+   --Iir_Kind_Subtype_Declaration
+   --Iir_Kind_Nature_Declaration
+   --Iir_Kind_Subnature_Declaration
+   --Iir_Kind_Package_Declaration
+   --Iir_Kind_Package_Instantiation_Declaration
+   --Iir_Kind_Package_Body
+   --Iir_Kind_Configuration_Declaration
+   --Iir_Kind_Entity_Declaration
+   --Iir_Kind_Architecture_Body
+   --Iir_Kind_Package_Header
+   --Iir_Kind_Unit_Declaration
+   --Iir_Kind_Library_Declaration
+   --Iir_Kind_Component_Declaration
+   --Iir_Kind_Attribute_Declaration
+   --Iir_Kind_Group_Template_Declaration
+   --Iir_Kind_Group_Declaration
+   --Iir_Kind_Element_Declaration
+   --Iir_Kind_Non_Object_Alias_Declaration
+   --Iir_Kind_Psl_Declaration
+   --Iir_Kind_Terminal_Declaration
+   --Iir_Kind_Free_Quantity_Declaration
+   --Iir_Kind_Across_Quantity_Declaration
+   --Iir_Kind_Through_Quantity_Declaration
+   --Iir_Kind_Enumeration_Literal
+   --Iir_Kind_Function_Declaration
+   --Iir_Kind_Implicit_Function_Declaration
+   --Iir_Kind_Implicit_Procedure_Declaration
+   --Iir_Kind_Procedure_Declaration
+   --Iir_Kind_Function_Body
+   --Iir_Kind_Procedure_Body
+   --Iir_Kind_Object_Alias_Declaration
+   --Iir_Kind_File_Declaration
+   --Iir_Kind_Guard_Signal_Declaration
+   --Iir_Kind_Signal_Declaration
+   --Iir_Kind_Variable_Declaration
+   --Iir_Kind_Constant_Declaration
+   --Iir_Kind_Iterator_Declaration
+   --Iir_Kind_Interface_Constant_Declaration
+   --Iir_Kind_Interface_Variable_Declaration
+   --Iir_Kind_Interface_Signal_Declaration
+     Iir_Kind_Interface_File_Declaration;
+
+   -------------------------------------
+   -- Types and subtypes declarations --
+   -------------------------------------
+
+   -- Level 1 base class.
+   subtype Iir is Nodes.Node_Type;
+   subtype Iir_List is Lists.List_Type;
+   Null_Iir_List : constant Iir_List := Lists.Null_List;
+   Iir_List_All : constant Iir_List := Lists.List_All;
+   Iir_List_Others : constant Iir_List := Lists.List_Others;
+   subtype Iir_Lists_All_Others is Iir_List
+     range Iir_List_Others .. Iir_List_All;
+
+   Null_Iir : constant Iir := Nodes.Null_Node;
+
+   function Is_Null (Node : Iir) return Boolean;
+   pragma Inline (Is_Null);
+
+   function Is_Null_List (Node : Iir_List) return Boolean;
+   pragma Inline (Is_Null_List);
+
+   function "=" (L, R : Iir) return Boolean renames Nodes."=";
+
+   function Get_Last_Node return Iir renames Nodes.Get_Last_Node;
+
+   function Create_Iir_List return Iir_List
+     renames Lists.Create_List;
+   function Get_Nth_Element (L : Iir_List; N : Natural) return Iir
+     renames Lists.Get_Nth_Element;
+   procedure Replace_Nth_Element (L : Iir_List; N : Natural; El : Iir)
+     renames Lists.Replace_Nth_Element;
+   procedure Append_Element (L : Iir_List; E : Iir)
+     renames Lists.Append_Element;
+   procedure Add_Element (L : Iir_List; E : Iir)
+     renames Lists.Add_Element;
+   procedure Destroy_Iir_List (L : in out Iir_List)
+     renames Lists.Destroy_List;
+   function Get_Nbr_Elements (L : Iir_List) return Natural
+     renames Lists.Get_Nbr_Elements;
+   procedure Set_Nbr_Elements (L : Iir_List; Nbr : Natural)
+     renames Lists.Set_Nbr_Elements;
+   function Get_First_Element (L : Iir_List) return Iir
+     renames Lists.Get_First_Element;
+   function Get_Last_Element (L : Iir_List) return Iir
+     renames Lists.Get_Last_Element;
+   function "=" (L, R : Iir_List) return Boolean renames Lists."=";
+
+   -- This is used only for lists.
+   type Iir_Array is array (Natural range <>) of Iir;
+   type Iir_Array_Acc is access Iir_Array;
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Iir_Array, Name => Iir_Array_Acc);
+
+   --  Date State.
+   --  This indicates the origin of the data information.
+   --  This also indicates the state of the unit (loaded or not).
+   type Date_State_Type is
+     (
+      --  The unit is not yet in the library.
+      Date_Extern,
+
+      --  The unit is not loaded (still on the disk).
+      --  All the informations come from the library file.
+      Date_Disk,
+
+      --  The unit has been parsed, but not analyzed.
+      --  Only the date information come from the library.
+      Date_Parse,
+
+      --  The unit has been analyzed.
+      Date_Analyze
+     );
+
+   --  A date is used for analysis order.  All design units from a library
+   --  are ordered according to the date.
+   type Date_Type is new Nat32;
+   --  The unit is obseleted (ie replaced) by a more recently analyzed design
+   --  unit.another design unit.
+   --  If another design unit depends (directly or not) on an obseleted design
+   --  unit, it is also obselete, and cannot be defined.
+   Date_Obsolete      : constant Date_Type := 0;
+   --  The unit was not analyzed.
+   Date_Not_Analyzed  : constant Date_Type := 1;
+   --  The unit has been analyzed but it has bad dependences.
+   Date_Bad_Analyze   : constant Date_Type := 2;
+   --  The unit has been parsed but not analyzed.
+   Date_Parsed        : constant Date_Type := 4;
+   --  The unit is being analyzed.
+   Date_Analyzing     : constant Date_Type := 5;
+   --  This unit has just been analyzed and should be marked at the last
+   --  analyzed unit.
+   Date_Analyzed      : constant Date_Type := 6;
+   --  Used only for default configuration.
+   --  Such units are always up-to-date.
+   Date_Uptodate      : constant Date_Type := 7;
+   subtype Date_Valid is Date_Type range 10 .. Date_Type'Last;
+
+   --  Predefined depth values.
+   --  Depth of a subprogram not declared in another subprogram.
+   Iir_Depth_Top : constant Iir_Int32 := 0;
+   --  Purity depth of a pure subprogram.
+   Iir_Depth_Pure : constant Iir_Int32 := Iir_Int32'Last;
+   --  Purity depth of an impure subprogram.
+   Iir_Depth_Impure : constant Iir_Int32 := -1;
+
+   type Base_Type is (Base_2, Base_8, Base_16);
+
+   -- design file
+   subtype Iir_Design_File is Iir;
+
+   subtype Iir_Design_Unit is Iir;
+
+   subtype Iir_Library_Clause is Iir;
+
+   -- Literals.
+   --subtype Iir_Text_Literal is Iir;
+
+   subtype Iir_Character_Literal is Iir;
+
+   subtype Iir_Integer_Literal is Iir;
+
+   subtype Iir_Floating_Point_Literal is Iir;
+
+   subtype Iir_String_Literal is Iir;
+
+   subtype Iir_Bit_String_Literal is Iir;
+
+   subtype Iir_Null_Literal is Iir;
+
+   subtype Iir_Physical_Int_Literal is Iir;
+
+   subtype Iir_Physical_Fp_Literal is Iir;
+
+   subtype Iir_Enumeration_Literal is Iir;
+
+   subtype Iir_Simple_Aggregate is Iir;
+
+   subtype Iir_Enumeration_Type_Definition is Iir;
+
+   subtype Iir_Enumeration_Subtype_Definition is Iir;
+
+   subtype Iir_Range_Expression is Iir;
+
+   subtype Iir_Integer_Subtype_Definition is Iir;
+
+   subtype Iir_Integer_Type_Definition is Iir;
+
+   subtype Iir_Floating_Subtype_Definition is Iir;
+
+   subtype Iir_Floating_Type_Definition is Iir;
+
+   subtype Iir_Array_Type_Definition is Iir;
+
+   subtype Iir_Record_Type_Definition is Iir;
+
+   subtype Iir_Protected_Type_Declaration is Iir;
+
+   subtype Iir_Protected_Type_Body is Iir;
+
+   subtype Iir_Subtype_Definition is Iir;
+
+   subtype Iir_Array_Subtype_Definition is Iir;
+
+   subtype Iir_Physical_Type_Definition is Iir;
+
+   subtype Iir_Physical_Subtype_Definition is Iir;
+
+   subtype Iir_Access_Type_Definition is Iir;
+
+   subtype Iir_Access_Subtype_Definition is Iir;
+
+   subtype Iir_File_Type_Definition is Iir;
+
+   subtype Iir_Waveform_Element is Iir;
+
+   subtype Iir_Conditional_Waveform is Iir;
+
+   subtype Iir_Association_Element_By_Expression is Iir;
+
+   subtype Iir_Association_Element_By_Individual is Iir;
+
+   subtype Iir_Association_Element_Open is Iir;
+
+   subtype Iir_Signature is Iir;
+
+   subtype Iir_Unit_Declaration is Iir;
+
+   subtype Iir_Entity_Aspect_Entity is Iir;
+
+   subtype Iir_Entity_Aspect_Configuration is Iir;
+
+   subtype Iir_Entity_Aspect_Open is Iir;
+
+   subtype Iir_Block_Configuration is Iir;
+
+   subtype Iir_Block_Header is Iir;
+
+   subtype Iir_Component_Configuration is Iir;
+
+   subtype Iir_Binding_Indication is Iir;
+
+   subtype Iir_Entity_Class is Iir;
+
+   subtype Iir_Attribute_Specification is Iir;
+
+   subtype Iir_Attribute_Value is Iir;
+
+   subtype Iir_Selected_Element is Iir;
+
+   subtype Iir_Implicit_Dereference is Iir;
+
+   subtype Iir_Aggregate_Info is Iir;
+
+   subtype Iir_Procedure_Call is Iir;
+
+   subtype Iir_Disconnection_Specification is Iir;
+
+   -- Lists.
+
+   subtype Iir_Index_List is Iir_List;
+
+   subtype Iir_Design_Unit_List is Iir_List;
+
+   subtype Iir_Enumeration_Literal_List is Iir_List;
+
+   subtype Iir_Designator_List is Iir_List;
+
+   subtype Iir_Attribute_Value_Chain is Iir_List;
+
+   subtype Iir_Overload_List is Iir;
+
+   subtype Iir_Group_Constituent_List is Iir_List;
+
+   subtype Iir_Callees_List is Iir_List;
+
+   -- Declaration and children.
+   subtype Iir_Entity_Declaration is Iir;
+
+   subtype Iir_Architecture_Body is Iir;
+
+   subtype Iir_Interface_Signal_Declaration is Iir;
+
+   subtype Iir_Configuration_Declaration is Iir;
+
+   subtype Iir_Type_Declaration is Iir;
+
+   subtype Iir_Anonymous_Type_Declaration is Iir;
+
+   subtype Iir_Subtype_Declaration is Iir;
+
+   subtype Iir_Package_Declaration is Iir;
+   subtype Iir_Package_Body is Iir;
+
+   subtype Iir_Library_Declaration is Iir;
+
+   subtype Iir_Function_Declaration is Iir;
+
+   subtype Iir_Function_Body is Iir;
+
+   subtype Iir_Procedure_Declaration is Iir;
+
+   subtype Iir_Procedure_Body is Iir;
+
+   subtype Iir_Implicit_Function_Declaration is Iir;
+
+   subtype Iir_Implicit_Procedure_Declaration is Iir;
+
+   subtype Iir_Use_Clause is Iir;
+
+   subtype Iir_Constant_Declaration is Iir;
+
+   subtype Iir_Iterator_Declaration is Iir;
+
+   subtype Iir_Interface_Constant_Declaration is Iir;
+
+   subtype Iir_Interface_Variable_Declaration is Iir;
+
+   subtype Iir_Interface_File_Declaration is Iir;
+
+   subtype Iir_Guard_Signal_Declaration is Iir;
+
+   subtype Iir_Signal_Declaration is Iir;
+
+   subtype Iir_Variable_Declaration is Iir;
+
+   subtype Iir_Component_Declaration is Iir;
+
+   subtype Iir_Element_Declaration is Iir;
+
+   subtype Iir_Object_Alias_Declaration is Iir;
+
+   subtype Iir_Non_Object_Alias_Declaration is Iir;
+
+   subtype Iir_Interface_Declaration is Iir;
+
+   subtype Iir_Configuration_Specification is Iir;
+
+   subtype Iir_File_Declaration is Iir;
+
+   subtype Iir_Attribute_Declaration is Iir;
+
+   subtype Iir_Group_Template_Declaration is Iir;
+
+   subtype Iir_Group_Declaration is Iir;
+
+   -- concurrent_statement and children.
+   subtype Iir_Concurrent_Statement is Iir;
+
+   subtype Iir_Concurrent_Conditional_Signal_Assignment is Iir;
+
+   subtype Iir_Sensitized_Process_Statement is Iir;
+
+   subtype Iir_Process_Statement is Iir;
+
+   subtype Iir_Component_Instantiation_Statement is Iir;
+
+   subtype Iir_Block_Statement is Iir;
+
+   subtype Iir_Generate_Statement is Iir;
+
+   -- sequential statements.
+   subtype Iir_If_Statement is Iir;
+
+   subtype Iir_Elsif is Iir;
+
+   subtype Iir_For_Loop_Statement is Iir;
+
+   subtype Iir_While_Loop_Statement is Iir;
+
+   subtype Iir_Exit_Statement is Iir;
+   subtype Iir_Next_Statement is Iir;
+
+   subtype Iir_Variable_Assignment_Statement is Iir;
+
+   subtype Iir_Signal_Assignment_Statement is Iir;
+
+   subtype Iir_Assertion_Statement is Iir;
+
+   subtype Iir_Report_Statement is Iir;
+
+   subtype Iir_Wait_Statement is Iir;
+
+   subtype Iir_Return_Statement is Iir;
+
+   subtype Iir_Case_Statement is Iir;
+
+   subtype Iir_Procedure_Call_Statement is Iir;
+
+   -- expression and children.
+   subtype Iir_Expression is Iir;
+
+   subtype Iir_Function_Call is Iir;
+
+   subtype Iir_Aggregate is Iir;
+
+   subtype Iir_Qualified_Expression is Iir;
+
+   subtype Iir_Type_Conversion is Iir;
+
+   subtype Iir_Allocator_By_Expression is Iir;
+
+   subtype Iir_Allocator_By_Subtype is Iir;
+
+   -- names.
+   subtype Iir_Simple_Name is Iir;
+
+   subtype Iir_Slice_Name is Iir;
+
+   subtype Iir_Selected_Name is Iir;
+
+   subtype Iir_Selected_By_All_Name is Iir;
+
+   subtype Iir_Indexed_Name is Iir;
+
+   subtype Iir_Parenthesis_Name is Iir;
+
+   -- attributes.
+   subtype Iir_Attribute_Name is Iir;
+
+   -- General methods.
+
+   -- Get the kind of the iir.
+   function Get_Kind (An_Iir: Iir) return Iir_Kind;
+   pragma Inline (Get_Kind);
+
+   --  Create a new IIR of kind NEW_KIND, and copy fields from SRC to this
+   --  iir.  Src fields are cleaned.
+   --function Clone_Iir (Src: Iir; New_Kind : Iir_Kind) return Iir;
+
+   procedure Set_Location (Target: Iir; Location: Location_Type)
+     renames Nodes.Set_Location;
+   function Get_Location (Target: Iir) return Location_Type
+     renames Nodes.Get_Location;
+
+   procedure Location_Copy (Target: Iir; Src: Iir);
+
+   function Create_Iir (Kind: Iir_Kind) return Iir;
+   function Create_Iir_Error return Iir;
+   procedure Free_Iir (Target: Iir) renames Nodes.Free_Node;
+
+   --  Disp statistics about node usage.
+   procedure Disp_Stats;
+
+   --  Design units contained in a design file.
+   --  Field: Field5 Chain
+   function Get_First_Design_Unit (Design : Iir) return Iir;
+   procedure Set_First_Design_Unit (Design : Iir; Chain : Iir);
+
+   --  Field: Field6 Ref
+   function Get_Last_Design_Unit (Design : Iir) return Iir;
+   procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir);
+
+   --  Library declaration of a library clause.
+   --  Field: Field1
+   function Get_Library_Declaration (Design : Iir) return Iir;
+   procedure Set_Library_Declaration (Design : Iir; Library : Iir);
+
+   -- File time stamp is the system time of the file last modification.
+   --  Field: Field4 (uc)
+   function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id;
+   procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id);
+
+   -- Time stamp of the last analysis system time.
+   --  Field: Field3 (uc)
+   function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id;
+   procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id);
+
+   --  The library which FILE belongs to.
+   --  Field: Field0 Ref
+   function Get_Library (File : Iir_Design_File) return Iir;
+   procedure Set_Library (File : Iir_Design_File; Lib : Iir);
+
+   --  List of files which this design file depends on.
+   --  Field: Field1 (uc)
+   function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List;
+   procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List);
+
+   --  Identifier for the design file file name.
+   --  Field: Field12 (pos)
+   function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id;
+   procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id);
+
+   --  Directory of a design file.
+   --  Field: Field11 (pos)
+   function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id;
+   procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id);
+
+   --  The parent of a design unit is a design file.
+   --  Field: Field0 Ref
+   function Get_Design_File (Unit : Iir_Design_Unit) return Iir;
+   procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir);
+
+   --  Design files of a library.
+   --  Field: Field1 Chain
+   function Get_Design_File_Chain (Library : Iir) return Iir;
+   procedure Set_Design_File_Chain (Library : Iir; Chain : Iir);
+
+   --  System directory where the library is stored.
+   --  Field: Field11 (pos)
+   function Get_Library_Directory (Library : Iir) return Name_Id;
+   procedure Set_Library_Directory (Library : Iir; Dir : Name_Id);
+
+   -- Symbolic date, used to order design units in a library.
+   --  Field: Field10 (pos)
+   function Get_Date (Target : Iir) return Date_Type;
+   procedure Set_Date (Target : Iir; Date : Date_Type);
+
+   --  Chain of context clauses.
+   --  Field: Field1 Chain
+   function Get_Context_Items (Design_Unit : Iir) return Iir;
+   procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir);
+
+   --  List of design units on which the design unit depends. There is an
+   --  exception: the architecture of an entity aspect (of a component
+   --  instantiation) may not have been analyzed.  The Entity_Aspect_Entity
+   --  is added to this list (instead of the non-existing design unit).
+   --  Field: Field8 Of_Ref (uc)
+   function Get_Dependence_List (Unit : Iir) return Iir_List;
+   procedure Set_Dependence_List (Unit : Iir; List : Iir_List);
+
+   --  List of functions or sensitized processes whose analysis checks are not
+   --  complete.
+   --  These elements have direct or indirect calls to procedure whose body is
+   --  not yet analyzed.  Therefore, purity or wait checks are not complete.
+   --  Field: Field9 (uc)
+   function Get_Analysis_Checks_List (Unit : Iir) return Iir_List;
+   procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List);
+
+   --  Wether the unit is on disk, parsed or analyzed.
+   --  Field: State1 (pos)
+   function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type;
+   procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type);
+
+   --  If TRUE, the target of the signal assignment is guarded.
+   --  If FALSE, the target is not guarded.
+   --  This is determined during sem by examining the declaration(s) of the
+   --  target (there may be severals declarations in the case of a aggregate
+   --  target).
+   --  If UNKNOWN, this is not determined at compile time but at run-time.
+   --  This is the case for formal signal interfaces of subprograms.
+   --  Field: State3 (pos)
+   function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type;
+   procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type);
+
+   --  Library unit of a design unit.
+   --  Field: Field5
+   function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir;
+   procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir);
+   pragma Inline (Get_Library_Unit);
+
+   --  Every design unit is put in an hash table to find quickly found by its
+   --  name.  This field is a single chain for collisions.
+   --  Field: Field7 Ref
+   function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir;
+   procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir);
+
+   -- Set the line and the offset in the line, only for the library manager.
+   -- This is valid until the file is really loaded in memory.  On loading,
+   -- location will contain all this informations.
+   --  Field: Field4 (uc)
+   function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr;
+   procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr);
+
+   --  Field: Field11 (uc)
+   function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32;
+   procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32);
+
+   --  Field: Field12 (uc)
+   function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32;
+   procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32);
+
+   --  literals.
+
+   --  Value of an integer/physical literal.
+   --  Field: Int64
+   function Get_Value (Lit : Iir) return Iir_Int64;
+   procedure Set_Value (Lit : Iir; Val : Iir_Int64);
+
+   --  Position (same as lit_type'pos) of an enumeration literal.
+   --  Field: Field10 (pos)
+   function Get_Enum_Pos (Lit : Iir) return Iir_Int32;
+   procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32);
+
+   --  Field: Field6
+   function Get_Physical_Literal (Unit : Iir) return Iir;
+   procedure Set_Physical_Literal (Unit : Iir; Lit : Iir);
+
+   --  Value of a physical unit declaration.
+   --  Field: Field7
+   function Get_Physical_Unit_Value (Unit : Iir) return Iir;
+   procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir);
+
+   --  Value of a floating point literal.
+   --  Field: Fp64
+   function Get_Fp_Value (Lit : Iir) return Iir_Fp64;
+   procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64);
+
+   --  Declaration of the literal.
+   --  This is used to retrieve the genuine enumeration literal for literals
+   --  created from static expression.
+   --  Field: Field6 Ref
+   function Get_Enumeration_Decl (Target : Iir) return Iir;
+   procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir);
+
+   --  List of elements of a simple aggregate.
+   --  Field: Field3 (uc)
+   function Get_Simple_Aggregate_List (Target : Iir) return Iir_List;
+   procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List);
+
+   -- The logarithm of the base (1, 3 or 4) of a bit string.
+   --  Field: Field8 (pos)
+   function Get_Bit_String_Base (Lit : Iir) return Base_Type;
+   procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type);
+
+   --  The enumeration literal which defines the '0' and '1' value.
+   --  Field: Field6
+   function Get_Bit_String_0 (Lit : Iir) return Iir;
+   procedure Set_Bit_String_0 (Lit : Iir; El : Iir);
+
+   --  Field: Field7
+   function Get_Bit_String_1 (Lit : Iir) return Iir;
+   procedure Set_Bit_String_1 (Lit : Iir; El : Iir);
+
+   --  The origin of a literal can be null_iir for a literal generated by the
+   --  parser, or a node which was statically evaluated to this literal.
+   --  Such nodes are created by eval_expr.
+   --  Field: Field2
+   function Get_Literal_Origin (Lit : Iir) return Iir;
+   procedure Set_Literal_Origin (Lit : Iir; Orig : Iir);
+
+   --  Field: Field4
+   function Get_Range_Origin (Lit : Iir) return Iir;
+   procedure Set_Range_Origin (Lit : Iir; Orig : Iir);
+
+   --  Same as Type, but not marked as Ref.  This is when a literal has a
+   --  subtype (such as string or bit_string) created specially for the
+   --  literal.
+   --  Field: Field5
+   function Get_Literal_Subtype (Lit : Iir) return Iir;
+   procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir);
+
+   --  Field: Field3 (uc)
+   function Get_Entity_Class (Target : Iir) return Token_Type;
+   procedure Set_Entity_Class (Target : Iir; Kind : Token_Type);
+
+   --  Field: Field1 (uc)
+   function Get_Entity_Name_List (Target : Iir) return Iir_List;
+   procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List);
+
+   --  Field: Field6
+   function Get_Attribute_Designator (Target : Iir) return Iir;
+   procedure Set_Attribute_Designator (Target : Iir; Designator : Iir);
+
+   --  Chain of attribute specifications.  This is used only during sem, to
+   --  check that no named entity of a given class appear after an attr. spec.
+   --  with the entity name list OTHERS or ALL.
+   --  Field: Field7
+   function Get_Attribute_Specification_Chain (Target : Iir) return Iir;
+   procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field4 Ref
+   function Get_Attribute_Specification (Val : Iir) return Iir;
+   procedure Set_Attribute_Specification (Val : Iir; Attr : Iir);
+
+   --  Field: Field3 (uc)
+   function Get_Signal_List (Target : Iir) return Iir_List;
+   procedure Set_Signal_List (Target : Iir; List : Iir_List);
+
+   --  Field: Field3 Ref
+   function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir;
+   procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir);
+
+   --  Field: Field1
+   function Get_Formal (Target : Iir) return Iir;
+   procedure Set_Formal (Target : Iir; Formal : Iir);
+
+   --  Field: Field3
+   function Get_Actual (Target : Iir) return Iir;
+   procedure Set_Actual (Target : Iir; Actual : Iir);
+
+   --  Field: Field4
+   function Get_In_Conversion (Target : Iir) return Iir;
+   procedure Set_In_Conversion (Target : Iir; Conv : Iir);
+
+   --  Field: Field5
+   function Get_Out_Conversion (Target : Iir) return Iir;
+   procedure Set_Out_Conversion (Target : Iir; Conv : Iir);
+
+   --  This flag is set when the formal is associated in whole (ie, not
+   --  individually).
+   --  Field: Flag1
+   function Get_Whole_Association_Flag (Target : Iir) return Boolean;
+   procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean);
+
+   --  This flag is set when the formal signal can be the actual signal.  In
+   --  this case, the formal signal is not created, and the actual is shared.
+   --  This is the signal collapsing optimisation.
+   --  Field: Flag2
+   function Get_Collapse_Signal_Flag (Target : Iir) return Boolean;
+   procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean);
+
+   --  Set when the node was artificially created, eg by canon.
+   --  Currently used only by association_element_open.
+   --  Field: Flag3
+   function Get_Artificial_Flag (Target : Iir) return Boolean;
+   procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean);
+
+   --  This flag is set for a very short time during the check that no in
+   --  port is unconnected.
+   --  Field: Flag3
+   function Get_Open_Flag (Target : Iir) return Boolean;
+   procedure Set_Open_Flag (Target : Iir; Flag : Boolean);
+
+   --  This flag is set by trans_analyze if there is a projected waveform
+   --  assignment in the process.
+   --  Field: Flag5
+   function Get_After_Drivers_Flag (Target : Iir) return Boolean;
+   procedure Set_After_Drivers_Flag (Target : Iir; Flag : Boolean);
+
+   --  Field: Field1
+   function Get_We_Value (We : Iir_Waveform_Element) return Iir;
+   procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir);
+
+   --  Field: Field3
+   function Get_Time (We : Iir_Waveform_Element) return Iir;
+   procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir);
+
+   --  Node associated with a choice.
+   --  Field: Field3
+   function Get_Associated_Expr (Target : Iir) return Iir;
+   procedure Set_Associated_Expr (Target : Iir; Associated : Iir);
+
+   --  Chain associated with a choice.
+   --  Field: Field4 Chain
+   function Get_Associated_Chain (Target : Iir) return Iir;
+   procedure Set_Associated_Chain (Target : Iir; Associated : Iir);
+
+   --  Field: Field5
+   function Get_Choice_Name (Choice : Iir) return Iir;
+   procedure Set_Choice_Name (Choice : Iir; Name : Iir);
+
+   --  Field: Field5
+   function Get_Choice_Expression (Choice : Iir) return Iir;
+   procedure Set_Choice_Expression (Choice : Iir; Name : Iir);
+
+   --  Field: Field5
+   function Get_Choice_Range (Choice : Iir) return Iir;
+   procedure Set_Choice_Range (Choice : Iir; Name : Iir);
+
+   --  Set when a choice belongs to the same alternative as the previous one.
+   --  Field: Flag1
+   function Get_Same_Alternative_Flag (Target : Iir) return Boolean;
+   procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean);
+
+   --  Field: Field3
+   function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir;
+   procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir);
+
+   --  Field: Field5
+   function Get_Block_Specification (Target : Iir) return Iir;
+   procedure Set_Block_Specification (Target : Iir; Block : Iir);
+
+   --  Return the link of the previous block_configuration of a
+   --  block_configuration.
+   --  This single linked list is used to list all the block_configuration that
+   --  configuration the same block (which can only be an iterative generate
+   --  statement).
+   --  All elements of this list must belong to the same block configuration.
+   --  The order is not important.
+   --  Field: Field4 Ref
+   function Get_Prev_Block_Configuration (Target : Iir) return Iir;
+   procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir);
+
+   --  Field: Field3 Chain
+   function Get_Configuration_Item_Chain (Target : Iir) return Iir;
+   procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir);
+
+   --  Chain of attribute values for a named entity.
+   --  To be used with Get/Set_Chain.
+   --  There is no order, therefore, a new attribute value may be always
+   --  prepended.
+   --  Field: Field4 Chain
+   function Get_Attribute_Value_Chain (Target : Iir) return Iir;
+   procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir);
+
+   --  Next attribute value in the attribute specification chain (of attribute
+   --  value).
+   --  Field: Field0
+   function Get_Spec_Chain (Target : Iir) return Iir;
+   procedure Set_Spec_Chain (Target : Iir; Chain : Iir);
+
+   --  Chain of attribute values for attribute specification.
+   --  To be used with Get/Set_Spec_Chain.
+   --  Field: Field4
+   function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir;
+   procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir);
+
+   --  The entity name for an architecture or a configuration.
+   --  Field: Field2
+   function Get_Entity_Name (Arch : Iir) return Iir;
+   procedure Set_Entity_Name (Arch : Iir; Entity : Iir);
+
+   --  The package declaration corresponding to the body.
+   --  Field: Field4 Ref
+   function Get_Package (Package_Body : Iir) return Iir;
+   procedure Set_Package (Package_Body : Iir; Decl : Iir);
+
+   --  The package body corresponding to the package declaration.
+   --  Field: Field2 Ref
+   function Get_Package_Body (Pkg : Iir) return Iir;
+   procedure Set_Package_Body (Pkg : Iir; Decl : Iir);
+
+   --  If true, the package need a body.
+   --  Field: Flag1
+   function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean;
+   procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean);
+
+   --  Field: Field5
+   function Get_Block_Configuration (Target : Iir) return Iir;
+   procedure Set_Block_Configuration (Target : Iir; Block : Iir);
+
+   --  Field: Field5 Chain
+   function Get_Concurrent_Statement_Chain (Target : Iir) return Iir;
+   procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir);
+
+   --  Field: Field2 Chain_Next
+   function Get_Chain (Target : Iir) return Iir;
+   procedure Set_Chain (Target : Iir; Chain : Iir);
+   pragma Inline (Get_Chain);
+
+   --  Field: Field7 Chain
+   function Get_Port_Chain (Target : Iir) return Iir;
+   procedure Set_Port_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field6 Chain
+   function Get_Generic_Chain (Target : Iir) return Iir;
+   procedure Set_Generic_Chain (Target : Iir; Generics : Iir);
+
+   --  Field: Field1 Ref
+   function Get_Type (Target : Iir) return Iir;
+   procedure Set_Type (Target : Iir; Atype : Iir);
+   pragma Inline (Get_Type);
+
+   --  The subtype indication of a declaration.  Note that this node can be
+   --  shared between declarations if they are separated by comma, such as in:
+   --    variable a, b : integer := 5;
+   --  Field: Field5 Maybe_Ref
+   function Get_Subtype_Indication (Target : Iir) return Iir;
+   procedure Set_Subtype_Indication (Target : Iir; Atype : Iir);
+
+   --  Field: Field6
+   function Get_Discrete_Range (Target : Iir) return Iir;
+   procedure Set_Discrete_Range (Target : Iir; Rng : Iir);
+
+   --  Field: Field1
+   function Get_Type_Definition (Decl : Iir) return Iir;
+   procedure Set_Type_Definition (Decl : Iir; Atype : Iir);
+
+   --  The subtype definition associated with the type declaration (if any).
+   --  Field: Field4
+   function Get_Subtype_Definition (Target : Iir) return Iir;
+   procedure Set_Subtype_Definition (Target : Iir; Def : Iir);
+
+   --  Field: Field1
+   function Get_Nature (Target : Iir) return Iir;
+   procedure Set_Nature (Target : Iir; Nature : Iir);
+
+   --  Mode of interfaces or file (v87).
+   --  Field: Odigit1 (pos)
+   function Get_Mode (Target : Iir) return Iir_Mode;
+   procedure Set_Mode (Target : Iir; Mode : Iir_Mode);
+
+   --  Field: State3 (pos)
+   function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind;
+   procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind);
+
+   --  The base name of a name is the node at the origin of the name.
+   --  The base name is a declaration (signal, object, constant or interface),
+   --  a selected_by_all name, an implicit_dereference name.
+   --  Field: Field5 Ref
+   function Get_Base_Name (Target : Iir) return Iir;
+   procedure Set_Base_Name (Target : Iir; Name : Iir);
+   pragma Inline (Get_Base_Name);
+
+   --  Field: Field5 Chain
+   function Get_Interface_Declaration_Chain (Target : Iir) return Iir;
+   procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir);
+   pragma Inline (Get_Interface_Declaration_Chain);
+
+   --  Field: Field4 Ref
+   function Get_Subprogram_Specification (Target : Iir) return Iir;
+   procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir);
+
+   --  Field: Field5 Chain
+   function Get_Sequential_Statement_Chain (Target : Iir) return Iir;
+   procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field9 Ref
+   function Get_Subprogram_Body (Target : Iir) return Iir;
+   procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir);
+
+   --  Several subprograms in a declarative region may have the same
+   --  identifier.  If the overload number is not 0, it is the rank of the
+   --  subprogram.  If the overload number is 0, then the identifier is not
+   --  overloaded in the declarative region.
+   --  Field: Field12 (pos)
+   function Get_Overload_Number (Target : Iir) return Iir_Int32;
+   procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32);
+
+   --  Depth of a subprogram.
+   --  For a subprogram declared immediatly within an entity, architecture,
+   --  package, process, block, generate, the depth is 0.
+   --  For a subprogram declared immediatly within a subprogram of level N,
+   --  the depth is N + 1.
+   --  Depth is used with depth of impure objects to check purity rules.
+   --  Field: Field10 (pos)
+   function Get_Subprogram_Depth (Target : Iir) return Iir_Int32;
+   procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32);
+
+   --  Hash of a subprogram profile.
+   --  This is used to speed up subprogram profile comparaison, which is very
+   --  often used by overload.
+   --  Field: Field11 (pos)
+   function Get_Subprogram_Hash (Target : Iir) return Iir_Int32;
+   procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32);
+   pragma Inline (Get_Subprogram_Hash);
+
+   --  Depth of the deepest impure object.
+   --  Field: Field3 (uc)
+   function Get_Impure_Depth (Target : Iir) return Iir_Int32;
+   procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32);
+
+   --  Field: Field1 Ref
+   function Get_Return_Type (Target : Iir) return Iir;
+   procedure Set_Return_Type (Target : Iir; Decl : Iir);
+   pragma Inline (Get_Return_Type);
+
+   --  Code of an implicit subprogram definition.
+   --  Field: Field9 (pos)
+   function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions;
+   procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions);
+
+   --  For an implicit subprogram, the type_reference is the type declaration
+   --  for which the implicit subprogram was defined.
+   --  Field: Field10 Ref
+   function Get_Type_Reference (Target : Iir) return Iir;
+   procedure Set_Type_Reference (Target : Iir; Decl : Iir);
+
+   --  Get the default value of an object declaration.
+   --  Null_iir if no default value.
+   --  Note that this node can be shared between declarations if they are
+   --  separated by comma, such as in:
+   --    variable a, b : integer := 5;
+   --  Field: Field6 Maybe_Ref
+   function Get_Default_Value (Target : Iir) return Iir;
+   procedure Set_Default_Value (Target : Iir; Value : Iir);
+
+   --  The deferred_declaration field points to the deferred constant
+   --  declaration for a full constant declaration, or is null_iir for a
+   --  usual or deferred constant declaration.
+   --  Set only during sem.
+   --  Field: Field7
+   function Get_Deferred_Declaration (Target : Iir) return Iir;
+   procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir);
+
+   --  The deferred_declaration_flag must be set if the constant declaration is
+   --  a deferred_constant declaration.
+   --  Set only during sem.
+   --  Field: Flag1
+   function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean;
+   procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean);
+
+   --  If true, the variable is declared shared.
+   --  Field: Flag2
+   function Get_Shared_Flag (Target : Iir) return Boolean;
+   procedure Set_Shared_Flag (Target : Iir; Shared : Boolean);
+
+   --  Get the design unit in which the target is declared.
+   --  For a library unit, this is to get the design unit node.
+   --  Field: Field0
+   function Get_Design_Unit (Target : Iir) return Iir;
+   procedure Set_Design_Unit (Target : Iir; Unit : Iir);
+
+   --  Field: Field7
+   function Get_Block_Statement (Target : Iir) return Iir;
+   procedure Set_Block_Statement (Target : Iir; Block : Iir);
+
+   --  For a non-resolved signal: null_iir if the signal has no driver, or
+   --  a process/concurrent_statement for which the signal should have a
+   --  driver.  This is used to catch at analyse time unresolved signals with
+   --  several drivers.
+   --  Field: Field7
+   function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir;
+   procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir);
+
+   --  Field: Field1 Chain
+   function Get_Declaration_Chain (Target : Iir) return Iir;
+   procedure Set_Declaration_Chain (Target : Iir; Decls : Iir);
+
+   --  Field: Field6
+   function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir;
+   procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir);
+
+   --  Field: Field7
+   function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir;
+   procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir);
+
+   --  Field: Field4 (pos)
+   function Get_Element_Position (Target : Iir) return Iir_Index32;
+   procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32);
+
+   --  Field: Field2
+   function Get_Element_Declaration (Target : Iir) return Iir;
+   procedure Set_Element_Declaration (Target : Iir; El : Iir);
+
+   --  Field: Field2 Ref
+   function Get_Selected_Element (Target : Iir) return Iir;
+   procedure Set_Selected_Element (Target : Iir; El : Iir);
+
+   --  Selected names of an use_clause are chained.
+   --  Field: Field3
+   function Get_Use_Clause_Chain (Target : Iir) return Iir;
+   procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir);
+
+   --  Selected name of an use_clause.
+   --  Field: Field1
+   function Get_Selected_Name (Target : Iir_Use_Clause) return Iir;
+   procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir);
+
+   --  The type declarator which declares the type definition DEF.
+   --  Field: Field3 Ref
+   function Get_Type_Declarator (Def : Iir) return Iir;
+   procedure Set_Type_Declarator (Def : Iir; Decl : Iir);
+
+   --  Field: Field2 (uc)
+   function Get_Enumeration_Literal_List (Target : Iir) return Iir_List;
+   procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List);
+
+   --  Field: Field1 Chain
+   function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir;
+   procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field1 (uc)
+   function Get_Group_Constituent_List (Group : Iir) return Iir_List;
+   procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List);
+
+   --  Chain of physical type units.
+   --  The first unit is the primary unit.  If you really need the primary
+   --  unit (and not the chain), you'd better to use Get_Primary_Unit.
+   --  Field: Field1 Chain
+   function Get_Unit_Chain (Target : Iir) return Iir;
+   procedure Set_Unit_Chain (Target : Iir; Chain : Iir);
+
+   --  Alias of Get_Unit_Chain.
+   --  Return the primary unit of a physical type.
+   --  Field: Field1 Ref
+   function Get_Primary_Unit (Target : Iir) return Iir;
+   procedure Set_Primary_Unit (Target : Iir; Unit : Iir);
+
+   --  Get/Set the identifier of a declaration.
+   --  Can also be used instead of get/set_label.
+   --  Field: Field3 (uc)
+   function Get_Identifier (Target : Iir) return Name_Id;
+   procedure Set_Identifier (Target : Iir; Identifier : Name_Id);
+   pragma Inline (Get_Identifier);
+
+   --  Field: Field3 (uc)
+   function Get_Label (Target : Iir) return Name_Id;
+   procedure Set_Label (Target : Iir; Label : Name_Id);
+
+   --  Get/Set the visible flag of a declaration.
+   --  The visible flag is true to make invalid the use of the identifier
+   --  during its declaration.  It is set to false when the identifier is added
+   --  to the name table, and set to true when the declaration is finished.
+   --  Field: Flag4
+   function Get_Visible_Flag (Target : Iir) return Boolean;
+   procedure Set_Visible_Flag (Target : Iir; Flag : Boolean);
+
+   --  Field: Field1
+   function Get_Range_Constraint (Target : Iir) return Iir;
+   procedure Set_Range_Constraint (Target : Iir; Constraint : Iir);
+
+   --  Field: State2 (pos)
+   function Get_Direction (Decl : Iir) return Iir_Direction;
+   procedure Set_Direction (Decl : Iir; Dir : Iir_Direction);
+
+   --  Field: Field2
+   function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir;
+   procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir);
+
+   --  Field: Field3
+   function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir;
+   procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir);
+
+   --  Field: Field4 Ref
+   function Get_Base_Type (Decl : Iir) return Iir;
+   procedure Set_Base_Type (Decl : Iir; Base_Type : Iir);
+   pragma Inline (Get_Base_Type);
+
+   --  Either a resolution function name, an array_element_resolution or a
+   --  record_resolution
+   --  Field: Field5
+   function Get_Resolution_Indication (Decl : Iir) return Iir;
+   procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir);
+
+   --  Field: Field1 Chain
+   function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir;
+   procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir);
+
+   --  Field: Field7
+   function Get_Tolerance (Def : Iir) return Iir;
+   procedure Set_Tolerance (Def : Iir; Tol : Iir);
+
+   --  Field: Field8
+   function Get_Plus_Terminal (Def : Iir) return Iir;
+   procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir);
+
+   --  Field: Field9
+   function Get_Minus_Terminal (Def : Iir) return Iir;
+   procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir);
+
+   --  Field: Field5
+   function Get_Simultaneous_Left (Def : Iir) return Iir;
+   procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir);
+
+   --  Field: Field6
+   function Get_Simultaneous_Right (Def : Iir) return Iir;
+   procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir);
+
+   --  True if ATYPE defines std.textio.text file type.
+   --  Field: Flag4
+   function Get_Text_File_Flag (Atype : Iir) return Boolean;
+   procedure Set_Text_File_Flag (Atype : Iir; Flag : Boolean);
+
+   --  True if enumeration type ATYPE has only character literals.
+   --  Field: Flag4
+   function Get_Only_Characters_Flag (Atype : Iir) return Boolean;
+   procedure Set_Only_Characters_Flag (Atype : Iir; Flag : Boolean);
+
+   --  Field: State1 (pos)
+   function Get_Type_Staticness (Atype : Iir) return Iir_Staticness;
+   procedure Set_Type_Staticness (Atype : Iir; Static : Iir_Staticness);
+
+   --  Field: State2 (pos)
+   function Get_Constraint_State (Atype : Iir) return Iir_Constraint;
+   procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint);
+
+   --  Reference either index_subtype_definition_list of array_type_definition
+   --  or index_constraint_list of array_subtype_definition.
+   --  Field: Field9 Ref (uc)
+   function Get_Index_Subtype_List (Decl : Iir) return Iir_List;
+   procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List);
+
+   --  List of type marks for indexes type of array types.
+   --  Field: Field6 (uc)
+   function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List;
+   procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List);
+
+   --  The subtype_indication as it appears in a array type declaration.
+   --  Field: Field2
+   function Get_Element_Subtype_Indication (Decl : Iir) return Iir;
+   procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir);
+
+   --  Field: Field1 Ref
+   function Get_Element_Subtype (Decl : Iir) return Iir;
+   procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir);
+
+   --  Field: Field6 (uc)
+   function Get_Index_Constraint_List (Def : Iir) return Iir_List;
+   procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List);
+
+   --  Field: Field8
+   function Get_Array_Element_Constraint (Def : Iir) return Iir;
+   procedure Set_Array_Element_Constraint (Def : Iir; El : Iir);
+
+   --  Chains of elements of a record.
+   --  Field: Field1 (uc)
+   function Get_Elements_Declaration_List (Decl : Iir) return Iir_List;
+   procedure Set_Elements_Declaration_List (Decl : Iir; List : Iir_List);
+
+   --  Field: Field1 Ref
+   function Get_Designated_Type (Target : Iir) return Iir;
+   procedure Set_Designated_Type (Target : Iir; Dtype : Iir);
+
+   --  Field: Field5
+   function Get_Designated_Subtype_Indication (Target : Iir) return Iir;
+   procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir);
+
+   --  List of indexes for indexed name.
+   --  Field: Field2 (uc)
+   function Get_Index_List (Decl : Iir) return Iir_List;
+   procedure Set_Index_List (Decl : Iir; List : Iir_List);
+
+   --  The terminal declaration for the reference (ground) of a nature
+   --  Field: Field2
+   function Get_Reference (Def : Iir) return Iir;
+   procedure Set_Reference (Def : Iir; Ref : Iir);
+
+   --  Field: Field3
+   function Get_Nature_Declarator (Def : Iir) return Iir;
+   procedure Set_Nature_Declarator (Def : Iir; Decl : Iir);
+
+   --  Field: Field7
+   function Get_Across_Type (Def : Iir) return Iir;
+   procedure Set_Across_Type (Def : Iir; Atype : Iir);
+
+   --  Field: Field8
+   function Get_Through_Type (Def : Iir) return Iir;
+   procedure Set_Through_Type (Def : Iir; Atype : Iir);
+
+   --  Field: Field1
+   function Get_Target (Target : Iir) return Iir;
+   procedure Set_Target (Target : Iir; Atarget : Iir);
+
+   --  Field: Field5 Chain
+   function Get_Waveform_Chain (Target : Iir) return Iir;
+   procedure Set_Waveform_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field8
+   function Get_Guard (Target : Iir) return Iir;
+   procedure Set_Guard (Target : Iir; Guard : Iir);
+
+   --  Field: Field12 (pos)
+   function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism;
+   procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism);
+
+   --  Field: Field6
+   function Get_Reject_Time_Expression (Target : Iir) return Iir;
+   procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir);
+
+   --  Field: Field6 (uc)
+   function Get_Sensitivity_List (Wait : Iir) return Iir_List;
+   procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List);
+
+   --  Field: Field8
+   function Get_Process_Origin (Proc : Iir) return Iir;
+   procedure Set_Process_Origin (Proc : Iir; Orig : Iir);
+
+   --  Field: Field5
+   function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir;
+   procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir);
+
+   --  Field: Field1
+   function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir;
+   procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir);
+
+   --  If set, the concurrent statement is postponed.
+   --  Field: Flag3
+   function Get_Postponed_Flag (Target : Iir) return Boolean;
+   procedure Set_Postponed_Flag (Target : Iir; Value : Boolean);
+
+   --  Returns the list of subprogram called in this subprogram or process.
+   --  Note: implicit function (such as implicit operators) are omitted
+   --  from this list, since the purpose of this list is to correctly set
+   --  flags for side effects (purity_state, wait_state).
+   --  Can return null_iir if there is no subprogram called.
+   --  Field: Field7 Of_Ref (uc)
+   function Get_Callees_List (Proc : Iir) return Iir_List;
+   procedure Set_Callees_List (Proc : Iir; List : Iir_List);
+
+   --  Get/Set the passive flag of a process.
+   --   TRUE if the process must be passive.
+   --   FALSE if the process may be not passive.
+   --  For a procedure declaration, set if it is passive.
+   --  Field: Flag2
+   function Get_Passive_Flag (Proc : Iir) return Boolean;
+   procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean);
+
+   --  True if the function is used as a resolution function.
+   --  Field: Flag7
+   function Get_Resolution_Function_Flag (Func : Iir) return Boolean;
+   procedure Set_Resolution_Function_Flag (Func : Iir; Flag : Boolean);
+
+   --  Get/Set the wait state of the current subprogram or process.
+   --  TRUE if it contains a wait statement, either directly or
+   --   indirectly.
+   --  FALSE if it doesn't contain a wait statement.
+   --  UNKNOWN if the wait status is not yet known.
+   --  Field: State1 (pos)
+   function Get_Wait_State (Proc : Iir) return Tri_State_Type;
+   procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type);
+
+   --  Get/Set wether the subprogram may be called by a sensitized process
+   --  whose sensitivity list is ALL.
+   --  FALSE if declared in a package unit and reads a signal that is not
+   --    one of its interface, or if it calls such a subprogram.
+   --  TRUE if it doesn't call a subprogram whose state is False and
+   --    either doesn't read a signal or declared within an entity or
+   --    architecture.
+   --  UNKNOWN if the status is not yet known.
+   --  Field: State3 (pos)
+   function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized;
+   procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized);
+
+   --  Get/Set the seen flag.
+   --  Used when the graph of callees is walked, to avoid infinite loops, since
+   --  the graph is not a DAG (there may be cycles).
+   --  Field: Flag1
+   function Get_Seen_Flag (Proc : Iir) return Boolean;
+   procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean);
+
+   --  Get/Set the pure flag of a function.
+   --  TRUE if the function is declared pure.
+   --  FALSE if the function is declared impure.
+   --  Field: Flag2
+   function Get_Pure_Flag (Func : Iir) return Boolean;
+   procedure Set_Pure_Flag (Func : Iir; Flag : Boolean);
+
+   --  Get/Set the foreign flag of a declaration.
+   --  TRUE if the declaration was decored with the std.foreign attribute.
+   --  Field: Flag3
+   function Get_Foreign_Flag (Decl : Iir) return Boolean;
+   procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean);
+
+   --  Get/Set the resolved flag of a subtype definition.
+   --  A subtype definition may be resolved either because a
+   --  resolution_indication is present in the subtype_indication, or
+   --  because all elements type are resolved.
+   --  Field: Flag1
+   function Get_Resolved_Flag (Atype : Iir) return Boolean;
+   procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean);
+
+   --  Get/Set the signal_type flag of a type/subtype definition.
+   --  This flags indicates whether the type can be used as a signal type.
+   --  Access types, file types and composite types whose a sub-element is
+   --  an access type cannot be used as a signal type.
+   --  Field: Flag2
+   function Get_Signal_Type_Flag (Atype : Iir) return Boolean;
+   procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean);
+
+   --  True if ATYPE is used to declare a signal or to handle a signal
+   --   (such as slice or aliases).
+   --  Field: Flag3
+   function Get_Has_Signal_Flag (Atype : Iir) return Boolean;
+   procedure Set_Has_Signal_Flag (Atype : Iir; Flag : Boolean);
+
+   --  Get/Set the purity status of a subprogram.
+   --  Field: State2 (pos)
+   function Get_Purity_State (Proc : Iir) return Iir_Pure_State;
+   procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State);
+
+   --  Set during binding when DESIGN is added in a list of file to bind.
+   --  Field: Flag3
+   function Get_Elab_Flag (Design : Iir) return Boolean;
+   procedure Set_Elab_Flag (Design : Iir; Flag : Boolean);
+
+   --  Set on an array_subtype if there is an index constraint.
+   --  If not set, the subtype is unconstrained.
+   --  Field: Flag4
+   function Get_Index_Constraint_Flag (Atype : Iir) return Boolean;
+   procedure Set_Index_Constraint_Flag (Atype : Iir; Flag : Boolean);
+
+   --  Condition of an assertion.
+   --  Field: Field1
+   function Get_Assertion_Condition (Target : Iir) return Iir;
+   procedure Set_Assertion_Condition (Target : Iir; Cond : Iir);
+
+   --  Report expression of an assertion or report statement.
+   --  Field: Field6
+   function Get_Report_Expression (Target : Iir) return Iir;
+   procedure Set_Report_Expression (Target : Iir; Expr : Iir);
+
+   --  Severity expression of an assertion or report statement.
+   --  Field: Field5
+   function Get_Severity_Expression (Target : Iir) return Iir;
+   procedure Set_Severity_Expression (Target : Iir; Expr : Iir);
+
+   --  Instantiated unit of a component instantiation statement.
+   --  Field: Field1
+   function Get_Instantiated_Unit (Target : Iir) return Iir;
+   procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir);
+
+   --  Generic map aspect list.
+   --  Field: Field8 Chain
+   function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir;
+   procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir);
+
+   --  Port map aspect list.
+   --  Field: Field9 Chain
+   function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir;
+   procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir);
+
+   --  Configuration of an entity_aspect_configuration.
+   --  Field: Field1
+   function Get_Configuration_Name (Target : Iir) return Iir;
+   procedure Set_Configuration_Name (Target : Iir; Conf : Iir);
+
+   --  Component configuration for a component_instantiation_statement.
+   --  Field: Field6
+   function Get_Component_Configuration (Target : Iir) return Iir;
+   procedure Set_Component_Configuration (Target : Iir; Conf : Iir);
+
+   --  Configuration specification for a component_instantiation_statement.
+   --  Field: Field7
+   function Get_Configuration_Specification (Target : Iir) return Iir;
+   procedure Set_Configuration_Specification (Target : Iir; Conf : Iir);
+
+   --  Set/Get the default binding indication of a configuration specification
+   --  or a component configuration.
+   --  Field: Field5
+   function Get_Default_Binding_Indication (Target : Iir) return Iir;
+   procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir);
+
+   --  Set/Get the default configuration of an architecture.
+   --  Field: Field6
+   function Get_Default_Configuration_Declaration (Target : Iir) return Iir;
+   procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir);
+
+   --  Expression for an various nodes.
+   --  Field: Field5
+   function Get_Expression (Target : Iir) return Iir;
+   procedure Set_Expression (Target : Iir; Expr : Iir);
+
+   --  Set to the designated type (either the type of the expression or the
+   --  subtype) when the expression is analyzed.
+   --  Field: Field2 Ref
+   function Get_Allocator_Designated_Type (Target : Iir) return Iir;
+   procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir);
+
+   --  Field: Field7 Chain
+   function Get_Selected_Waveform_Chain (Target : Iir) return Iir;
+   procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field7 Chain
+   function Get_Conditional_Waveform_Chain (Target : Iir) return Iir;
+   procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir);
+
+   --  Expression defining the value of the implicit guard signal.
+   --  Field: Field2
+   function Get_Guard_Expression (Target : Iir) return Iir;
+   procedure Set_Guard_Expression (Target : Iir; Expr : Iir);
+
+   --  The declaration (if any) of the implicit guard signal of a block
+   --  statement.
+   --  Field: Field8
+   function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir;
+   procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir);
+
+   --  Sensitivity list for the implicit guard signal.
+   --  Field: Field6 (uc)
+   function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List;
+   procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List);
+
+   --  Block_Configuration that applies to this block statement.
+   --  Field: Field6
+   function Get_Block_Block_Configuration (Block : Iir) return Iir;
+   procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir);
+
+   --  Field: Field5
+   function Get_Package_Header (Pkg : Iir) return Iir;
+   procedure Set_Package_Header (Pkg : Iir; Header : Iir);
+
+   --  Field: Field7
+   function Get_Block_Header (Target : Iir) return Iir;
+   procedure Set_Block_Header (Target : Iir; Header : Iir);
+
+   --  Field: Field5
+   function Get_Uninstantiated_Package_Name (Inst : Iir) return Iir;
+   procedure Set_Uninstantiated_Package_Name (Inst : Iir; Name : Iir);
+
+   --  Get/Set the block_configuration (there may be several
+   --  block_configuration through the use of prev_configuration singly linked
+   --  list) that apply to this generate statement.
+   --  Field: Field7
+   function Get_Generate_Block_Configuration (Target : Iir) return Iir;
+   procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir);
+
+   --  Field: Field6
+   function Get_Generation_Scheme (Target : Iir) return Iir;
+   procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir);
+
+   --  Condition of a conditionam_waveform, if_statement, elsif,
+   --  while_loop_statement, next_statement or exit_statement.
+   --  Field: Field1
+   function Get_Condition (Target : Iir) return Iir;
+   procedure Set_Condition (Target : Iir; Condition : Iir);
+
+   --  Field: Field6
+   function Get_Else_Clause (Target : Iir) return Iir;
+   procedure Set_Else_Clause (Target : Iir; Clause : Iir);
+
+   --  Iterator of a for_loop_statement.
+   --  Field: Field1
+   function Get_Parameter_Specification (Target : Iir) return Iir;
+   procedure Set_Parameter_Specification (Target : Iir; Param : Iir);
+
+   --  Get/Set the statement in which TARGET appears.  This is used to check
+   --  if next/exit is in a loop.
+   --  Field: Field0 Ref
+   function Get_Parent (Target : Iir) return Iir;
+   procedure Set_Parent (Target : Iir; Parent : Iir);
+
+   --  Loop label for an exit_statement or next_statement.
+   --  Field: Field5
+   function Get_Loop_Label (Target : Iir) return Iir;
+   procedure Set_Loop_Label (Target : Iir; Stmt : Iir);
+
+   --  Component name for a component_configuration or
+   --  a configuration_specification.
+   --  Field: Field4
+   function Get_Component_Name (Target : Iir) return Iir;
+   procedure Set_Component_Name (Target : Iir; Name : Iir);
+
+   --  Field: Field1 (uc)
+   function Get_Instantiation_List (Target : Iir) return Iir_List;
+   procedure Set_Instantiation_List (Target : Iir; List : Iir_List);
+
+   --  Field: Field3
+   function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir;
+   procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir);
+
+   --  Field: Field1
+   function Get_Default_Entity_Aspect (Target : Iir) return Iir;
+   procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir);
+
+   --  Field: Field6 Chain
+   function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir;
+   procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field7 Chain
+   function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir;
+   procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir);
+
+   --  Field: Field3
+   function Get_Binding_Indication (Target : Iir) return Iir;
+   procedure Set_Binding_Indication (Target : Iir; Binding : Iir);
+
+   --  The named entity designated by a name.
+   --  Field: Field4 Ref
+   function Get_Named_Entity (Name : Iir) return Iir;
+   procedure Set_Named_Entity (Name : Iir; Val : Iir);
+
+   --  If a name designate a non-object alias, the designated alias.
+   --  Named_Entity will designate the aliased entity.
+   --  Field: Field2
+   function Get_Alias_Declaration (Name : Iir) return Iir;
+   procedure Set_Alias_Declaration (Name : Iir; Val : Iir);
+
+   --  Expression staticness, defined by rules of LRM 7.4
+   --  Field: State1 (pos)
+   function Get_Expr_Staticness (Target : Iir) return Iir_Staticness;
+   procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness);
+
+   --  Node which couldn't be correctly analyzed.
+   --  Field: Field2
+   function Get_Error_Origin (Target : Iir) return Iir;
+   procedure Set_Error_Origin (Target : Iir; Origin : Iir);
+
+   --  Operand of a monadic operator.
+   --  Field: Field2
+   function Get_Operand (Target : Iir) return Iir;
+   procedure Set_Operand (Target : Iir; An_Iir : Iir);
+
+   --  Left operand of a dyadic operator.
+   --  Field: Field2
+   function Get_Left (Target : Iir) return Iir;
+   procedure Set_Left (Target : Iir; An_Iir : Iir);
+
+   --  Right operand of a dyadic operator.
+   --  Field: Field4
+   function Get_Right (Target : Iir) return Iir;
+   procedure Set_Right (Target : Iir; An_Iir : Iir);
+
+   --  Field: Field3
+   function Get_Unit_Name (Target : Iir) return Iir;
+   procedure Set_Unit_Name (Target : Iir; Name : Iir);
+
+   --  Field: Field4
+   function Get_Name (Target : Iir) return Iir;
+   procedure Set_Name (Target : Iir; Name : Iir);
+
+   --  Field: Field5
+   function Get_Group_Template_Name (Target : Iir) return Iir;
+   procedure Set_Group_Template_Name (Target : Iir; Name : Iir);
+
+   --  Staticness of a name, according to rules of LRM 6.1
+   --  Field: State2 (pos)
+   function Get_Name_Staticness (Target : Iir) return Iir_Staticness;
+   procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness);
+
+   --  Prefix of a name.
+   --  Field: Field0
+   function Get_Prefix (Target : Iir) return Iir;
+   procedure Set_Prefix (Target : Iir; Prefix : Iir);
+
+   --  Prefix of a name signature
+   --  Field: Field1 Ref
+   function Get_Signature_Prefix (Sign : Iir) return Iir;
+   procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir);
+
+   --  The subtype of a slice.  Contrary to the Type field, this is not a
+   --  reference.
+   --  Field: Field3
+   function Get_Slice_Subtype (Slice : Iir) return Iir;
+   procedure Set_Slice_Subtype (Slice : Iir; Atype : Iir);
+
+   --  Suffix of a slice or attribute.
+   --  Field: Field2
+   function Get_Suffix (Target : Iir) return Iir;
+   procedure Set_Suffix (Target : Iir; Suffix : Iir);
+
+   --  Set the designated index subtype of an array attribute.
+   --  Field: Field2
+   function Get_Index_Subtype (Attr : Iir) return Iir;
+   procedure Set_Index_Subtype (Attr : Iir; St : Iir);
+
+   --  Parameter of an attribute.
+   --  Field: Field4
+   function Get_Parameter (Target : Iir) return Iir;
+   procedure Set_Parameter (Target : Iir; Param : Iir);
+
+   --  Type of the actual for an association by individual.
+   --  Unless the formal is an unconstrained array type, this is the same as
+   --  the formal type.
+   --  Field: Field3
+   function Get_Actual_Type (Target : Iir) return Iir;
+   procedure Set_Actual_Type (Target : Iir; Atype : Iir);
+
+   --  Interface for a package association.
+   --  Field: Field4 Ref
+   function Get_Associated_Interface (Assoc : Iir) return Iir;
+   procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir);
+
+   --  List of individual associations for association_element_by_individual.
+   --  Associations for parenthesis_name.
+   --  Field: Field2 Chain
+   function Get_Association_Chain (Target : Iir) return Iir;
+   procedure Set_Association_Chain (Target : Iir; Chain : Iir);
+
+   --  List of individual associations for association_element_by_individual.
+   --  Field: Field4 Chain
+   function Get_Individual_Association_Chain (Target : Iir) return Iir;
+   procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir);
+
+   --  Get/Set info for the aggregate.
+   --  There is one aggregate_info for for each dimension.
+   --  Field: Field2
+   function Get_Aggregate_Info (Target : Iir) return Iir;
+   procedure Set_Aggregate_Info (Target : Iir; Info : Iir);
+
+   --  Get/Set the info node for the next dimension.
+   --  Field: Field1
+   function Get_Sub_Aggregate_Info (Target : Iir) return Iir;
+   procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir);
+
+   --  TRUE when the length of the aggregate is not locally static.
+   --  Field: Flag3
+   function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean;
+   procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean);
+
+   --  Get/Set the minimum number of elements for the lowest dimension of
+   --  the aggregate or for the current dimension of a sub-aggregate.
+   --  The real number of elements may be greater than this number if there
+   --  is an 'other' choice.
+   --  Field: Field4 (uc)
+   function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32;
+   procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32);
+
+   --  Highest index choice, if any.
+   --  Field: Field2
+   function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir;
+   procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir);
+
+   --  Highest index choice, if any.
+   --  Field: Field3
+   function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir;
+   procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir);
+
+   --  True if the aggregate has an 'others' choice.
+   --  Field: Flag2
+   function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean;
+   procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean);
+
+   --  True if the aggregate have named associations.
+   --  Field: Flag4
+   function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean;
+   procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean);
+
+   --  Staticness of the expressions in an aggregate.
+   --  We can't use expr_staticness for this purpose, since the staticness
+   --  of an aggregate is at most globally.
+   --  Field: State2 (pos)
+   function Get_Value_Staticness (Target : Iir) return Iir_Staticness;
+   procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness);
+
+   --  Chain of choices.
+   --  Field: Field4 Chain
+   function Get_Association_Choices_Chain (Target : Iir) return Iir;
+   procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir);
+
+   --  Chain of choices.
+   --  Field: Field1 Chain
+   function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir;
+   procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir);
+
+   --  Staticness of the choice.
+   --  Field: State2 (pos)
+   function Get_Choice_Staticness (Target : Iir) return Iir_Staticness;
+   procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness);
+
+   --  Field: Field1
+   function Get_Procedure_Call (Stmt : Iir) return Iir;
+   procedure Set_Procedure_Call (Stmt : Iir; Call : Iir);
+
+   --  Subprogram to be called by a procedure, function call or operator.  This
+   --  is the declaration of the subprogram (or a list of during analysis).
+   --  Field: Field3 Ref
+   function Get_Implementation (Target : Iir) return Iir;
+   procedure Set_Implementation (Target : Iir; Decl : Iir);
+
+   --  Paramater associations for procedure and function call.
+   --  Field: Field2 Chain
+   function Get_Parameter_Association_Chain (Target : Iir) return Iir;
+   procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir);
+
+   --  Object of a method call.  NULL_IIR if the subprogram is not a method.
+   --  Field: Field4
+   function Get_Method_Object (Target : Iir) return Iir;
+   procedure Set_Method_Object (Target : Iir; Object : Iir);
+
+   --  The type_mark that appeared in the subtype indication.  This is a name.
+   --  May be null_iir if there is no type mark (as in an iterator).
+   --  Field: Field2
+   function Get_Subtype_Type_Mark (Target : Iir) return Iir;
+   procedure Set_Subtype_Type_Mark (Target : Iir; Mark : Iir);
+
+   --  Field: Field3
+   function Get_Type_Conversion_Subtype (Target : Iir) return Iir;
+   procedure Set_Type_Conversion_Subtype (Target : Iir; Atype : Iir);
+
+   --  The type_mark that appeared in qualified expressions or type
+   --  conversions.
+   --  Field: Field4
+   function Get_Type_Mark (Target : Iir) return Iir;
+   procedure Set_Type_Mark (Target : Iir; Mark : Iir);
+
+   --  The type of values for a type file.
+   --  Field: Field2
+   function Get_File_Type_Mark (Target : Iir) return Iir;
+   procedure Set_File_Type_Mark (Target : Iir; Mark : Iir);
+
+   --  Field: Field8
+   function Get_Return_Type_Mark (Target : Iir) return Iir;
+   procedure Set_Return_Type_Mark (Target : Iir; Mark : Iir);
+
+   --  Get/set the lexical layout of an interface.
+   --  Field: Odigit2 (pos)
+   function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type;
+   procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type);
+
+   --  List of use (designated type of access types) of an incomplete type
+   --  definition.  The purpose is to complete the uses with the full type
+   --  definition.
+   --  Field: Field2 (uc)
+   function Get_Incomplete_Type_List (Target : Iir) return Iir_List;
+   procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List);
+
+   --  This flag is set on a signal_declaration, when a disconnection
+   --  specification applies to the signal (or a subelement of it).
+   --  This is used to check 'others' and 'all' designators.
+   --  Field: Flag1
+   function Get_Has_Disconnect_Flag (Target : Iir) return Boolean;
+   procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean);
+
+   --  This flag is set on a signal when its activity is read by the user.
+   --  Some signals handling can be optimized when this flag is set.
+   --  Field: Flag2
+   function Get_Has_Active_Flag (Target : Iir) return Boolean;
+   procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean);
+
+   --  This flag is set is code being analyzed is textually within TARGET.
+   --  This is used for selected by name rule.
+   --  Field: Flag5
+   function Get_Is_Within_Flag (Target : Iir) return Boolean;
+   procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean);
+
+   --  List of type_mark for an Iir_Kind_Signature
+   --  Field: Field2 (uc)
+   function Get_Type_Marks_List (Target : Iir) return Iir_List;
+   procedure Set_Type_Marks_List (Target : Iir; List : Iir_List);
+
+   --  Field: Flag1
+   function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean;
+   procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean);
+
+   --  Field: Field5
+   function Get_Alias_Signature (Alias : Iir) return Iir;
+   procedure Set_Alias_Signature (Alias : Iir; Signature : Iir);
+
+   --  Field: Field2
+   function Get_Attribute_Signature (Attr : Iir) return Iir;
+   procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir);
+
+   --  Field: Field1 Of_Ref (uc)
+   function Get_Overload_List (Target : Iir) return Iir_List;
+   procedure Set_Overload_List (Target : Iir; List : Iir_List);
+
+   --  Identifier of the simple_name attribute.
+   --  Field: Field3 (uc)
+   function Get_Simple_Name_Identifier (Target : Iir) return Name_Id;
+   procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id);
+
+   --  Subtype for Simple_Name attribute.
+   --  Field: Field4
+   function Get_Simple_Name_Subtype (Target : Iir) return Iir;
+   procedure Set_Simple_Name_Subtype (Target : Iir; Atype : Iir);
+
+   --  Body of a protected type declaration.
+   --  Field: Field2
+   function Get_Protected_Type_Body (Target : Iir) return Iir;
+   procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir);
+
+   --  Corresponsing protected type declaration of a protected type body.
+   --  Field: Field4
+   function Get_Protected_Type_Declaration (Target : Iir) return Iir;
+   procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir);
+
+   --  Location of the 'end' token.
+   --  Field: Field6 (uc)
+   function Get_End_Location (Target : Iir) return Location_Type;
+   procedure Set_End_Location (Target : Iir; Loc : Location_Type);
+
+   --  For a string literal: the string identifier.
+   --  Field: Field3 (uc)
+   function Get_String_Id (Lit : Iir) return String_Id;
+   procedure Set_String_Id (Lit : Iir; Id : String_Id);
+
+   --  For a string literal: the string length.
+   --  Field: Field4 (uc)
+   function Get_String_Length (Lit : Iir) return Int32;
+   procedure Set_String_Length (Lit : Iir; Len : Int32);
+
+   --  For a declaration: true if the declaration is used somewhere.
+   --  Field: Flag6
+   function Get_Use_Flag (Decl : Iir) return Boolean;
+   procedure Set_Use_Flag (Decl : Iir; Val : Boolean);
+
+   --  Layout flag: true if 'end' is followed by the reserved identifier.
+   --  Field: Flag8
+   function Get_End_Has_Reserved_Id (Decl : Iir) return Boolean;
+   procedure Set_End_Has_Reserved_Id (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if 'end' is followed by the identifier.
+   --  Field: Flag9
+   function Get_End_Has_Identifier (Decl : Iir) return Boolean;
+   procedure Set_End_Has_Identifier (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if 'end' is followed by 'postponed'.
+   --  Field: Flag10
+   function Get_End_Has_Postponed (Decl : Iir) return Boolean;
+   procedure Set_End_Has_Postponed (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if 'begin' is present.
+   --  Field: Flag10
+   function Get_Has_Begin (Decl : Iir) return Boolean;
+   procedure Set_Has_Begin (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if 'is' is present.
+   --  Field: Flag7
+   function Get_Has_Is (Decl : Iir) return Boolean;
+   procedure Set_Has_Is (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if 'pure' or 'impure' is present.
+   --  Field: Flag8
+   function Get_Has_Pure (Decl : Iir) return Boolean;
+   procedure Set_Has_Pure (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag: true if body appears just after the specification.
+   --  Field: Flag9
+   function Get_Has_Body (Decl : Iir) return Boolean;
+   procedure Set_Has_Body (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag for object declaration.  If True, the identifier of this
+   --  declaration is followed by an identifier (and separated by a comma).
+   --  This flag is set on all but the last declarations.
+   --  Eg: on 'signal A, B, C : Bit', the flag is set on A and B (but not C).
+   --  Field: Flag3
+   function Get_Has_Identifier_List (Decl : Iir) return Boolean;
+   procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean);
+
+   --  Layout flag for object declaration.  If True, the mode is present.
+   --  Field: Flag8
+   function Get_Has_Mode (Decl : Iir) return Boolean;
+   procedure Set_Has_Mode (Decl : Iir; Flag : Boolean);
+
+   --  Set to True if Maybe_Ref fields are references.  This cannot be shared
+   --  with Has_Identifier_List as: Is_Ref is set to True on all items but
+   --  the first, while Has_Identifier_List is set to True on all items but
+   --  the last.  Furthermore Is_Ref appears in nodes where Has_Identifier_List
+   --  is not present.
+   --  Field: Flag7
+   function Get_Is_Ref (N : Iir) return Boolean;
+   procedure Set_Is_Ref (N : Iir; Ref : Boolean);
+
+   --  Field: Field1 (uc)
+   function Get_Psl_Property (Decl : Iir) return PSL_Node;
+   procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node);
+
+   --  Field: Field1 (uc)
+   function Get_Psl_Declaration (Decl : Iir) return PSL_Node;
+   procedure Set_Psl_Declaration (Decl : Iir; Prop : PSL_Node);
+
+   --  Field: Field3 (uc)
+   function Get_Psl_Expression (Decl : Iir) return PSL_Node;
+   procedure Set_Psl_Expression (Decl : Iir; Prop : PSL_Node);
+
+   --  Field: Field1 (uc)
+   function Get_Psl_Boolean (N : Iir) return PSL_Node;
+   procedure Set_Psl_Boolean (N : Iir; Bool : PSL_Node);
+
+   --  Field: Field7 (uc)
+   function Get_PSL_Clock (N : Iir) return PSL_Node;
+   procedure Set_PSL_Clock (N : Iir; Clock : PSL_Node);
+
+   --  Field: Field8 (uc)
+   function Get_PSL_NFA (N : Iir) return PSL_NFA;
+   procedure Set_PSL_NFA (N : Iir; Fa : PSL_NFA);
+end Iirs;
diff --git a/src/iirs_utils.adb b/src/iirs_utils.adb
new file mode 100644
index 000000000..52c1ee8bb
--- /dev/null
+++ b/src/iirs_utils.adb
@@ -0,0 +1,1131 @@
+--  Common operations on nodes.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Scanner; use Scanner;
+with Tokens; use Tokens;
+with Errorout; use Errorout;
+with Name_Table;
+with Str_Table;
+with Std_Names; use Std_Names;
+with Flags; use Flags;
+with PSL.Nodes;
+with Sem_Inst;
+
+package body Iirs_Utils is
+   -- Transform the current token into an iir literal.
+   -- The current token must be either a character or an identifier.
+   function Current_Text return Iir is
+      Res: Iir;
+   begin
+      case Current_Token is
+         when Tok_Identifier =>
+            Res := Create_Iir (Iir_Kind_Simple_Name);
+         when Tok_Character =>
+            Res := Create_Iir (Iir_Kind_Character_Literal);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Set_Identifier (Res, Current_Identifier);
+      Invalidate_Current_Identifier;
+      Invalidate_Current_Token;
+      Set_Location (Res, Get_Token_Location);
+      return Res;
+   end Current_Text;
+
+   function Is_Error (N : Iir) return Boolean is
+   begin
+      return Get_Kind (N) = Iir_Kind_Error;
+   end Is_Error;
+
+   function Get_Operator_Name (Op : Iir) return Name_Id is
+   begin
+      case Get_Kind (Op) is
+         when Iir_Kind_And_Operator
+           | Iir_Kind_Reduction_And_Operator =>
+            return Name_And;
+         when Iir_Kind_Or_Operator
+           | Iir_Kind_Reduction_Or_Operator =>
+            return Name_Or;
+         when Iir_Kind_Nand_Operator
+           | Iir_Kind_Reduction_Nand_Operator =>
+            return Name_Nand;
+         when Iir_Kind_Nor_Operator
+           | Iir_Kind_Reduction_Nor_Operator =>
+            return Name_Nor;
+         when Iir_Kind_Xor_Operator
+           | Iir_Kind_Reduction_Xor_Operator =>
+            return Name_Xor;
+         when Iir_Kind_Xnor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator =>
+            return Name_Xnor;
+
+         when Iir_Kind_Equality_Operator =>
+            return Name_Op_Equality;
+         when Iir_Kind_Inequality_Operator =>
+            return Name_Op_Inequality;
+         when Iir_Kind_Less_Than_Operator =>
+            return Name_Op_Less;
+         when Iir_Kind_Less_Than_Or_Equal_Operator =>
+            return Name_Op_Less_Equal;
+         when Iir_Kind_Greater_Than_Operator =>
+            return Name_Op_Greater;
+         when Iir_Kind_Greater_Than_Or_Equal_Operator =>
+            return Name_Op_Greater_Equal;
+
+         when Iir_Kind_Match_Equality_Operator =>
+            return Name_Op_Match_Equality;
+         when Iir_Kind_Match_Inequality_Operator =>
+            return Name_Op_Match_Inequality;
+         when Iir_Kind_Match_Less_Than_Operator =>
+            return Name_Op_Match_Less;
+         when Iir_Kind_Match_Less_Than_Or_Equal_Operator =>
+            return Name_Op_Match_Less_Equal;
+         when Iir_Kind_Match_Greater_Than_Operator =>
+            return Name_Op_Match_Greater;
+         when Iir_Kind_Match_Greater_Than_Or_Equal_Operator =>
+            return Name_Op_Match_Greater_Equal;
+
+         when Iir_Kind_Sll_Operator =>
+            return Name_Sll;
+         when Iir_Kind_Sla_Operator =>
+            return Name_Sla;
+         when Iir_Kind_Srl_Operator =>
+            return Name_Srl;
+         when Iir_Kind_Sra_Operator =>
+            return Name_Sra;
+         when Iir_Kind_Rol_Operator =>
+            return Name_Rol;
+         when Iir_Kind_Ror_Operator =>
+            return Name_Ror;
+         when Iir_Kind_Addition_Operator =>
+            return Name_Op_Plus;
+         when Iir_Kind_Substraction_Operator =>
+            return Name_Op_Minus;
+         when Iir_Kind_Concatenation_Operator =>
+            return Name_Op_Concatenation;
+         when Iir_Kind_Multiplication_Operator =>
+            return Name_Op_Mul;
+         when Iir_Kind_Division_Operator =>
+            return Name_Op_Div;
+         when Iir_Kind_Modulus_Operator =>
+            return Name_Mod;
+         when Iir_Kind_Remainder_Operator =>
+            return Name_Rem;
+         when Iir_Kind_Exponentiation_Operator =>
+            return Name_Op_Exp;
+         when Iir_Kind_Not_Operator =>
+            return Name_Not;
+         when Iir_Kind_Negation_Operator =>
+            return Name_Op_Minus;
+         when Iir_Kind_Identity_Operator =>
+            return Name_Op_Plus;
+         when Iir_Kind_Absolute_Operator =>
+            return Name_Abs;
+         when Iir_Kind_Condition_Operator =>
+            return Name_Op_Condition;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Operator_Name;
+
+   function Get_Longuest_Static_Prefix (Expr: Iir) return Iir is
+      Adecl: Iir;
+   begin
+      Adecl := Expr;
+      loop
+         case Get_Kind (Adecl) is
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_Interface_Variable_Declaration =>
+               return Adecl;
+            when Iir_Kind_Constant_Declaration
+              | Iir_Kind_Interface_Constant_Declaration =>
+               return Adecl;
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Guard_Signal_Declaration
+              | Iir_Kind_Interface_Signal_Declaration =>
+               return Adecl;
+            when Iir_Kind_Object_Alias_Declaration =>
+               --  LRM 4.3.3.1 Object Aliases
+               --  2.  The name must be a static name [...]
+               return Adecl;
+            when Iir_Kind_Slice_Name
+              | Iir_Kind_Indexed_Name
+              | Iir_Kind_Selected_Element =>
+               if Get_Name_Staticness (Adecl) >= Globally then
+                  return Adecl;
+               else
+                  Adecl := Get_Prefix (Adecl);
+               end if;
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               Adecl := Get_Named_Entity (Adecl);
+            when Iir_Kind_Type_Conversion =>
+               return Null_Iir;
+            when others =>
+               Error_Kind ("get_longuest_static_prefix", Adecl);
+         end case;
+      end loop;
+   end Get_Longuest_Static_Prefix;
+
+   function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True)
+                              return Iir
+   is
+      Adecl : Iir;
+   begin
+      Adecl := Name;
+      loop
+         case Get_Kind (Adecl) is
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_Interface_Variable_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Interface_Constant_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Guard_Signal_Declaration
+              | Iir_Kind_Interface_Signal_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_Interface_File_Declaration
+              | Iir_Kind_Iterator_Declaration =>
+               return Adecl;
+            when Iir_Kind_Object_Alias_Declaration =>
+               if With_Alias then
+                  Adecl := Get_Name (Adecl);
+               else
+                  return Adecl;
+               end if;
+            when Iir_Kind_Indexed_Name
+              | Iir_Kind_Slice_Name
+              | Iir_Kind_Selected_Element
+              | Iir_Kind_Selected_By_All_Name =>
+               Adecl := Get_Base_Name (Adecl);
+            when Iir_Kinds_Literal
+              | Iir_Kind_Enumeration_Literal
+              | Iir_Kinds_Monadic_Operator
+              | Iir_Kinds_Dyadic_Operator
+              | Iir_Kind_Function_Call
+              | Iir_Kind_Qualified_Expression
+              | Iir_Kind_Type_Conversion
+              | Iir_Kind_Allocator_By_Expression
+              | Iir_Kind_Allocator_By_Subtype
+              | Iir_Kinds_Attribute
+              | Iir_Kind_Attribute_Value
+              | Iir_Kind_Aggregate
+              | Iir_Kind_Simple_Aggregate
+              | Iir_Kind_Dereference
+              | Iir_Kind_Implicit_Dereference
+              | Iir_Kind_Unit_Declaration
+              | Iir_Kinds_Concurrent_Statement =>
+               return Adecl;
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               Adecl := Get_Named_Entity (Adecl);
+            when Iir_Kind_Attribute_Name =>
+               return Get_Named_Entity (Adecl);
+            when others =>
+               Error_Kind ("get_object_prefix", Adecl);
+         end case;
+      end loop;
+   end Get_Object_Prefix;
+
+   function Get_Association_Interface (Assoc : Iir) return Iir
+   is
+      Formal : Iir;
+   begin
+      Formal := Get_Formal (Assoc);
+      loop
+         case Get_Kind (Formal) is
+            when Iir_Kind_Simple_Name =>
+               return Get_Named_Entity (Formal);
+            when Iir_Kinds_Interface_Object_Declaration =>
+               return Formal;
+            when Iir_Kind_Slice_Name
+              | Iir_Kind_Indexed_Name
+              | Iir_Kind_Selected_Element =>
+               Formal := Get_Prefix (Formal);
+            when others =>
+               Error_Kind ("get_association_interface", Formal);
+         end case;
+      end loop;
+   end Get_Association_Interface;
+
+   function Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is
+      El: Iir;
+      Ident: Name_Id;
+   begin
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Ident := Get_Identifier (El);
+         if Ident = Lit then
+            return El;
+         end if;
+      end loop;
+      return Null_Iir;
+   end Find_Name_In_List;
+
+   function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir
+   is
+      El: Iir := Chain;
+   begin
+      while El /= Null_Iir loop
+         if Get_Identifier (El) = Lit then
+            return El;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+      return Null_Iir;
+   end Find_Name_In_Chain;
+
+   function Is_In_Chain (Chain : Iir; El : Iir) return Boolean
+   is
+      Chain_El : Iir;
+   begin
+      Chain_El := Chain;
+      while Chain_El /= Null_Iir loop
+         if Chain_El = El then
+            return True;
+         end if;
+         Chain_El := Get_Chain (Chain_El);
+      end loop;
+      return False;
+   end Is_In_Chain;
+
+   procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is
+   begin
+      --  Do not add self-dependency
+      if Unit = Target then
+         return;
+      end if;
+
+      case Get_Kind (Unit) is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Entity_Aspect_Entity =>
+            null;
+         when others =>
+            Error_Kind ("add_dependence", Unit);
+      end case;
+
+      Add_Element (Get_Dependence_List (Target), Unit);
+   end Add_Dependence;
+
+   procedure Clear_Instantiation_Configuration_Vhdl87
+     (Parent : Iir; In_Generate : Boolean; Full : Boolean)
+   is
+      El : Iir;
+      Prev : Iir;
+   begin
+      El := Get_Concurrent_Statement_Chain (Parent);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Component_Instantiation_Statement =>
+               if In_Generate and not Full then
+                  Prev := Get_Component_Configuration (El);
+                  if Prev /= Null_Iir then
+                     case Get_Kind (Prev) is
+                        when Iir_Kind_Configuration_Specification =>
+                           --  Keep it.
+                           null;
+                        when Iir_Kind_Component_Configuration =>
+                           Set_Component_Configuration (El, Null_Iir);
+                        when others =>
+                           Error_Kind
+                             ("clear_instantiation_configuration_vhdl87",
+                              Prev);
+                     end case;
+                  end if;
+               else
+                  Set_Component_Configuration (El, Null_Iir);
+               end if;
+            when Iir_Kind_Generate_Statement =>
+               Set_Generate_Block_Configuration (El, Null_Iir);
+               --  Clear inside a generate statement.
+               Clear_Instantiation_Configuration_Vhdl87 (El, True, Full);
+            when Iir_Kind_Block_Statement =>
+               Set_Block_Block_Configuration (El, Null_Iir);
+            when others =>
+               null;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Clear_Instantiation_Configuration_Vhdl87;
+
+   procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean)
+   is
+      El : Iir;
+   begin
+      if False and then Flags.Vhdl_Std = Vhdl_87 then
+         Clear_Instantiation_Configuration_Vhdl87
+           (Parent, Get_Kind (Parent) = Iir_Kind_Generate_Statement, Full);
+      else
+         El := Get_Concurrent_Statement_Chain (Parent);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  Set_Component_Configuration (El, Null_Iir);
+               when Iir_Kind_Generate_Statement =>
+                  Set_Generate_Block_Configuration (El, Null_Iir);
+               when Iir_Kind_Block_Statement =>
+                  Set_Block_Block_Configuration (El, Null_Iir);
+               when others =>
+                  null;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end if;
+   end Clear_Instantiation_Configuration;
+
+   function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc is
+   begin
+      return Str_Table.Get_String_Fat_Acc (Get_String_Id (Str));
+   end Get_String_Fat_Acc;
+
+   --  Get identifier of NODE as a string.
+   function Image_Identifier (Node : Iir) return String is
+   begin
+      return Name_Table.Image (Iirs.Get_Identifier (Node));
+   end Image_Identifier;
+
+   function Image_String_Lit (Str : Iir) return String
+   is
+      Ptr : String_Fat_Acc;
+      Len : Nat32;
+   begin
+      Ptr := Get_String_Fat_Acc (Str);
+      Len := Get_String_Length (Str);
+      return String (Ptr (1 .. Len));
+   end Image_String_Lit;
+
+   function Copy_Enumeration_Literal (Lit : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Enumeration_Literal);
+      Set_Identifier (Res, Get_Identifier (Lit));
+      Location_Copy (Res, Lit);
+      Set_Parent (Res, Get_Parent (Lit));
+      Set_Type (Res, Get_Type (Lit));
+      Set_Enum_Pos (Res, Get_Enum_Pos (Lit));
+      Set_Expr_Staticness (Res, Locally);
+      Set_Enumeration_Decl (Res, Lit);
+      return Res;
+   end Copy_Enumeration_Literal;
+
+   procedure Create_Range_Constraint_For_Enumeration_Type
+     (Def : Iir_Enumeration_Type_Definition)
+   is
+      Range_Expr : Iir_Range_Expression;
+      Literal_List : constant Iir_List := Get_Enumeration_Literal_List (Def);
+   begin
+      --  Create a constraint.
+      Range_Expr := Create_Iir (Iir_Kind_Range_Expression);
+      Location_Copy (Range_Expr, Def);
+      Set_Type (Range_Expr, Def);
+      Set_Direction (Range_Expr, Iir_To);
+      Set_Left_Limit
+        (Range_Expr,
+         Copy_Enumeration_Literal (Get_First_Element (Literal_List)));
+      Set_Right_Limit
+        (Range_Expr,
+         Copy_Enumeration_Literal (Get_Last_Element (Literal_List)));
+      Set_Expr_Staticness (Range_Expr, Locally);
+      Set_Range_Constraint (Def, Range_Expr);
+   end Create_Range_Constraint_For_Enumeration_Type;
+
+   procedure Free_Name (Node : Iir)
+   is
+      N : Iir;
+      N1 : Iir;
+   begin
+      if Node = Null_Iir then
+         return;
+      end if;
+      N := Node;
+      case Get_Kind (N) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Subtype_Definition =>
+            Free_Iir (N);
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Selected_By_All_Name =>
+            N1 := Get_Prefix (N);
+            Free_Iir (N);
+            Free_Name (N1);
+         when Iir_Kind_Library_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Design_Unit
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement =>
+            return;
+         when others =>
+            Error_Kind ("free_name", Node);
+            --Free_Iir (N);
+      end case;
+   end Free_Name;
+
+   procedure Free_Recursive_List (List : Iir_List)
+   is
+      El : Iir;
+   begin
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Free_Recursive (El);
+      end loop;
+   end Free_Recursive_List;
+
+   procedure Free_Recursive (Node : Iir; Free_List : Boolean := False)
+   is
+      N : Iir;
+   begin
+      if Node = Null_Iir then
+         return;
+      end if;
+      N := Node;
+      case Get_Kind (N) is
+         when Iir_Kind_Library_Declaration =>
+            return;
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Character_Literal =>
+            null;
+         when Iir_Kind_Enumeration_Literal =>
+            return;
+         when Iir_Kind_Selected_Name =>
+            Free_Recursive (Get_Prefix (N));
+         when Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration =>
+            Free_Recursive (Get_Type (N));
+            Free_Recursive (Get_Default_Value (N));
+         when Iir_Kind_Range_Expression =>
+            Free_Recursive (Get_Left_Limit (N));
+            Free_Recursive (Get_Right_Limit (N));
+         when Iir_Kind_Subtype_Definition =>
+            Free_Recursive (Get_Base_Type (N));
+         when Iir_Kind_Integer_Literal =>
+            null;
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Configuration_Declaration =>
+            null;
+         when Iir_Kind_File_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            return;
+         when Iir_Kind_Architecture_Body =>
+            Free_Recursive (Get_Entity_Name (N));
+         when Iir_Kind_Overload_List =>
+            Free_Recursive_List (Get_Overload_List (N));
+            if not Free_List then
+               return;
+            end if;
+         when Iir_Kind_Array_Subtype_Definition =>
+            Free_Recursive_List (Get_Index_List (N));
+            Free_Recursive (Get_Base_Type (N));
+         when Iir_Kind_Entity_Aspect_Entity =>
+            Free_Recursive (Get_Entity (N));
+            Free_Recursive (Get_Architecture (N));
+         when others =>
+            Error_Kind ("free_recursive", Node);
+      end case;
+      Free_Iir (N);
+   end Free_Recursive;
+
+   function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions)
+                                          return String
+   is
+   begin
+      return Iir_Predefined_Functions'Image (Func);
+   end Get_Predefined_Function_Name;
+
+   procedure Mark_Subprogram_Used (Subprg : Iir)
+   is
+      N : Iir;
+   begin
+      N := Subprg;
+      loop
+         exit when Get_Use_Flag (N);
+         Set_Use_Flag (N, True);
+         N := Sem_Inst.Get_Origin (N);
+         --  The origin may also be an instance.
+         exit when N = Null_Iir;
+      end loop;
+   end Mark_Subprogram_Used;
+
+   function Get_Callees_List_Holder (Subprg : Iir) return Iir is
+   begin
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            return Get_Subprogram_Body (Subprg);
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return Subprg;
+         when others =>
+            Error_Kind ("get_callees_list_holder", Subprg);
+      end case;
+   end Get_Callees_List_Holder;
+
+   procedure Clear_Seen_Flag (Top : Iir)
+   is
+      Callees_List : Iir_Callees_List;
+      El: Iir;
+   begin
+      if Get_Seen_Flag (Top) then
+         Set_Seen_Flag (Top, False);
+         Callees_List := Get_Callees_List (Get_Callees_List_Holder (Top));
+         if Callees_List /= Null_Iir_List then
+            for I in Natural loop
+               El := Get_Nth_Element (Callees_List, I);
+               exit when El = Null_Iir;
+               if Get_Seen_Flag (El) = False then
+                  Clear_Seen_Flag (El);
+               end if;
+            end loop;
+         end if;
+      end if;
+   end Clear_Seen_Flag;
+
+   function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is
+   begin
+      return Get_Type_Declarator (Def) = Null_Iir;
+   end Is_Anonymous_Type_Definition;
+
+   function Is_Fully_Constrained_Type (Def : Iir) return Boolean is
+   begin
+      return Get_Kind (Def) not in Iir_Kinds_Composite_Type_Definition
+        or else Get_Constraint_State (Def) = Fully_Constrained;
+   end Is_Fully_Constrained_Type;
+
+   function Strip_Denoting_Name (Name : Iir) return Iir is
+   begin
+      if Get_Kind (Name) in Iir_Kinds_Denoting_Name then
+         return Get_Named_Entity (Name);
+      else
+         return Name;
+      end if;
+   end Strip_Denoting_Name;
+
+   function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Simple_Name);
+      Set_Location (Res, Loc);
+      Set_Identifier (Res, Get_Identifier (Ref));
+      Set_Named_Entity (Res, Ref);
+      Set_Base_Name (Res, Res);
+      --  FIXME: set type and expr staticness ?
+      return Res;
+   end Build_Simple_Name;
+
+   function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir is
+   begin
+      return Build_Simple_Name (Ref, Get_Location (Loc));
+   end Build_Simple_Name;
+
+   function Has_Resolution_Function (Subtyp : Iir) return Iir
+   is
+      Ind : constant Iir := Get_Resolution_Indication (Subtyp);
+   begin
+      if Ind /= Null_Iir
+        and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name
+      then
+         return Get_Named_Entity (Ind);
+      else
+         return Null_Iir;
+      end if;
+   end Has_Resolution_Function;
+
+   function Get_Primary_Unit_Name (Physical_Def : Iir) return Iir
+   is
+      Unit : constant Iir := Get_Primary_Unit (Physical_Def);
+   begin
+      return Get_Unit_Name (Get_Physical_Unit_Value (Unit));
+   end Get_Primary_Unit_Name;
+
+   function Is_Type_Name (Name : Iir) return Iir
+   is
+      Ent : Iir;
+   begin
+      if Get_Kind (Name) in Iir_Kinds_Denoting_Name then
+         Ent := Get_Named_Entity (Name);
+         case Get_Kind (Ent) is
+            when Iir_Kind_Type_Declaration =>
+               return Get_Type_Definition (Ent);
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Base_Attribute =>
+               return Get_Type (Ent);
+            when others =>
+               return Null_Iir;
+         end case;
+      else
+         return Null_Iir;
+      end if;
+   end Is_Type_Name;
+
+   function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir is
+   begin
+      case Get_Kind (Ind) is
+         when Iir_Kinds_Denoting_Name =>
+            return Get_Type (Ind);
+         when Iir_Kinds_Subtype_Definition =>
+            return Ind;
+         when others =>
+            Error_Kind ("get_type_of_subtype_indication", Ind);
+      end case;
+   end Get_Type_Of_Subtype_Indication;
+
+   function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir
+   is
+      Index : constant Iir := Get_Nth_Element (Indexes, Idx);
+   begin
+      if Index = Null_Iir then
+         return Null_Iir;
+      else
+         return Get_Index_Type (Index);
+      end if;
+   end Get_Index_Type;
+
+   function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir is
+   begin
+      return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx);
+   end Get_Index_Type;
+
+   function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir
+   is
+      Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp);
+   begin
+      if Type_Mark_Name = Null_Iir then
+         --  No type_mark (for array subtype created by constrained array
+         --  definition.
+         return Null_Iir;
+      else
+         return Get_Type (Get_Named_Entity (Type_Mark_Name));
+      end if;
+   end Get_Denoted_Type_Mark;
+
+   function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean
+   is
+      Bod : constant Iir := Get_Subprogram_Body (Spec);
+   begin
+      return Bod /= Null_Iir
+        and then Get_Subprogram_Specification (Bod) /= Spec;
+   end Is_Second_Subprogram_Specification;
+
+   function Is_Same_Profile (L, R: Iir) return Boolean
+   is
+      L1, R1 : Iir;
+      L_Kind, R_Kind : Iir_Kind;
+      El_L, El_R : Iir;
+   begin
+      L_Kind := Get_Kind (L);
+      if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then
+         L1 := Get_Named_Entity (Get_Name (L));
+         L_Kind := Get_Kind (L1);
+      else
+         L1 := L;
+      end if;
+      R_Kind := Get_Kind (R);
+      if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then
+         R1 := Get_Named_Entity (Get_Name (R));
+         R_Kind := Get_Kind (R1);
+      else
+         R1 := R;
+      end if;
+
+      --  Check L and R are both of the same 'kind'.
+      --  Also the return profile for functions.
+      if L_Kind in Iir_Kinds_Function_Declaration
+        and then R_Kind in Iir_Kinds_Function_Declaration
+      then
+         if Get_Base_Type (Get_Return_Type (L1)) /=
+           Get_Base_Type (Get_Return_Type (R1))
+         then
+            return False;
+         end if;
+      elsif L_Kind in Iir_Kinds_Procedure_Declaration
+        and then R_Kind in Iir_Kinds_Procedure_Declaration
+      then
+         null;
+      elsif L_Kind = Iir_Kind_Enumeration_Literal
+        and then R_Kind = Iir_Kind_Enumeration_Literal
+      then
+         return Get_Type (L1) = Get_Type (R1);
+      else
+         --  Kind mismatch.
+         return False;
+      end if;
+
+      --  Check parameters profile.
+      El_L := Get_Interface_Declaration_Chain (L1);
+      El_R := Get_Interface_Declaration_Chain (R1);
+      loop
+         exit when El_L = Null_Iir and El_R = Null_Iir;
+         if El_L = Null_Iir or El_R = Null_Iir then
+            return False;
+         end if;
+         if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R))
+         then
+            return False;
+         end if;
+         El_L := Get_Chain (El_L);
+         El_R := Get_Chain (El_R);
+      end loop;
+
+      return True;
+   end Is_Same_Profile;
+
+   -- From a block_specification, returns the block.
+   function Get_Block_From_Block_Specification (Block_Spec : Iir)
+     return Iir
+   is
+      Res : Iir;
+   begin
+      case Get_Kind (Block_Spec) is
+         when Iir_Kind_Design_Unit =>
+            Res := Get_Library_Unit (Block_Spec);
+            if Get_Kind (Res) /= Iir_Kind_Architecture_Body then
+               raise Internal_Error;
+            end if;
+            return Res;
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Generate_Statement =>
+            return Block_Spec;
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Slice_Name =>
+            return Get_Named_Entity (Get_Prefix (Block_Spec));
+         when Iir_Kind_Simple_Name =>
+            return Get_Named_Entity (Block_Spec);
+         when others =>
+            Error_Kind ("get_block_from_block_specification", Block_Spec);
+            return Null_Iir;
+      end case;
+   end Get_Block_From_Block_Specification;
+
+   function Get_Entity (Decl : Iir) return Iir
+   is
+      Name : constant Iir := Get_Entity_Name (Decl);
+      Res : constant Iir := Get_Named_Entity (Name);
+   begin
+      pragma Assert (Res = Null_Iir
+                       or else Get_Kind (Res) = Iir_Kind_Entity_Declaration);
+      return Res;
+   end Get_Entity;
+
+   function Get_Configuration (Aspect : Iir) return Iir
+   is
+      Name : constant Iir := Get_Configuration_Name (Aspect);
+      Res : constant Iir := Get_Named_Entity (Name);
+   begin
+      pragma Assert (Get_Kind (Res) = Iir_Kind_Configuration_Declaration);
+      return Res;
+   end Get_Configuration;
+
+   function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id
+   is
+      Name : constant Iir := Get_Entity_Name (Arch);
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return Get_Identifier (Name);
+         when others =>
+            Error_Kind ("get_entity_identifier_of_architecture", Name);
+      end case;
+   end Get_Entity_Identifier_Of_Architecture;
+
+   function Is_Component_Instantiation
+     (Inst : Iir_Component_Instantiation_Statement)
+     return Boolean is
+   begin
+      case Get_Kind (Get_Instantiated_Unit (Inst)) is
+         when Iir_Kinds_Denoting_Name =>
+            return True;
+         when Iir_Kind_Entity_Aspect_Entity
+           | Iir_Kind_Entity_Aspect_Configuration =>
+            return False;
+         when others =>
+            Error_Kind ("is_component_instantiation", Inst);
+      end case;
+   end Is_Component_Instantiation;
+
+   function Is_Entity_Instantiation
+     (Inst : Iir_Component_Instantiation_Statement)
+     return Boolean is
+   begin
+      case Get_Kind (Get_Instantiated_Unit (Inst)) is
+         when Iir_Kinds_Denoting_Name =>
+            return False;
+         when Iir_Kind_Entity_Aspect_Entity
+           | Iir_Kind_Entity_Aspect_Configuration =>
+            return True;
+         when others =>
+            Error_Kind ("is_entity_instantiation", Inst);
+      end case;
+   end Is_Entity_Instantiation;
+
+   function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is
+   begin
+      if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then
+         Error_Kind ("get_string_type_bound_type", Sub_Type);
+      end if;
+      return Get_First_Element (Get_Index_Subtype_List (Sub_Type));
+   end Get_String_Type_Bound_Type;
+
+   procedure Get_Low_High_Limit (Arange : Iir_Range_Expression;
+                                 Low, High : out Iir)
+   is
+   begin
+      case Get_Direction (Arange) is
+         when Iir_To =>
+            Low := Get_Left_Limit (Arange);
+            High := Get_Right_Limit (Arange);
+         when Iir_Downto =>
+            High := Get_Left_Limit (Arange);
+            Low := Get_Right_Limit (Arange);
+      end case;
+   end Get_Low_High_Limit;
+
+   function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is
+   begin
+      case Get_Direction (Arange) is
+         when Iir_To =>
+            return Get_Left_Limit (Arange);
+         when Iir_Downto =>
+            return Get_Right_Limit (Arange);
+      end case;
+   end Get_Low_Limit;
+
+   function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is
+   begin
+      case Get_Direction (Arange) is
+         when Iir_To =>
+            return Get_Right_Limit (Arange);
+         when Iir_Downto =>
+            return Get_Left_Limit (Arange);
+      end case;
+   end Get_High_Limit;
+
+   function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+   begin
+      if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition
+        and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Is_One_Dimensional_Array_Type;
+
+   function Is_Range_Attribute_Name (Expr : Iir) return Boolean
+   is
+      Attr : Iir;
+      Id : Name_Id;
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then
+         Attr := Get_Prefix (Expr);
+      else
+         Attr := Expr;
+      end if;
+      if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then
+         return False;
+      end if;
+      Id := Get_Identifier (Attr);
+      return Id = Name_Range or Id = Name_Reverse_Range;
+   end Is_Range_Attribute_Name;
+
+   function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type)
+     return Iir_Array_Subtype_Definition
+   is
+      Res : Iir_Array_Subtype_Definition;
+      Base_Type : Iir;
+      List : Iir_List;
+   begin
+      Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      Set_Location (Res, Loc);
+      Base_Type := Get_Base_Type (Arr_Type);
+      Set_Base_Type (Res, Base_Type);
+      Set_Element_Subtype (Res, Get_Element_Subtype (Base_Type));
+      if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then
+         Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type));
+      end if;
+      Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type));
+      Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type));
+      Set_Type_Staticness (Res, Get_Type_Staticness (Base_Type));
+      List := Create_Iir_List;
+      Set_Index_Subtype_List (Res, List);
+      Set_Index_Constraint_List (Res, List);
+      return Res;
+   end Create_Array_Subtype;
+
+   function Is_Subprogram_Method (Spec : Iir) return Boolean is
+   begin
+      case Get_Kind (Get_Parent (Spec)) is
+         when Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Protected_Type_Body =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Subprogram_Method;
+
+   function Get_Method_Type (Spec : Iir) return Iir
+   is
+      Parent : Iir;
+   begin
+      Parent := Get_Parent (Spec);
+      case Get_Kind (Parent) is
+         when Iir_Kind_Protected_Type_Declaration =>
+            return Parent;
+         when Iir_Kind_Protected_Type_Body =>
+            return Get_Protected_Type_Declaration (Parent);
+         when others =>
+            return Null_Iir;
+      end case;
+   end Get_Method_Type;
+
+   function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Error);
+      Set_Expr_Staticness (Res, None);
+      Set_Type (Res, Atype);
+      Set_Error_Origin (Res, Orig);
+      Location_Copy (Res, Orig);
+      return Res;
+   end Create_Error_Expr;
+
+   function Create_Error_Type (Orig : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Error);
+      --Set_Expr_Staticness (Res, Locally);
+      Set_Base_Type (Res, Res);
+      Set_Error_Origin (Res, Orig);
+      Location_Copy (Res, Orig);
+      Set_Type_Declarator (Res, Null_Iir);
+      Set_Resolved_Flag (Res, True);
+      Set_Signal_Type_Flag (Res, True);
+      return Res;
+   end Create_Error_Type;
+
+   --  Extract the entity from ASPECT.
+   --  Note: if ASPECT is a component declaration, returns ASPECT.
+   function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir
+   is
+      Inst : Iir;
+   begin
+      case Get_Kind (Aspect) is
+         when Iir_Kinds_Denoting_Name =>
+            --  A component declaration.
+            Inst := Get_Named_Entity (Aspect);
+            pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Declaration);
+            return Inst;
+         when Iir_Kind_Component_Declaration =>
+            return Aspect;
+         when Iir_Kind_Entity_Aspect_Entity =>
+            return Get_Entity (Aspect);
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            Inst := Get_Configuration (Aspect);
+            return Get_Entity (Inst);
+         when Iir_Kind_Entity_Aspect_Open =>
+            return Null_Iir;
+         when others =>
+            Error_Kind ("get_entity_from_entity_aspect", Aspect);
+      end case;
+   end Get_Entity_From_Entity_Aspect;
+
+   function Is_Signal_Object (Name : Iir) return Boolean
+   is
+      Adecl: Iir;
+   begin
+      Adecl := Get_Object_Prefix (Name, True);
+      case Get_Kind (Adecl) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kinds_Signal_Attribute =>
+            return True;
+         when Iir_Kind_Object_Alias_Declaration =>
+            raise Internal_Error;
+         when others =>
+            return False;
+      end case;
+   end Is_Signal_Object;
+
+   --  LRM08 4.7 Package declarations
+   --  If the package header is empty, the package declared by a package
+   --  declaration is called a simple package.
+   function Is_Simple_Package (Pkg : Iir) return Boolean is
+   begin
+      return Get_Package_Header (Pkg) = Null_Iir;
+   end Is_Simple_Package;
+
+   --  LRM08 4.7 Package declarations
+   --  If the package header contains a generic clause and no generic map
+   --  aspect, the package is called an uninstantiated package.
+   function Is_Uninstantiated_Package (Pkg : Iir) return Boolean
+   is
+      Header : constant Iir := Get_Package_Header (Pkg);
+   begin
+      return Header /= Null_Iir
+        and then Get_Generic_Map_Aspect_Chain (Header) = Null_Iir;
+   end Is_Uninstantiated_Package;
+
+   --  LRM08 4.7 Package declarations
+   --  If the package header contains both a generic clause and a generic
+   --  map aspect, the package is declared a generic-mapped package.
+   function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean
+   is
+      Header : constant Iir := Get_Package_Header (Pkg);
+   begin
+      return Header /= Null_Iir
+        and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir;
+   end Is_Generic_Mapped_Package;
+
+   function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean
+   is
+      K : constant Iir_Kind := Get_Kind (N);
+   begin
+      return K = K1 or K = K2;
+   end Kind_In;
+
+   function Get_HDL_Node (N : PSL_Node) return Iir is
+   begin
+      return Iir (PSL.Nodes.Get_HDL_Node (N));
+   end Get_HDL_Node;
+
+   procedure Set_HDL_Node (N : PSL_Node; Expr : Iir) is
+   begin
+      PSL.Nodes.Set_HDL_Node (N, PSL.Nodes.HDL_Node (Expr));
+   end Set_HDL_Node;
+end Iirs_Utils;
diff --git a/src/iirs_utils.ads b/src/iirs_utils.ads
new file mode 100644
index 000000000..a588ab870
--- /dev/null
+++ b/src/iirs_utils.ads
@@ -0,0 +1,250 @@
+--  Common operations on nodes.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Iirs_Utils is
+   --  Transform the current token into an iir literal.
+   --  The current token must be either a character, a string or an identifier.
+   function Current_Text return Iir;
+
+   --  Get identifier of NODE as a string.
+   function Image_Identifier (Node : Iir) return String;
+   function Image_String_Lit (Str : Iir) return String;
+
+   --  Easier function for string literals.
+   function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc;
+   pragma Inline (Get_String_Fat_Acc);
+
+   --  Return True iff N is an error node.
+   function Is_Error (N : Iir) return Boolean;
+   pragma Inline (Is_Error);
+
+   --  Find LIT in the list of identifiers or characters LIST.
+   --  Return the literal (whose name is LIT) or null_iir if not found.
+   function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir;
+   function Find_Name_In_List (List : Iir_List; Lit: Name_Id) return Iir;
+
+   --  Return TRUE if EL in an element of chain CHAIN.
+   function Is_In_Chain (Chain : Iir; El : Iir) return Boolean;
+
+   --  Convert an operator node to a name.
+   function Get_Operator_Name (Op : Iir) return Name_Id;
+
+   -- Get the longuest static prefix of EXPR.
+   -- See LRM §8.1
+   function Get_Longuest_Static_Prefix (Expr: Iir) return Iir;
+
+   --  Get the prefix of NAME, ie the declaration at the base of NAME.
+   --  Return NAME itself if NAME is not an object or a subelement of
+   --  an object.  If WITH_ALIAS is true, continue with the alias name when an
+   --  alias is found, else return the alias.
+   --  FIXME: clarify when NAME is returned.
+   function Get_Object_Prefix (Name: Iir; With_Alias : Boolean := True)
+                              return Iir;
+
+
+   --  Get the interface associated by the association ASSOC.  This is always
+   --  an interface, even if the formal is a name.
+   function Get_Association_Interface (Assoc : Iir) return Iir;
+
+   --  Duplicate enumeration literal LIT.
+   function Copy_Enumeration_Literal (Lit : Iir) return Iir;
+
+   --  Make TARGETS depends on UNIT.
+   --  UNIT must be either a design unit or a entity_aspect_entity.
+   procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir);
+
+   --  Clear configuration field of all component instantiation of
+   --  the concurrent statements of PARENT.
+   procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean);
+
+   --  Free Node and its prefixes, if any.
+   procedure Free_Name (Node : Iir);
+
+   --  Free NODE and its sub-nodes.
+   procedure Free_Recursive (Node : Iir; Free_List : Boolean := False);
+
+   --  Name of FUNC.
+   function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions)
+     return String;
+
+   --  Mark SUBPRG as used.  If SUBPRG is an instance, its generic is also
+   --  marked.
+   procedure Mark_Subprogram_Used (Subprg : Iir);
+
+   --  Create the range_constraint node for an enumeration type.
+   procedure Create_Range_Constraint_For_Enumeration_Type
+     (Def : Iir_Enumeration_Type_Definition);
+
+   --  Return the node containing the Callees_List (ie the subprogram body if
+   --  SUBPRG is a subprogram spec, SUBPRG if SUBPRG is a process).
+   function Get_Callees_List_Holder (Subprg : Iir) return Iir;
+
+   --  Clear flag of TOP and all of its callees.
+   procedure Clear_Seen_Flag (Top : Iir);
+
+   --  Return TRUE iff DEF is an anonymous type (or subtype) definition.
+   --  Note: DEF is required to be a type (or subtype) definition.
+   --  Note: type (and not subtype) are never anonymous.
+   function Is_Anonymous_Type_Definition (Def : Iir) return Boolean;
+   pragma Inline (Is_Anonymous_Type_Definition);
+
+   --  Return TRUE iff DEF is a fully constrained type (or subtype) definition.
+   function Is_Fully_Constrained_Type (Def : Iir) return Boolean;
+
+   --  Return the type definition/subtype indication of NAME if NAME denotes
+   --  a type or subtype name.  Otherwise, return Null_Iir;
+   function Is_Type_Name (Name : Iir) return Iir;
+
+   --  Return TRUE iff SPEC is the subprogram specification of a subprogram
+   --  body which was previously declared.  In that case, the only use of SPEC
+   --  is to match the body with its declaration.
+   function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean;
+
+   --  If NAME is a simple or an expanded name, return the denoted declaration.
+   --  Otherwise, return NAME.
+   function Strip_Denoting_Name (Name : Iir) return Iir;
+
+   --  Build a simple name node whose named entity is REF and location LOC.
+   function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir;
+   function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir;
+
+   --  If SUBTYP has a resolution indication that is a function name, returns
+   --  the function declaration (not the name).
+   function Has_Resolution_Function (Subtyp : Iir) return Iir;
+
+   --  Return a simple name for the primary unit of physical type PHYSICAL_DEF.
+   --  This is the artificial unit name for the value of the primary unit, thus
+   --  its location is the location of the primary unit.  Used mainly to build
+   --  evaluated literals.
+   function Get_Primary_Unit_Name (Physical_Def : Iir) return Iir;
+
+   --  Get the type of any node representing a subtype indication.  This simply
+   --  skip over denoting names.
+   function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir;
+
+   --  Get the type of an index_subtype_definition or of a discrete_range from
+   --  an index_constraint.
+   function Get_Index_Type (Index_Type : Iir) return Iir
+     renames Get_Type_Of_Subtype_Indication;
+
+   --  Return the IDX-th index type for index subtype definition list or
+   --  index_constraint INDEXES.  Return Null_Iir if IDX is out of dimension
+   --  bounds, so that this function can be used to iterator over indexes of
+   --  a type (or subtype).  Note that IDX starts at 0.
+   function Get_Index_Type (Indexes : Iir_List; Idx : Natural) return Iir;
+
+   --  Likewise but for array type or subtype ARRAY_TYPE.
+   function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir;
+
+   --  Return the type or subtype definition of the SUBTYP type mark.
+   function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir;
+
+   --  Return true iff L and R have the same profile.
+   --  L and R must be subprograms specification (or spec_body).
+   function Is_Same_Profile (L, R: Iir) return Boolean;
+
+   --  From a block_specification, returns the block.
+   --  Roughly speaking, this get prefix of indexed and sliced name.
+   function Get_Block_From_Block_Specification (Block_Spec : Iir)
+     return Iir;
+
+   --  Wrapper around Get_Entity_Name: return the entity declaration of the
+   --  entity name of DECL.
+   function Get_Entity (Decl : Iir) return Iir;
+
+   --  Wrapper around get_Configuration_Name: return the configuration
+   --  declaration of ASPECT.
+   function Get_Configuration (Aspect : Iir) return Iir;
+
+   --  Return the identifier of the entity for architecture ARCH.
+   function Get_Entity_Identifier_Of_Architecture (Arch : Iir) return Name_Id;
+
+   --  Return True is component instantiation statement INST instantiate a
+   --  component.
+   function Is_Component_Instantiation
+     (Inst : Iir_Component_Instantiation_Statement)
+     return Boolean;
+
+   --  Return True is component instantiation statement INST instantiate a
+   --  design entity.
+   function Is_Entity_Instantiation
+     (Inst : Iir_Component_Instantiation_Statement)
+     return Boolean;
+
+   --  Return the bound type of a string type, ie the type of the (first)
+   --  dimension of a one-dimensional array type.
+   function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir;
+
+   --  Return left or right limit according to the direction.
+   procedure Get_Low_High_Limit (Arange : Iir_Range_Expression;
+                                 Low, High : out Iir);
+   function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir;
+   function Get_High_Limit (Arange : Iir_Range_Expression) return Iir;
+
+   --  Return TRUE iff type/subtype definition A_TYPE is an undim array.
+   function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean;
+
+   --  Return TRUE iff unsemantized EXPR is a range attribute.
+   function Is_Range_Attribute_Name (Expr : Iir) return Boolean;
+
+   --  Create an array subtype from array_type or array_subtype ARR_TYPE.
+   --  All fields of the returned node are filled, except the index_list.
+   --  The type_staticness is set with the type staticness of the element
+   --  subtype and therefore must be updated.
+   --  The type_declarator field is set to null_iir.
+   function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type)
+                                 return Iir_Array_Subtype_Definition;
+
+   --  Return TRUE iff SPEC is declared inside a protected type or a protected
+   --  body.
+   function Is_Subprogram_Method (Spec : Iir) return Boolean;
+
+   --  Return the protected type for method SPEC.
+   function Get_Method_Type (Spec : Iir) return Iir;
+
+   --  Create an error node for node ORIG, and set its type to ATYPE.
+   --  Set its staticness to locally.
+   function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir;
+
+   --  Create an error node for node ORIG, which is supposed to be a type.
+   function Create_Error_Type (Orig : Iir) return Iir;
+
+   --  Extract the entity from ASPECT.
+   --  Note: if ASPECT is a component declaration, returns ASPECT.
+   --        if ASPECT is open, return Null_Iir;
+   function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir;
+
+   --  Definitions from LRM08 4.7 Package declarations.
+   --  PKG must denote a package declaration.
+   function Is_Simple_Package (Pkg : Iir) return Boolean;
+   function Is_Uninstantiated_Package (Pkg : Iir) return Boolean;
+   function Is_Generic_Mapped_Package (Pkg : Iir) return Boolean;
+
+   --  Return TRUE if the base name of NAME is a signal object.
+   function Is_Signal_Object (Name: Iir) return Boolean;
+
+   --  Return True IFF kind of N is K1 or K2.
+   function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean;
+   pragma Inline (Kind_In);
+
+   --  IIR wrapper around Get_HDL_Node/Set_HDL_Node.
+   function Get_HDL_Node (N : PSL_Node) return Iir;
+   procedure Set_HDL_Node (N : PSL_Node; Expr : Iir);
+end Iirs_Utils;
diff --git a/src/iirs_walk.adb b/src/iirs_walk.adb
new file mode 100644
index 000000000..399832907
--- /dev/null
+++ b/src/iirs_walk.adb
@@ -0,0 +1,115 @@
+--  Walk in iirs nodes.
+--  Copyright (C) 2009 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.
+
+package body Iirs_Walk is
+   function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status
+   is
+      El : Iir;
+      Status : Walk_Status := Walk_Continue;
+   begin
+      El := Chain;
+      while El /= Null_Iir loop
+         Status := Cb.all (El);
+         exit when Status /= Walk_Continue;
+         El := Get_Chain (El);
+      end loop;
+      return Status;
+   end Walk_Chain;
+
+   function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status;
+
+
+   function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb)
+                                       return Walk_Status
+   is
+      El : Iir;
+      Status : Walk_Status := Walk_Continue;
+   begin
+      El := Chain;
+      while El /= Null_Iir loop
+         Status := Cb.all (El);
+         exit when Status /= Walk_Continue;
+         Status := Walk_Sequential_Stmt (El, Cb);
+         exit when Status /= Walk_Continue;
+         El := Get_Chain (El);
+      end loop;
+      return Status;
+   end Walk_Sequential_Stmt_Chain;
+
+   function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status
+   is
+      Status : Walk_Status := Walk_Continue;
+      Chain : Iir;
+   begin
+      case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is
+         when Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Variable_Assignment_Statement =>
+            null;
+         when Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement =>
+            Status := Walk_Sequential_Stmt_Chain
+              (Get_Sequential_Statement_Chain (Stmt), Cb);
+         when Iir_Kind_Case_Statement =>
+            Chain := Get_Case_Statement_Alternative_Chain (Stmt);
+            while Chain /= Null_Iir loop
+               Status := Walk_Sequential_Stmt_Chain
+                 (Get_Associated_Chain (Chain), Cb);
+               exit when Status /= Walk_Continue;
+               Chain := Get_Chain (Chain);
+            end loop;
+         when Iir_Kind_If_Statement =>
+            Chain := Stmt;
+            while Chain /= Null_Iir loop
+               Status := Walk_Sequential_Stmt_Chain
+                 (Get_Sequential_Statement_Chain (Chain), Cb);
+               exit when Status /= Walk_Continue;
+               Chain := Get_Else_Clause (Chain);
+            end loop;
+      end case;
+      return Status;
+   end Walk_Sequential_Stmt;
+
+   function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb)
+                                   return Walk_Status
+   is
+      Chain : Iir;
+      Status : Walk_Status := Walk_Continue;
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Aggregate =>
+            Chain := Get_Association_Choices_Chain (Target);
+            while Chain /= Null_Iir loop
+               Status :=
+                 Walk_Assignment_Target (Get_Associated_Expr (Chain), Cb);
+               exit when Status /= Walk_Continue;
+               Chain := Get_Chain (Chain);
+            end loop;
+         when others =>
+            Status := Cb.all (Target);
+      end case;
+      return Status;
+   end Walk_Assignment_Target;
+end Iirs_Walk;
diff --git a/src/iirs_walk.ads b/src/iirs_walk.ads
new file mode 100644
index 000000000..4c098f7d5
--- /dev/null
+++ b/src/iirs_walk.ads
@@ -0,0 +1,45 @@
+--  Walk in iirs nodes.
+--  Copyright (C) 2009 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 Iirs; use Iirs;
+
+package Iirs_Walk is
+   type Walk_Status is
+     (
+      --  Continue to walk.
+      Walk_Continue,
+
+      --  Stop walking in the subtree, continue in the parent tree.
+      Walk_Up,
+
+      --  Abort the walk.
+      Walk_Abort);
+
+   type Walk_Cb is access function (El : Iir) return Walk_Status;
+
+   --  Walk on all elements of CHAIN.
+   function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status;
+
+
+   function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb)
+                                   return Walk_Status;
+
+   --  Walk on all stmts and sub-stmts of CHAIN.
+   function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb)
+                                       return Walk_Status;
+end Iirs_Walk;
diff --git a/src/libraries.adb b/src/libraries.adb
new file mode 100644
index 000000000..7fd2b69ef
--- /dev/null
+++ b/src/libraries.adb
@@ -0,0 +1,1714 @@
+--  VHDL libraries handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Table;
+with GNAT.OS_Lib;
+with Interfaces.C_Streams;
+with System;
+with Errorout; use Errorout;
+with Scanner;
+with Iirs_Utils; use Iirs_Utils;
+with Parse;
+with Back_End;
+with Name_Table; use Name_Table;
+with Str_Table;
+with Sem_Scopes;
+with Tokens;
+with Files_Map;
+with Flags;
+with Std_Package;
+
+package body Libraries is
+   --  Chain of known libraries.  This is also the top node of all iir node.
+   Libraries_Chain : Iir_Library_Declaration := Null_Iir;
+   Libraries_Chain_Last : Iir_Library_Declaration := Null_Iir;
+
+   --  A location for any implicit declarations (such as library WORK).
+   Implicit_Location: Location_Type;
+
+   --  Table of library pathes.
+   package Pathes is new GNAT.Table
+     (Table_Index_Type => Integer,
+      Table_Component_Type => Name_Id,
+      Table_Low_Bound => 1,
+      Table_Initial => 4,
+      Table_Increment => 100);
+
+   --  Initialize pathes table.
+   --  Set the local path.
+   procedure Init_Pathes
+   is
+   begin
+      Name_Nil := Get_Identifier ("");
+      Pathes.Append (Name_Nil);
+      Local_Directory := Name_Nil;
+      Work_Directory := Name_Nil;
+   end Init_Pathes;
+
+   function Path_To_Id (Path : String) return Name_Id is
+   begin
+      if Path (Path'Last) /= GNAT.OS_Lib.Directory_Separator then
+         return Get_Identifier (Path & GNAT.OS_Lib.Directory_Separator);
+      else
+         return Get_Identifier (Path);
+      end if;
+   end Path_To_Id;
+
+   procedure Add_Library_Path (Path : String)
+   is
+   begin
+      if Path'Length = 0 then
+         return;
+      end if;
+      --  Nice message instead of constraint_error.
+      if Path'Length + 2 >= Name_Buffer'Length then
+         Error_Msg ("argument of -P is too long");
+         return;
+      end if;
+      Pathes.Append (Path_To_Id (Path));
+   end Add_Library_Path;
+
+   function Get_Nbr_Pathes return Natural is
+   begin
+      return Pathes.Last;
+   end Get_Nbr_Pathes;
+
+   function Get_Path (N : Natural) return Name_Id is
+   begin
+      if N > Pathes.Last or N < Pathes.First then
+         raise Constraint_Error;
+      end if;
+      return Pathes.Table (N);
+   end Get_Path;
+
+   --  Set PATH as the path of the work library.
+   procedure Set_Work_Library_Path (Path : String) is
+   begin
+      Work_Directory := Path_To_Id (Path);
+      if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) then
+         --  This is a warning, since 'clean' action should not fail in
+         --  this cases.
+         Warning_Msg
+           ("directory '" & Path & "' set by --workdir= does not exist");
+         --  raise Option_Error;
+      end if;
+   end Set_Work_Library_Path;
+
+   --  Open LIBRARY map file, return TRUE if successful.
+   function Set_Library_File_Name (Dir : Name_Id;
+                                   Library: Iir_Library_Declaration)
+     return Boolean
+   is
+      File_Name : constant String := Back_End.Library_To_File_Name (Library);
+      Fe : Source_File_Entry;
+   begin
+      Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name));
+      if Fe = No_Source_File_Entry then
+         return False;
+      end if;
+      Scanner.Set_File (Fe);
+      return True;
+   end Set_Library_File_Name;
+
+   --  Every design unit is put in this hash table to be quickly found by
+   --  its (primary) identifier.
+   Unit_Hash_Length : constant Name_Id := 127;
+   subtype Hash_Id is Name_Id range 0 .. Unit_Hash_Length - 1;
+   Unit_Hash_Table : array (Hash_Id) of Iir := (others => Null_Iir);
+
+   --  Get the hash value for DESIGN_UNIT.
+   --  Architectures use the entity name.
+   function Get_Hash_Id_For_Unit (Design_Unit : Iir_Design_Unit)
+                                 return Hash_Id
+   is
+      Lib_Unit : Iir;
+      Id : Name_Id;
+   begin
+      Lib_Unit := Get_Library_Unit (Design_Unit);
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Package_Instantiation_Declaration =>
+            Id := Get_Identifier (Lib_Unit);
+         when Iir_Kind_Architecture_Body =>
+            --  Architectures are put with the entity identifier.
+            Id := Get_Entity_Identifier_Of_Architecture (Lib_Unit);
+         when others =>
+            Error_Kind ("get_Hash_Id_For_Unit", Lib_Unit);
+      end case;
+      return Id mod Unit_Hash_Length;
+   end Get_Hash_Id_For_Unit;
+
+   --  Put DESIGN_UNIT into the unit hash table.
+   procedure Add_Unit_Hash (Design_Unit : Iir)
+   is
+      Id : Hash_Id;
+   begin
+      Id := Get_Hash_Id_For_Unit (Design_Unit);
+      Set_Hash_Chain (Design_Unit, Unit_Hash_Table (Id));
+      Unit_Hash_Table (Id) := Design_Unit;
+   end Add_Unit_Hash;
+
+   --  Remove DESIGN_UNIT from the unit hash table.
+   procedure Remove_Unit_Hash (Design_Unit : Iir)
+   is
+      Id : Hash_Id;
+      Unit, Prev, Next : Iir_Design_Unit;
+   begin
+      Id := Get_Hash_Id_For_Unit (Design_Unit);
+      Unit := Unit_Hash_Table (Id);
+      Prev := Null_Iir;
+      while Unit /= Null_Iir loop
+         Next := Get_Hash_Chain (Unit);
+         if Unit = Design_Unit then
+            if Prev = Null_Iir then
+               Unit_Hash_Table (Id) := Next;
+            else
+               Set_Hash_Chain (Prev, Next);
+            end if;
+            return;
+         end if;
+         Prev := Unit;
+         Unit := Next;
+      end loop;
+      --  Not found.
+      raise Internal_Error;
+   end Remove_Unit_Hash;
+
+   procedure Purge_Design_File (Design_File : Iir_Design_File)
+   is
+      Prev, File, Next : Iir_Design_File;
+      Unit : Iir_Design_Unit;
+
+      File_Name : Name_Id;
+      Dir_Name : Name_Id;
+   begin
+      File_Name := Get_Design_File_Filename (Design_File);
+      Dir_Name := Get_Design_File_Directory (Design_File);
+
+      File := Get_Design_File_Chain (Work_Library);
+      Prev := Null_Iir;
+      while File /= Null_Iir loop
+         Next := Get_Chain (File);
+         if Get_Design_File_Filename (File) = File_Name
+           and then Get_Design_File_Directory (File) = Dir_Name
+         then
+            --  Remove from library.
+            if Prev = Null_Iir then
+               Set_Design_File_Chain (Work_Library, Next);
+            else
+               Set_Chain (Prev, Next);
+            end if;
+
+            --  Remove all units from unit hash table.
+            Unit := Get_First_Design_Unit (File);
+            while Unit /= Null_Iir loop
+               Remove_Unit_Hash (Unit);
+               Unit := Get_Chain (Unit);
+            end loop;
+
+            return;
+         end if;
+         Prev := File;
+         File := Next;
+      end loop;
+   end Purge_Design_File;
+
+   -- Load the contents of a library from a map file.
+   -- The format of this file, used by save_library and load_library is
+   -- as follow:
+   --
+   -- file_format ::= header { design_file_format }
+   -- header ::= v 3
+   -- design_file_format ::=
+   --      filename_format { design_unit_format  }
+   -- filename_format ::=
+   --      FILE directory "FILENAME" file_time_stamp analyze_time_stamp:
+   -- design_unit_format ::= entity_format
+   --                        | architecture_format
+   --                        | package_format
+   --                        | package_body_format
+   --                        | configuration_format
+   -- position_format ::= LINE(POS) + OFF on DATE
+   -- entity_format ::=
+   --      ENTITY identifier AT position_format ;
+   -- architecture_format ::=
+   --      ARCHITECTURE identifier of name AT position_format ;
+   -- package_format ::=
+   --      PACKAGE identifier AT position_format [BODY] ;
+   -- package_body_format ::=
+   --      PACKAGE BODY identifier AT position_format ;
+   -- configuration_format ::=
+   --      CONFIGURATION identifier AT position_format ;
+   --
+   -- The position_format meaning is:
+   --       LINE is the line number (first line is number 1),
+   --       POS is the offset of this line number, as a source_ptr value,
+   --       OFF is the offset in the line, starting with 0.
+   --       DATE is the symbolic date of analysis (order).
+   --
+   -- Return TRUE if the library was found.
+   function Load_Library (Library: Iir_Library_Declaration)
+     return Boolean
+   is
+      use Scanner;
+      use Tokens;
+
+      File : Source_File_Entry;
+
+      procedure Bad_Library_Format is
+      begin
+         Error_Msg (Image (Files_Map.Get_File_Name (File)) &
+                    ": bad library format");
+      end Bad_Library_Format;
+
+      procedure Scan_Expect (Tok: Token_Type) is
+      begin
+         Scan;
+         if Current_Token /= Tok then
+            Bad_Library_Format;
+            raise Compilation_Error;
+         end if;
+      end Scan_Expect;
+
+      function Current_Time_Stamp return Time_Stamp_Id is
+      begin
+         if Current_String_Length /= Time_Stamp_String'Length then
+            Bad_Library_Format;
+            raise Compilation_Error;
+         end if;
+         return Time_Stamp_Id (Current_String_Id);
+      end Current_Time_Stamp;
+
+      function String_To_Name_Id return Name_Id
+      is
+         Len : Int32;
+         Ptr : String_Fat_Acc;
+      begin
+         Len := Current_String_Length;
+         Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id);
+         for I in 1 .. Len loop
+            Name_Table.Name_Buffer (Natural (I)) := Ptr (I);
+         end loop;
+         Name_Table.Name_Length := Natural (Len);
+         --  FIXME: should remove last string.
+         return Get_Identifier;
+      end String_To_Name_Id;
+
+      Design_Unit, Last_Design_Unit : Iir_Design_Unit;
+      Lib_Ident : Name_Id;
+
+      function Scan_Unit_List return Iir_List is
+      begin
+         if Current_Token = Tok_Left_Paren then
+            Scan_Expect (Tok_Identifier);
+            loop
+               Scan_Expect (Tok_Dot);
+               Scan_Expect (Tok_Identifier);
+               Scan;
+               if Current_Token = Tok_Left_Paren then
+                  --  This is an architecture.
+                  Scan_Expect (Tok_Identifier);
+                  Scan_Expect (Tok_Right_Paren);
+                  Scan;
+               end if;
+               exit when Current_Token /= Tok_Comma;
+               Scan;
+            end loop;
+            Scan;
+         end if;
+         return Null_Iir_List;
+      end Scan_Unit_List;
+
+      Design_File: Iir_Design_File;
+      Library_Unit: Iir;
+      Line, Col: Int32;
+      File_Dir : Name_Id;
+      Pos: Source_Ptr;
+      Date: Date_Type;
+      Max_Date: Date_Type := Date_Valid'First;
+      Dir : Name_Id;
+   begin
+      Lib_Ident := Get_Identifier (Library);
+
+      if False then
+         Ada.Text_IO.Put_Line ("Load library " & Image (Lib_Ident));
+      end if;
+
+      -- Check the library was not already loaded.
+      if Get_Design_File_Chain (Library) /= Null_Iir then
+         raise Internal_Error;
+      end if;
+
+      -- Try to open the library file map.
+      Dir := Get_Library_Directory (Library);
+      if Dir = Null_Identifier then
+         --  Search in the library path.
+         declare
+            File_Name : constant String :=
+              Back_End.Library_To_File_Name (Library);
+            L : Natural;
+         begin
+            for I in Pathes.First .. Pathes.Last loop
+               Image (Pathes.Table (I));
+               L := Name_Length + File_Name'Length;
+               Name_Buffer (Name_Length + 1 .. L) := File_Name;
+               Name_Buffer (L + 1) := Character'Val (0);
+               if GNAT.OS_Lib.Is_Regular_File (Name_Buffer'Address) then
+                  Dir := Pathes.Table (I);
+                  Set_Library_Directory (Library, Dir);
+                  exit;
+               end if;
+            end loop;
+         end;
+      end if;
+      if Dir = Null_Identifier
+        or else not Set_Library_File_Name (Dir, Library)
+      then
+         --  Not found.
+         Set_Date (Library, Date_Valid'First);
+         return False;
+      end if;
+      File := Get_Current_Source_File;
+
+      --  Parse header.
+      Scan;
+      if Current_Token /= Tok_Identifier
+        or else Name_Length /= 1 or else Name_Buffer (1) /= 'v'
+      then
+         Bad_Library_Format;
+         raise Compilation_Error;
+      end if;
+      Scan_Expect (Tok_Integer);
+      if Current_Iir_Int64 not in 1 .. 3 then
+         Bad_Library_Format;
+         raise Compilation_Error;
+      end if;
+      Scan;
+
+      Last_Design_Unit := Null_Iir;
+      while Current_Token /= Tok_Eof loop
+         if Current_Token = Tok_File then
+            -- This is a new design file.
+            Design_File := Create_Iir (Iir_Kind_Design_File);
+
+            Scan;
+            if Current_Token = Tok_Dot then
+               --  The filename is local, use the directory of the library.
+               if Dir = Name_Nil then
+                  File_Dir := Files_Map.Get_Home_Directory;
+               else
+                  File_Dir := Dir;
+               end if;
+            elsif Current_Token = Tok_Slash then
+               --  The filename is an absolute file.
+               File_Dir := Null_Identifier;
+            elsif Current_Token = Tok_String then
+               --  Be compatible with version 1: an empty directory for
+               --  an absolute filename.
+               if Current_String_Length = 0 then
+                  File_Dir := Null_Identifier;
+               else
+                  File_Dir := String_To_Name_Id;
+               end if;
+            else
+               Bad_Library_Format;
+               raise Compilation_Error;
+            end if;
+
+            Set_Design_File_Directory (Design_File, File_Dir);
+
+            Scan_Expect (Tok_String);
+            Set_Design_File_Filename (Design_File, String_To_Name_Id);
+
+            -- FIXME: check the file name is uniq.
+
+            Set_Parent (Design_File, Library);
+
+            --  Prepend.
+            Set_Chain (Design_File, Get_Design_File_Chain (Library));
+            Set_Design_File_Chain (Library, Design_File);
+
+            Scan_Expect (Tok_String);
+            Set_File_Time_Stamp (Design_File, Current_Time_Stamp);
+
+            Scan_Expect (Tok_String);
+            Set_Analysis_Time_Stamp (Design_File, Current_Time_Stamp);
+
+            Scan_Expect (Tok_Colon);
+            Scan;
+            Last_Design_Unit := Null_Iir;
+         else
+            -- This is a new design unit.
+            Design_Unit := Create_Iir (Iir_Kind_Design_Unit);
+            Set_Design_File (Design_Unit, Design_File);
+            case Current_Token is
+               when Tok_Entity =>
+                  Library_Unit := Create_Iir (Iir_Kind_Entity_Declaration);
+                  Scan;
+               when Tok_Architecture =>
+                  Library_Unit := Create_Iir (Iir_Kind_Architecture_Body);
+                  Scan;
+               when Tok_Configuration =>
+                  Library_Unit :=
+                    Create_Iir (Iir_Kind_Configuration_Declaration);
+                  Scan;
+               when Tok_Package =>
+                  Scan;
+                  if Current_Token = Tok_Body then
+                     Library_Unit := Create_Iir (Iir_Kind_Package_Body);
+                     Scan;
+                  else
+                     Library_Unit := Create_Iir (Iir_Kind_Package_Declaration);
+                  end if;
+               when Tok_With =>
+                  if Library_Unit = Null_Iir
+                    or else
+                    Get_Kind (Library_Unit) /= Iir_Kind_Architecture_Body
+                  then
+                     Put_Line ("load_library: invalid use of 'with'");
+                     raise Internal_Error;
+                  end if;
+                  Scan_Expect (Tok_Configuration);
+                  Scan_Expect (Tok_Colon);
+                  Scan;
+                  Set_Dependence_List (Design_Unit, Scan_Unit_List);
+                  goto Next_Line;
+               when others =>
+                  Put_Line
+                    ("load_library: line must start with " &
+                     "'architecture', 'entity', 'package' or 'configuration'");
+                  raise Internal_Error;
+            end case;
+
+            if Current_Token /= Tok_Identifier then
+               raise Internal_Error;
+            end if;
+            Set_Identifier (Library_Unit, Current_Identifier);
+            Set_Identifier (Design_Unit, Current_Identifier);
+
+            if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body then
+               Scan_Expect (Tok_Of);
+               Scan_Expect (Tok_Identifier);
+               Set_Entity_Name (Library_Unit, Current_Text);
+            end if;
+
+            -- Scan position.
+            Scan_Expect (Tok_Identifier); -- at
+            Scan_Expect (Tok_Integer);
+            Line := Int32 (Current_Iir_Int64);
+            Scan_Expect (Tok_Left_Paren);
+            Scan_Expect (Tok_Integer);
+            Pos := Source_Ptr (Current_Iir_Int64);
+            Scan_Expect (Tok_Right_Paren);
+            Scan_Expect (Tok_Plus);
+            Scan_Expect (Tok_Integer);
+            Col := Int32 (Current_Iir_Int64);
+            Scan_Expect (Tok_On);
+            Scan_Expect (Tok_Integer);
+            Date := Date_Type (Current_Iir_Int64);
+
+            Scan;
+            if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration
+              and then Current_Token = Tok_Body
+            then
+               Set_Need_Body (Library_Unit, True);
+               Scan;
+            end if;
+            if Current_Token /= Tok_Semi_Colon then
+               raise Internal_Error;
+            end if;
+            Scan;
+
+            if False then
+               Put_Line ("line:" & Int32'Image (Line)
+                         & ", pos:" & Source_Ptr'Image (Pos));
+            end if;
+
+            -- Scan dependence list.
+            Set_Dependence_List (Design_Unit, Scan_Unit_List);
+
+            -- Keep the position of the design unit.
+            --Set_Location (Design_Unit, Location_Type (File));
+            --Set_Location (Library_Unit, Location_Type (File));
+            Set_Design_Unit_Source_Pos (Design_Unit, Pos);
+            Set_Design_Unit_Source_Line (Design_Unit, Line);
+            Set_Design_Unit_Source_Col (Design_Unit, Col);
+            Set_Date (Design_Unit, Date);
+            if Date > Max_Date then
+               Max_Date := Date;
+            end if;
+            Set_Date_State (Design_Unit, Date_Disk);
+            Set_Library_Unit (Design_Unit, Library_Unit);
+            Set_Design_Unit (Library_Unit, Design_Unit);
+
+            --  Add in the unit hash table.
+            Add_Unit_Hash (Design_Unit);
+
+            if Last_Design_Unit = Null_Iir then
+               Set_First_Design_Unit (Design_File, Design_Unit);
+            else
+               Set_Chain (Last_Design_Unit, Design_Unit);
+            end if;
+            Last_Design_Unit := Design_Unit;
+            Set_Last_Design_Unit (Design_File, Design_Unit);
+         end if;
+         << Next_Line >> null;
+      end loop;
+      Set_Date (Library, Max_Date);
+      Close_File;
+      return True;
+   end Load_Library;
+
+   procedure Create_Virtual_Locations
+   is
+      use Files_Map;
+      Implicit_Source_File : Source_File_Entry;
+      Command_Source_File : Source_File_Entry;
+   begin
+      Implicit_Source_File := Create_Virtual_Source_File
+        (Get_Identifier ("*implicit*"));
+      Command_Source_File := Create_Virtual_Source_File
+        (Get_Identifier ("*command line*"));
+      Command_Line_Location := Source_File_To_Location (Command_Source_File);
+      Implicit_Location := Source_File_To_Location (Implicit_Source_File);
+   end Create_Virtual_Locations;
+
+   -- Note: the scanner shouldn't be in use, since this procedure uses it.
+   procedure Load_Std_Library (Build_Standard : Boolean := True)
+   is
+      use Std_Package;
+      Dir : Name_Id;
+   begin
+      if Libraries_Chain /= Null_Iir then
+         --  This procedure must not be called twice.
+         raise Internal_Error;
+      end if;
+
+      Flags.Create_Flag_String;
+      Create_Virtual_Locations;
+
+      Std_Package.Create_First_Nodes;
+
+      --  Create the library.
+      Std_Library := Create_Iir (Iir_Kind_Library_Declaration);
+      Set_Identifier (Std_Library, Std_Names.Name_Std);
+      Set_Location (Std_Library, Implicit_Location);
+      Libraries_Chain := Std_Library;
+      Libraries_Chain_Last := Std_Library;
+
+      if Build_Standard then
+         Create_Std_Standard_Package (Std_Library);
+         Add_Unit_Hash (Std_Standard_Unit);
+      end if;
+
+      if Flags.Bootstrap
+        and then Work_Library_Name = Std_Names.Name_Std
+      then
+         Dir := Work_Directory;
+      else
+         Dir := Null_Identifier;
+      end if;
+      Set_Library_Directory (Std_Library, Dir);
+      if Load_Library (Std_Library) = False
+        and then not Flags.Bootstrap
+      then
+         Error_Msg_Option ("cannot find ""std"" library");
+      end if;
+
+      if Build_Standard then
+         --  Add the standard_file into the library.
+         --  This is done after Load_Library, because it checks there is no
+         --  previous files in the library.
+         Set_Parent (Std_Standard_File, Std_Library);
+         Set_Chain (Std_Standard_File, Get_Design_File_Chain (Std_Library));
+         Set_Design_File_Chain (Std_Library, Std_Standard_File);
+      end if;
+
+      Set_Visible_Flag (Std_Library, True);
+   end Load_Std_Library;
+
+   procedure Load_Work_Library (Empty : Boolean := False)
+   is
+      use Std_Names;
+   begin
+      if Work_Library_Name = Name_Std then
+         if not Flags.Bootstrap then
+            Error_Msg_Option ("the WORK library cannot be STD");
+            return;
+         end if;
+         Work_Library := Std_Library;
+      else
+         Work_Library := Create_Iir (Iir_Kind_Library_Declaration);
+         Set_Location (Work_Library, Implicit_Location);
+         --Set_Visible_Flag (Work_Library, True);
+         Set_Library_Directory (Work_Library, Work_Directory);
+
+         Set_Identifier (Work_Library, Work_Library_Name);
+
+         if not Empty then
+            if Load_Library (Work_Library) = False then
+               null;
+            end if;
+         end if;
+
+         --  Add it to the list of libraries.
+         Set_Chain (Libraries_Chain_Last, Work_Library);
+         Libraries_Chain_Last := Work_Library;
+      end if;
+      Set_Visible_Flag (Work_Library, True);
+   end Load_Work_Library;
+
+   -- Get or create a library from an identifier.
+   function Get_Library (Ident: Name_Id; Loc : Location_Type)
+                        return Iir_Library_Declaration
+   is
+      Library: Iir_Library_Declaration;
+   begin
+      -- library work is a little bit special.
+      if Ident = Std_Names.Name_Work or else Ident = Work_Library_Name then
+         if Work_Library = Null_Iir then
+            --  load_work_library must have been called before.
+            raise Internal_Error;
+         end if;
+         return Work_Library;
+      end if;
+
+      --  Check if the library has already been loaded.
+      Library := Iirs_Utils.Find_Name_In_Chain (Libraries_Chain, Ident);
+      if Library /= Null_Iir then
+         return Library;
+      end if;
+
+      --  This is a new library.
+      if Ident = Std_Names.Name_Std then
+         --  Load_std_library must have been called before.
+         raise Internal_Error;
+      end if;
+
+      Library := Create_Iir (Iir_Kind_Library_Declaration);
+      Set_Location (Library, Scanner.Get_Token_Location);
+      Set_Library_Directory (Library, Null_Identifier);
+      Set_Identifier (Library, Ident);
+      if Load_Library (Library) = False then
+         Error_Msg_Sem ("cannot find resource library """
+                        & Name_Table.Image (Ident) & """", Loc);
+      end if;
+      Set_Visible_Flag (Library, True);
+
+      Set_Chain (Libraries_Chain_Last, Library);
+      Libraries_Chain_Last := Library;
+
+      return Library;
+   end Get_Library;
+
+   -- Return TRUE if LIBRARY_UNIT and UNIT have identifiers for the same
+   -- design unit identifier.
+   -- eg: 'entity A' and 'package A' returns TRUE.
+   function Is_Same_Library_Unit (Library_Unit, Unit: Iir) return Boolean
+   is
+      Entity_Name1, Entity_Name2: Name_Id;
+      Library_Unit_Kind, Unit_Kind : Iir_Kind;
+   begin
+      if Get_Identifier (Unit) /= Get_Identifier (Library_Unit) then
+         return False;
+      end if;
+
+      Library_Unit_Kind := Get_Kind (Library_Unit);
+      Unit_Kind := Get_Kind (Unit);
+
+      --  Package and package body are never the same library unit.
+      if Library_Unit_Kind = Iir_Kind_Package_Declaration
+        and then Unit_Kind = Iir_Kind_Package_Body
+      then
+         return False;
+      end if;
+      if Unit_Kind = Iir_Kind_Package_Declaration
+        and then Library_Unit_Kind = Iir_Kind_Package_Body
+      then
+         return False;
+      end if;
+
+      --  Two architecture declarations are identical only if they also have
+      --  the same entity name.
+      if Unit_Kind = Iir_Kind_Architecture_Body
+        and then Library_Unit_Kind = Iir_Kind_Architecture_Body
+      then
+         Entity_Name1 := Get_Entity_Identifier_Of_Architecture (Unit);
+         Entity_Name2 := Get_Entity_Identifier_Of_Architecture (Library_Unit);
+         if Entity_Name1 /= Entity_Name2 then
+            return False;
+         end if;
+      end if;
+
+      --  An architecture declaration never conflits with a library unit that
+      --  is not an architecture declaration.
+      if (Unit_Kind = Iir_Kind_Architecture_Body
+          and then Library_Unit_Kind /= Iir_Kind_Architecture_Body)
+        or else
+        (Unit_Kind /= Iir_Kind_Architecture_Body
+         and then Library_Unit_Kind = Iir_Kind_Architecture_Body)
+      then
+         return False;
+      end if;
+
+      return True;
+   end Is_Same_Library_Unit;
+
+   procedure Free_Dependence_List (Design : Iir_Design_Unit)
+   is
+      List : Iir_List;
+      El : Iir;
+   begin
+      List := Get_Dependence_List (Design);
+      if List /= Null_Iir_List then
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            Iirs_Utils.Free_Recursive (El);
+         end loop;
+         Destroy_Iir_List (List);
+      end if;
+   end Free_Dependence_List;
+
+   --  This procedure is called when the DESIGN_UNIT (either the stub created
+   --  when a library is read or created from a previous unit in a source
+   --  file) has been replaced by a new unit.  Free everything but DESIGN_UNIT,
+   --  has it may be referenced in other units (dependence...)
+   --  FIXME: Isn't the library unit also referenced too ?
+   procedure Free_Design_Unit (Design_Unit : Iir_Design_Unit)
+   is
+      Lib : Iir;
+      Unit : Iir_Design_Unit;
+      Dep_List : Iir_List;
+   begin
+      --  Free dependence list.
+      Dep_List := Get_Dependence_List (Design_Unit);
+      Destroy_Iir_List (Dep_List);
+      Set_Dependence_List (Design_Unit, Null_Iir_List);
+
+      --  Free default configuration of architecture (if any).
+      Lib := Get_Library_Unit (Design_Unit);
+      if Lib /= Null_Iir
+        and then Get_Kind (Lib) = Iir_Kind_Architecture_Body
+      then
+         Free_Iir (Get_Entity_Name (Lib));
+         Unit := Get_Default_Configuration_Declaration (Lib);
+         if Unit /= Null_Iir then
+            Free_Design_Unit (Unit);
+         end if;
+      end if;
+
+      --  Free library unit.
+      Free_Iir (Lib);
+      Set_Library_Unit (Design_Unit, Null_Iir);
+   end Free_Design_Unit;
+
+   procedure Remove_Unit_From_File
+     (Unit_Ref : Iir_Design_Unit; File : Iir_Design_File)
+   is
+      Prev : Iir_Design_Unit;
+      Unit, Next : Iir_Design_Unit;
+   begin
+      Prev := Null_Iir;
+      Unit := Get_First_Design_Unit (File);
+      while Unit /= Null_Iir loop
+         Next := Get_Chain (Unit);
+         if Unit = Unit_Ref then
+            if Prev = Null_Iir then
+               Set_First_Design_Unit (File, Next);
+            else
+               Set_Chain (Prev, Next);
+            end if;
+            if Next = Null_Iir then
+               Set_Last_Design_Unit (File, Prev);
+            end if;
+            return;
+         end if;
+         Prev := Unit;
+         Unit := Next;
+      end loop;
+      --  Not found.
+      raise Internal_Error;
+   end Remove_Unit_From_File;
+
+   --  Last design_file used.  Kept to speed-up operations.
+   Last_Design_File : Iir_Design_File := Null_Iir;
+
+   -- Add or replace a design unit in the working library.
+   procedure Add_Design_Unit_Into_Library
+     (Unit : in Iir_Design_Unit; Keep_Obsolete : Boolean := False)
+   is
+      Design_File: Iir_Design_File;
+      Design_Unit, Prev_Design_Unit : Iir_Design_Unit;
+      Last_Unit : Iir_Design_Unit;
+      Library_Unit: Iir;
+      New_Library_Unit: Iir;
+      Unit_Id : Name_Id;
+      Date: Date_Type;
+      New_Lib_Time_Stamp : Time_Stamp_Id;
+      Id : Hash_Id;
+
+      --  File name and dir name of DECL.
+      File_Name : Name_Id;
+      Dir_Name : Name_Id;
+   begin
+      --  As specified, the Chain must be not set.
+      pragma Assert (Get_Chain (Unit) = Null_Iir);
+
+      --  The unit must not be in the library.
+      pragma Assert (Get_Date_State (Unit) = Date_Extern);
+
+      --  Mark this design unit as being loaded.
+      New_Library_Unit := Get_Library_Unit (Unit);
+      Unit_Id := Get_Identifier (New_Library_Unit);
+
+      --  Set the date of the design unit as the most recently analyzed
+      --  design unit.
+      case Get_Date (Unit) is
+         when Date_Parsed =>
+            Set_Date_State (Unit, Date_Parse);
+         when Date_Analyzed =>
+            Date := Get_Date (Work_Library) + 1;
+            Set_Date (Unit, Date);
+            Set_Date (Work_Library, Date);
+            Set_Date_State (Unit, Date_Analyze);
+         when Date_Valid =>
+            raise Internal_Error;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  Set file time stamp.
+      declare
+         File : Source_File_Entry;
+         Pos : Source_Ptr;
+      begin
+         Files_Map.Location_To_File_Pos (Get_Location (New_Library_Unit),
+                                         File, Pos);
+         New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File);
+         File_Name := Files_Map.Get_File_Name (File);
+         Image (File_Name);
+         if GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then
+            Dir_Name := Null_Identifier;
+         else
+            Dir_Name := Files_Map.Get_Home_Directory;
+         end if;
+      end;
+
+      --  Try to find a design unit with the same name in the work library.
+      Id := Get_Hash_Id_For_Unit (Unit);
+      Design_Unit := Unit_Hash_Table (Id);
+      Prev_Design_Unit := Null_Iir;
+      while Design_Unit /= Null_Iir loop
+         Design_File := Get_Design_File (Design_Unit);
+         Library_Unit := Get_Library_Unit (Design_Unit);
+         if Get_Identifier (Design_Unit) = Unit_Id
+           and then Get_Library (Design_File) = Work_Library
+           and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit)
+         then
+            --  LIBRARY_UNIT and UNIT designate the same design unit.
+            --  Remove the old one.
+            Set_Date (Design_Unit, Date_Obsolete);
+            declare
+               Next_Design : Iir;
+            begin
+               --  Remove DESIGN_UNIT from the unit_hash.
+               Next_Design := Get_Hash_Chain (Design_Unit);
+               if Prev_Design_Unit = Null_Iir then
+                  Unit_Hash_Table (Id) := Next_Design;
+               else
+                  Set_Hash_Chain (Prev_Design_Unit, Next_Design);
+               end if;
+
+               --  Remove DESIGN_UNIT from the design_file.
+               --  If KEEP_OBSOLETE is True, units that are obsoleted by units
+               --  in the same design file are kept.  This allows to process
+               --  (pretty print, xrefs, ...) all units of a design file.
+               --  But still remove units that are replaced (if a file was
+               --  already in the library).
+               if not Keep_Obsolete
+                 or else Get_Date_State (Design_Unit) = Date_Disk
+               then
+                  Remove_Unit_From_File (Design_Unit, Design_File);
+
+                  Set_Chain (Design_Unit, Obsoleted_Design_Units);
+                  Obsoleted_Design_Units := Design_Unit;
+               end if;
+            end;
+
+            --  UNIT *must* replace library_unit if they don't belong
+            --  to the same file.
+            if Get_Design_File_Filename (Design_File) = File_Name
+              and then Get_Design_File_Directory (Design_File) = Dir_Name
+            then
+               --  In the same file.
+               if Get_Date_State (Design_Unit) = Date_Analyze then
+                  --  Warns only if we are not re-analyzing the file.
+                  if Flags.Warn_Library then
+                     Warning_Msg_Sem
+                       ("redefinition of a library unit in "
+                        & "same design file:", Unit);
+                     Warning_Msg_Sem
+                       (Disp_Node (Library_Unit) & " defined at "
+                        & Disp_Location (Library_Unit) & " is now "
+                        & Disp_Node (New_Library_Unit), Unit);
+                  end if;
+               else
+                  --  Free the stub.
+                  if not Keep_Obsolete then
+                     Free_Design_Unit (Design_Unit);
+                  end if;
+               end if;
+
+               --  Note: the current design unit should not be freed if
+               --  in use; unfortunatly, this is not obvious to check.
+            else
+               if Flags.Warn_Library then
+                  if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit)
+                  then
+                     Warning_Msg ("changing definition of a library unit:");
+                     Warning_Msg (Disp_Node (Library_Unit) & " is now "
+                                  & Disp_Node (New_Library_Unit));
+                  end if;
+                  Warning_Msg
+                    ("library unit '"
+                     & Iirs_Utils.Image_Identifier (Library_Unit)
+                     & "' was also defined in file '"
+                     & Image (Get_Design_File_Filename (Design_File))
+                     & ''');
+               end if;
+            end if;
+            exit;
+         else
+            Prev_Design_Unit := Design_Unit;
+            Design_Unit := Get_Hash_Chain (Design_Unit);
+         end if;
+      end loop;
+
+      --  Try to find the design file in the library.
+      --  First try the last one found.
+      if Last_Design_File /= Null_Iir
+        and then Get_Library (Last_Design_File) = Work_Library
+        and then Get_Design_File_Filename (Last_Design_File) = File_Name
+        and then Get_Design_File_Directory (Last_Design_File) = Dir_Name
+      then
+         Design_File := Last_Design_File;
+      else
+         --  Search.
+         Design_File := Get_Design_File_Chain (Work_Library);
+         while Design_File /= Null_Iir loop
+            if Get_Design_File_Filename (Design_File) = File_Name
+              and then Get_Design_File_Directory (Design_File) = Dir_Name
+            then
+               exit;
+            end if;
+            Design_File := Get_Chain (Design_File);
+         end loop;
+         Last_Design_File := Design_File;
+      end if;
+
+      if Design_File /= Null_Iir
+        and then not Files_Map.Is_Eq (New_Lib_Time_Stamp,
+                                      Get_File_Time_Stamp (Design_File))
+      then
+         -- FIXME: this test is not enough: what about reanalyzing
+         --  unmodified files (this works only because the order is not
+         --  changed).
+         -- Design file is updated.
+         -- Outdate all other units, overwrite the design_file.
+         Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp);
+         Design_Unit := Get_First_Design_Unit (Design_File);
+         while Design_Unit /= Null_Iir loop
+            if Design_Unit /= Unit then
+               --  Mark other design unit as obsolete.
+               Set_Date (Design_Unit, Date_Obsolete);
+               Remove_Unit_Hash (Design_Unit);
+            else
+               raise Internal_Error;
+            end if;
+            Prev_Design_Unit := Design_Unit;
+            Design_Unit := Get_Chain (Design_Unit);
+
+            Set_Chain (Prev_Design_Unit, Obsoleted_Design_Units);
+            Obsoleted_Design_Units := Prev_Design_Unit;
+         end loop;
+         Set_First_Design_Unit (Design_File, Null_Iir);
+         Set_Last_Design_Unit (Design_File, Null_Iir);
+      end if;
+
+      if Design_File = Null_Iir then
+         -- This is the first apparition of the design file.
+         Design_File := Create_Iir (Iir_Kind_Design_File);
+         Location_Copy (Design_File, Unit);
+
+         Set_Design_File_Filename (Design_File, File_Name);
+         Set_Design_File_Directory (Design_File, Dir_Name);
+
+         Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp);
+         Set_Parent (Design_File, Work_Library);
+         Set_Chain (Design_File, Get_Design_File_Chain (Work_Library));
+         Set_Design_File_Chain (Work_Library, Design_File);
+      end if;
+
+      --  Add DECL to DESIGN_FILE.
+      Last_Unit := Get_Last_Design_Unit (Design_File);
+      if Last_Unit = Null_Iir then
+         if Get_First_Design_Unit (Design_File) /= Null_Iir then
+            raise Internal_Error;
+         end if;
+         Set_First_Design_Unit (Design_File, Unit);
+      else
+         if Get_First_Design_Unit (Design_File) = Null_Iir then
+            raise Internal_Error;
+         end if;
+         Set_Chain (Last_Unit, Unit);
+      end if;
+      Set_Last_Design_Unit (Design_File, Unit);
+      Set_Design_File (Unit, Design_File);
+
+      --  Add DECL in unit hash table.
+      Set_Hash_Chain (Unit, Unit_Hash_Table (Id));
+      Unit_Hash_Table (Id) := Unit;
+
+      --  Update the analyzed time stamp.
+      Set_Analysis_Time_Stamp (Design_File, Files_Map.Get_Os_Time_Stamp);
+   end Add_Design_Unit_Into_Library;
+
+   procedure Add_Design_File_Into_Library (File : in out Iir_Design_File)
+   is
+      Unit : Iir_Design_Unit;
+      Next_Unit : Iir_Design_Unit;
+      First_Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (File);
+      First_Unit := Unit;
+      Set_First_Design_Unit (File, Null_Iir);
+      Set_Last_Design_Unit (File, Null_Iir);
+      while Unit /= Null_Iir loop
+         Next_Unit := Get_Chain (Unit);
+         Set_Chain (Unit, Null_Iir);
+         Libraries.Add_Design_Unit_Into_Library (Unit, True);
+         Unit := Next_Unit;
+      end loop;
+      if First_Unit /= Null_Iir then
+         File := Get_Design_File (First_Unit);
+      end if;
+   end Add_Design_File_Into_Library;
+
+   -- Save the file map of library LIBRARY.
+   procedure Save_Library (Library: Iir_Library_Declaration)
+   is
+      use System;
+      use Interfaces.C_Streams;
+      use GNAT.OS_Lib;
+      Temp_Name: constant String := Image (Work_Directory)
+        & '_' & Back_End.Library_To_File_Name (Library) & ASCII.NUL;
+      Mode : constant String := 'w' & ASCII.NUL;
+      Stream : FILEs;
+      Success : Boolean;
+
+      --  Write a string to the temporary file.
+      procedure WR (S : String)
+      is
+         Close_Res : int;
+         pragma Unreferenced (Close_Res);
+      begin
+         if Integer (fwrite (S'Address, S'Length, 1, Stream)) /= 1 then
+            Error_Msg
+              ("cannot write library file for " & Image_Identifier (Library));
+            Close_Res := fclose (Stream);
+            Delete_File (Temp_Name'Address, Success);
+            --  Ignore failure to delete the file.
+            raise Option_Error;
+         end if;
+      end WR;
+
+      --  Write a line terminator in the temporary file.
+      procedure WR_LF is
+      begin
+         WR (String'(1 => ASCII.LF));
+      end WR_LF;
+
+      Design_File: Iir_Design_File;
+      Design_Unit: Iir_Design_Unit;
+      Library_Unit: Iir;
+      Dir : Name_Id;
+
+      Off, Line: Natural;
+      Pos: Source_Ptr;
+      Source_File : Source_File_Entry;
+   begin
+      --  Create a temporary file so that the real library is atomically
+      --  updated, and won't be corrupted in case of Control-C, or concurrent
+      --  writes.
+      Stream := fopen (Temp_Name'Address, Mode'Address);
+
+      if Stream = NULL_Stream then
+         Error_Msg
+           ("cannot create library file for " & Image_Identifier (Library));
+         raise Option_Error;
+      end if;
+
+      --  Header: version.
+      WR ("v 3");
+      WR_LF;
+
+      Design_File := Get_Design_File_Chain (Library);
+      while Design_File /= Null_Iir loop
+         --  Ignore std.standard as there is no corresponding file.
+         if Design_File = Std_Package.Std_Standard_File then
+            goto Continue;
+         end if;
+         Design_Unit := Get_First_Design_Unit (Design_File);
+
+         if Design_Unit /= Null_Iir then
+            WR ("file ");
+            Dir := Get_Design_File_Directory (Design_File);
+            if Dir = Null_Identifier then
+               --  Absolute filenames.
+               WR ("/");
+            elsif Work_Directory = Name_Nil
+              and then Dir = Files_Map.Get_Home_Directory
+            then
+               --  If the library is in the current directory, do not write
+               --  it.  This allows to move the library file.
+               WR (".");
+            else
+               Image (Dir);
+               WR ("""");
+               WR (Name_Buffer (1 .. Name_Length));
+               WR ("""");
+            end if;
+            WR (" """);
+            Image (Get_Design_File_Filename (Design_File));
+            WR (Name_Buffer (1 .. Name_Length));
+            WR (""" """);
+            WR (Files_Map.Get_Time_Stamp_String
+                  (Get_File_Time_Stamp (Design_File)));
+            WR (""" """);
+            WR (Files_Map.Get_Time_Stamp_String
+                  (Get_Analysis_Time_Stamp (Design_File)));
+            WR (""":");
+            WR_LF;
+         end if;
+
+         while Design_Unit /= Null_Iir loop
+            Library_Unit := Get_Library_Unit (Design_Unit);
+
+            WR ("  ");
+            case Get_Kind (Library_Unit) is
+               when Iir_Kind_Entity_Declaration =>
+                  WR ("entity ");
+                  WR (Image_Identifier (Library_Unit));
+               when Iir_Kind_Architecture_Body =>
+                  WR ("architecture ");
+                  WR (Image_Identifier (Library_Unit));
+                  WR (" of ");
+                  WR (Image (Get_Entity_Identifier_Of_Architecture
+                               (Library_Unit)));
+               when Iir_Kind_Package_Declaration
+                 | Iir_Kind_Package_Instantiation_Declaration =>
+                  WR ("package ");
+                  WR (Image_Identifier (Library_Unit));
+               when Iir_Kind_Package_Body =>
+                  WR ("package body ");
+                  WR (Image_Identifier (Library_Unit));
+               when Iir_Kind_Configuration_Declaration =>
+                  WR ("configuration ");
+                  WR (Image_Identifier (Library_Unit));
+               when others =>
+                  Error_Kind ("save_library", Library_Unit);
+            end case;
+
+            if Get_Date_State (Design_Unit) = Date_Disk then
+               Pos := Get_Design_Unit_Source_Pos (Design_Unit);
+               Line := Natural (Get_Design_Unit_Source_Line (Design_Unit));
+               Off := Natural (Get_Design_Unit_Source_Col (Design_Unit));
+            else
+               Files_Map.Location_To_Coord (Get_Location (Design_Unit),
+                                            Source_File, Pos, Line, Off);
+            end if;
+
+            WR (" at");
+            WR (Natural'Image (Line));
+            WR ("(");
+            WR (Source_Ptr'Image (Pos));
+            WR (") +");
+            WR (Natural'Image (Off));
+            WR (" on");
+            case Get_Date (Design_Unit) is
+               when Date_Valid
+                 | Date_Analyzed
+                 | Date_Parsed =>
+                  WR (Date_Type'Image (Get_Date (Design_Unit)));
+               when others =>
+                  WR (Date_Type'Image (Get_Date (Design_Unit)));
+                  raise Internal_Error;
+            end case;
+            if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration
+              and then Get_Need_Body (Library_Unit)
+            then
+               WR (" body");
+            end if;
+            WR (";");
+            WR_LF;
+
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         << Continue >> null;
+         Design_File := Get_Chain (Design_File);
+      end loop;
+
+      declare
+         Fclose_Res : int;
+         pragma Unreferenced (Fclose_Res);
+      begin
+         Fclose_Res := fclose (Stream);
+      end;
+
+      --  Rename the temporary file to the library file.
+      --  FIXME: It may fail if they aren't on the same filesystem, but we
+      --  could assume it doesn't happen (humm...)
+      declare
+         use Files_Map;
+         File_Name: constant String := Image (Work_Directory)
+           & Back_End.Library_To_File_Name (Library) & ASCII.NUL;
+         Delete_Success : Boolean;
+      begin
+         --  For windows: renames doesn't overwrite destination; so first
+         --  delete it. This can create races condition on Unix: if the
+         --  program is killed between delete and rename, the library is lost.
+         Delete_File (File_Name'Address, Delete_Success);
+         Rename_File (Temp_Name'Address, File_Name'Address, Success);
+         if not Success then
+            --  Renaming may fail if the new filename is in a non-existant
+            --  directory.
+            Error_Msg ("cannot update library file """
+                         & File_Name (File_Name'First .. File_Name'Last - 1)
+                         & """");
+            Delete_File (Temp_Name'Address, Success);
+            raise Option_Error;
+         end if;
+      end;
+   end Save_Library;
+
+   -- Save the map of the work library.
+   procedure Save_Work_Library is
+   begin
+      Save_Library (Work_Library);
+   end Save_Work_Library;
+
+   -- Return the name of the latest architecture analysed for an entity.
+   function Get_Latest_Architecture (Entity: Iir_Entity_Declaration)
+                                    return Iir_Architecture_Body
+   is
+      Entity_Id : Name_Id;
+      Lib : Iir_Library_Declaration;
+      Design_File: Iir_Design_File;
+      Design_Unit: Iir_Design_Unit;
+      Library_Unit: Iir;
+      Res: Iir_Design_Unit;
+   begin
+      --  FIXME: use hash
+      Entity_Id := Get_Identifier (Entity);
+      Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity)));
+      Design_File := Get_Design_File_Chain (Lib);
+      Res := Null_Iir;
+      while Design_File /= Null_Iir loop
+         Design_Unit := Get_First_Design_Unit (Design_File);
+         while Design_Unit /= Null_Iir loop
+            Library_Unit := Get_Library_Unit (Design_Unit);
+
+            if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body
+              and then
+              Get_Entity_Identifier_Of_Architecture (Library_Unit) = Entity_Id
+            then
+               if Res = Null_Iir then
+                  Res := Design_Unit;
+               elsif Get_Date (Design_Unit) > Get_Date (Res) then
+                  Res := Design_Unit;
+               end if;
+            end if;
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         Design_File := Get_Chain (Design_File);
+      end loop;
+      if Res = Null_Iir then
+         return Null_Iir;
+      else
+         return Get_Library_Unit (Res);
+      end if;
+   end Get_Latest_Architecture;
+
+   function Load_File (File : Source_File_Entry) return Iir_Design_File
+   is
+      Res : Iir_Design_File;
+   begin
+      Scanner.Set_File (File);
+      Res := Parse.Parse_Design_File;
+      Scanner.Close_File;
+      if Res /= Null_Iir then
+         Set_Parent (Res, Work_Library);
+         Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File));
+      end if;
+      return Res;
+   end Load_File;
+
+   -- parse a file.
+   -- Return a design_file without putting it into the library
+   -- (because it was not semantized).
+   function Load_File (File_Name: Name_Id) return Iir_Design_File
+   is
+      Fe : Source_File_Entry;
+   begin
+      Fe := Files_Map.Load_Source_File (Local_Directory, File_Name);
+      if Fe = No_Source_File_Entry then
+         Error_Msg_Option ("cannot open " & Image (File_Name));
+         return Null_Iir;
+      end if;
+      return Load_File (Fe);
+   end Load_File;
+
+   function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit is
+   begin
+      case Get_Kind (Unit) is
+         when Iir_Kind_Design_Unit =>
+            return Unit;
+         when Iir_Kind_Selected_Name =>
+            declare
+               Lib : Iir_Library_Declaration;
+            begin
+               Lib := Get_Library (Get_Identifier (Get_Prefix (Unit)),
+                                   Get_Location (Unit));
+               return Find_Primary_Unit (Lib, Get_Identifier (Unit));
+            end;
+         when Iir_Kind_Entity_Aspect_Entity =>
+            return Find_Secondary_Unit
+              (Get_Design_Unit (Get_Entity (Unit)),
+               Get_Identifier (Get_Architecture (Unit)));
+         when others =>
+            Error_Kind ("find_design_unit", Unit);
+      end case;
+   end Find_Design_Unit;
+
+   function Is_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir)
+     return Boolean
+   is
+      procedure Error_Obsolete (Msg : String) is
+      begin
+         if not Flags.Flag_Elaborate_With_Outdated then
+            Error_Msg_Sem (Msg, Loc);
+         end if;
+      end Error_Obsolete;
+
+      List : Iir_List;
+      El : Iir;
+      Unit : Iir_Design_Unit;
+      U_Ts : Time_Stamp_Id;
+      Du_Ts : Time_Stamp_Id;
+   begin
+      if Get_Date (Design_Unit) = Date_Obsolete then
+         Error_Obsolete (Disp_Node (Design_Unit) & " is obsolete");
+         return True;
+      end if;
+      List := Get_Dependence_List (Design_Unit);
+      if List = Null_Iir_List then
+         return False;
+      end if;
+      Du_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit));
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Unit := Find_Design_Unit (El);
+         if Unit /= Null_Iir then
+            U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Unit));
+            if Files_Map.Is_Gt (U_Ts, Du_Ts) then
+               Error_Obsolete
+                 (Disp_Node (Design_Unit) & " is obsoleted by " &
+                  Disp_Node (Unit));
+               return True;
+            elsif Is_Obsolete (Unit, Loc) then
+               Error_Obsolete
+                 (Disp_Node (Design_Unit) & " depends on obsolete unit");
+               return True;
+            end if;
+         end if;
+      end loop;
+      return False;
+   end Is_Obsolete;
+
+   procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir)
+   is
+      use Scanner;
+      Line, Off: Natural;
+      Pos: Source_Ptr;
+      Res: Iir;
+      Design_File : Iir_Design_File;
+      Fe : Source_File_Entry;
+   begin
+      --  The unit must not be loaded.
+      pragma Assert (Get_Date_State (Design_Unit) = Date_Disk);
+
+      --  Load and parse the unit.
+      Design_File := Get_Design_File (Design_Unit);
+      Fe := Files_Map.Load_Source_File
+        (Get_Design_File_Directory (Design_File),
+         Get_Design_File_Filename (Design_File));
+      if Fe = No_Source_File_Entry then
+         Error_Msg
+           ("cannot load " & Disp_Node (Get_Library_Unit (Design_Unit)));
+         raise Compilation_Error;
+      end if;
+      Set_File (Fe);
+
+      if not Files_Map.Is_Eq
+        (Files_Map.Get_File_Time_Stamp (Get_Current_Source_File),
+         Get_File_Time_Stamp (Design_File))
+      then
+         Error_Msg_Sem
+           ("file " & Image (Get_Design_File_Filename (Design_File))
+            & " has changed and must be reanalysed", Loc);
+         raise Compilation_Error;
+      elsif Get_Date (Design_Unit) = Date_Obsolete then
+         Error_Msg_Sem
+           (''' & Disp_Node (Get_Library_Unit (Design_Unit))
+            & "' is not anymore in the file",
+            Design_Unit);
+         raise Compilation_Error;
+      end if;
+      Pos := Get_Design_Unit_Source_Pos (Design_Unit);
+      Line := Natural (Get_Design_Unit_Source_Line (Design_Unit));
+      Off := Natural (Get_Design_Unit_Source_Col (Design_Unit));
+      Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos);
+      Set_Current_Position (Pos + Source_Ptr (Off));
+      Res := Parse.Parse_Design_Unit;
+      Close_File;
+      if Res = Null_Iir then
+         raise Compilation_Error;
+      end if;
+      Set_Date_State (Design_Unit, Date_Parse);
+      --  FIXME: check the library unit read is the one expected.
+      --  Copy node.
+      Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit));
+      Set_Library_Unit (Design_Unit, Get_Library_Unit (Res));
+      Set_Design_Unit (Get_Library_Unit (Res), Design_Unit);
+      Set_Parent (Get_Library_Unit (Res), Design_Unit);
+      Set_Context_Items (Design_Unit, Get_Context_Items (Res));
+      Location_Copy (Design_Unit, Res);
+      Free_Dependence_List (Design_Unit);
+      Set_Dependence_List (Design_Unit, Get_Dependence_List (Res));
+      Set_Dependence_List (Res, Null_Iir_List);
+      Free_Iir (Res);
+   end Load_Parse_Design_Unit;
+
+   -- Load, parse, semantize, back-end a design_unit if necessary.
+   procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is
+   begin
+      if Get_Date_State (Design_Unit) = Date_Disk then
+         Load_Parse_Design_Unit (Design_Unit, Loc);
+      end if;
+
+      if Get_Date_State (Design_Unit) = Date_Parse then
+         --  Analyze the design unit.
+
+         if Get_Date (Design_Unit) = Date_Analyzed then
+            --  Work-around for an internal check in sem.
+            --  FIXME: to be removed ?
+            Set_Date (Design_Unit, Date_Parsed);
+         end if;
+
+         --  Avoid infinite recursion, if the unit is self-referenced.
+         Set_Date_State (Design_Unit, Date_Analyze);
+
+         Sem_Scopes.Push_Interpretations;
+         Back_End.Finish_Compilation (Design_Unit);
+         Sem_Scopes.Pop_Interpretations;
+
+      end if;
+
+      case Get_Date (Design_Unit) is
+         when Date_Parsed =>
+            raise Internal_Error;
+         when Date_Analyzing =>
+            --  Self-referenced unit.
+            return;
+         when Date_Analyzed =>
+            --  FIXME: Accept it silently ?
+            --  Note: this is used when Flag_Elaborate_With_Outdated is set.
+            --  This is also used by anonymous configuration declaration.
+            null;
+         when Date_Uptodate =>
+            return;
+         when Date_Valid =>
+            null;
+         when Date_Obsolete =>
+            if not Flags.Flag_Elaborate_With_Outdated then
+               Error_Msg_Sem (Disp_Node (Design_Unit) & " is obsolete", Loc);
+               return;
+            end if;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      if not Flags.Flag_Elaborate_With_Outdated
+        and then Is_Obsolete (Design_Unit, Loc)
+      then
+         Set_Date (Design_Unit, Date_Obsolete);
+      end if;
+   end Load_Design_Unit;
+
+   --  Return the declaration of primary unit NAME of LIBRARY.
+   function Find_Primary_Unit
+     (Library: Iir_Library_Declaration; Name: Name_Id)
+      return Iir_Design_Unit
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Unit_Hash_Table (Name mod Unit_Hash_Length);
+      while Unit /= Null_Iir loop
+         if Get_Identifier (Unit) = Name
+           and then Get_Library (Get_Design_File (Unit)) = Library
+         then
+            case Get_Kind (Get_Library_Unit (Unit)) is
+               when Iir_Kind_Package_Declaration
+                 | Iir_Kind_Package_Instantiation_Declaration
+                 | Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Configuration_Declaration =>
+                  --  Only return a primary unit.
+                  return Unit;
+               when Iir_Kind_Package_Body
+                 | Iir_Kind_Architecture_Body =>
+                  null;
+               when others =>
+                  raise Internal_Error;
+            end case;
+         end if;
+         Unit := Get_Hash_Chain (Unit);
+      end loop;
+
+      -- The primary unit is not in the library, return null.
+      return Null_Iir;
+   end Find_Primary_Unit;
+
+   function Load_Primary_Unit
+     (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir)
+      return Iir_Design_Unit
+   is
+      Design_Unit: Iir_Design_Unit;
+   begin
+      Design_Unit := Find_Primary_Unit (Library, Name);
+      if Design_Unit /= Null_Iir then
+         Load_Design_Unit (Design_Unit, Loc);
+      end if;
+      return Design_Unit;
+   end Load_Primary_Unit;
+
+   -- Return the declaration of secondary unit NAME for PRIMARY, or null if
+   -- not found.
+   function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id)
+      return Iir_Design_Unit
+   is
+      Design_Unit: Iir_Design_Unit;
+      Library_Unit: Iir;
+      Primary_Ident: Name_Id;
+      Lib_Prim : Iir;
+   begin
+      Lib_Prim := Get_Library (Get_Design_File (Primary));
+      Primary_Ident := Get_Identifier (Get_Library_Unit (Primary));
+      Design_Unit := Unit_Hash_Table (Primary_Ident mod Unit_Hash_Length);
+      while Design_Unit /= Null_Iir loop
+         Library_Unit := Get_Library_Unit (Design_Unit);
+
+         --  The secondary is always in the same library as the primary.
+         if Get_Library (Get_Design_File (Design_Unit)) = Lib_Prim then
+            -- Set design_unit to null iff this is not the correct
+            -- design unit.
+            case Get_Kind (Library_Unit) is
+               when Iir_Kind_Architecture_Body =>
+                  -- The entity field can be either an identifier (if the
+                  -- library unit was not loaded) or an access to the entity
+                  -- unit.
+                  if (Get_Entity_Identifier_Of_Architecture (Library_Unit)
+                        = Primary_Ident)
+                    and then Get_Identifier (Library_Unit) = Name
+                  then
+                     return Design_Unit;
+                  end if;
+               when Iir_Kind_Package_Body =>
+                  if Name = Null_Identifier
+                    and then Get_Identifier (Library_Unit) = Primary_Ident
+                  then
+                     return Design_Unit;
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end if;
+         Design_Unit := Get_Hash_Chain (Design_Unit);
+      end loop;
+
+      -- The architecture or the body is not in the library, return null.
+      return Null_Iir;
+   end Find_Secondary_Unit;
+
+   -- Load an secondary unit and analyse it.
+   function Load_Secondary_Unit
+     (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir)
+      return Iir_Design_Unit
+   is
+      Design_Unit: Iir_Design_Unit;
+   begin
+      Design_Unit := Find_Secondary_Unit (Primary, Name);
+      if Design_Unit /= Null_Iir then
+         Load_Design_Unit (Design_Unit, Loc);
+      end if;
+      return Design_Unit;
+   end Load_Secondary_Unit;
+
+   function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit
+   is
+      Res : Iir_Design_Unit := Null_Iir;
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Unit_Hash_Table (Name mod Unit_Hash_Length);
+      while Unit /= Null_Iir loop
+         if Get_Identifier (Unit) = Name
+           and then (Get_Kind (Get_Library_Unit (Unit))
+                     = Iir_Kind_Entity_Declaration)
+         then
+            if Res = Null_Iir then
+               Res := Unit;
+            else
+               --  Many entities.
+               return Null_Iir;
+            end if;
+         end if;
+         Unit := Get_Hash_Chain (Unit);
+      end loop;
+
+      return Res;
+   end Find_Entity_For_Component;
+
+   function Get_Libraries_Chain return Iir_Library_Declaration is
+   begin
+      return Libraries_Chain;
+   end Get_Libraries_Chain;
+end Libraries;
diff --git a/src/libraries.ads b/src/libraries.ads
new file mode 100644
index 000000000..ecb048c94
--- /dev/null
+++ b/src/libraries.ads
@@ -0,0 +1,188 @@
+--  VHDL libraries handling.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+with Std_Names;
+
+package Libraries is
+   -- This package defines the library manager.
+   -- The purpose of the library manager is to associate library logical names
+   -- with host-dependent library.
+   --
+   -- In this implementation a host-dependent library is a file, whose name
+   -- is logical name of the library with the extension '.cf'.  This file
+   -- contains the name and the position (filename, line, column and offset)
+   -- of all library unit of the library.
+   --
+   -- The working library WORK can be aliased with a ressource library,
+   -- they share the same host-dependenet library whose name is the name
+   -- of the ressource library.  This is done by load_work_library.
+
+   --  Location for a command line.
+   Command_Line_Location : Location_Type;
+
+   --  Library declaration for the std library.
+   --  This is also the first library of the libraries chain.
+   Std_Library : Iir_Library_Declaration := Null_Iir;
+
+   --  Library declaration for the work library.
+   --  Note: the identifier of the work_library is work_library_name, which
+   --  may be different from 'WORK'.
+   Work_Library: Iir_Library_Declaration;
+
+   --  Name of the WORK library.
+   Work_Library_Name : Name_Id := Std_Names.Name_Work;
+
+   --  Directory of the work library.
+   --  Set by default by INIT_PATHES to the local directory.
+   Work_Directory : Name_Id;
+
+   --  Local (current) directory.
+   Local_Directory : Name_Id;
+
+   --  Correspond to "" (empty identifier).  Used to denote current directory
+   --  for library directories.
+   Name_Nil : Name_Id;
+
+   --  Chain of obsoleted design units.
+   Obsoleted_Design_Units : Iir := Null_Iir;
+
+   --  Initialize library pathes table.
+   --  Set the local path.
+   procedure Init_Pathes;
+
+   --  Add PATH in the search path.
+   procedure Add_Library_Path (Path : String);
+
+   --  Get the number of path in the search pathes.
+   function Get_Nbr_Pathes return Natural;
+
+   --  Get path N.
+   function Get_Path (N : Natural) return Name_Id;
+
+   --  Set PATH as the path of the work library.
+   procedure Set_Work_Library_Path (Path : String);
+
+   --  Set the name of the work library, load the work library.
+   --  Note: the scanner shouldn't be in use, since this function uses it.
+   --  If EMPTY is set, the work library is just created and not loaded.
+   procedure Load_Work_Library (Empty : Boolean := False);
+
+   --  Initialize the library manager and load the STD library.
+   --  If BUILD_STANDARD is false, the std.standard library is not created.
+   procedure Load_Std_Library (Build_Standard : Boolean := True);
+
+   -- Save the work library as a host-dependent library.
+   procedure Save_Work_Library;
+
+   --  Start the analyse a file (ie load and parse it).
+   --  The file is read from the current directory (unless FILE_NAME is an
+   --    absolute path).
+   --  Emit an error if the file cannot be opened.
+   --  Return NULL_IIR in case of parse error.
+   function Load_File (File_Name: Name_Id) return Iir_Design_File;
+   function Load_File (File : Source_File_Entry) return Iir_Design_File;
+
+   --  Load, parse, semantize, back-end a design_unit if necessary.
+   --  Check Design_Unit is not obsolete.
+   --  LOC is the location where the design unit was needed, in case of error.
+   procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir);
+
+   --  Load and parse DESIGN_UNIT.
+   --  Contrary to Load_Design_Unit, the design_unit is not analyzed.
+   --  Also, the design_unit must not have been already loaded.
+   --  Used almost only by Load_Design_Unit.
+   procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir);
+
+   --  Remove the same file as DESIGN_FILE from work library and all of its
+   --  units.
+   procedure Purge_Design_File (Design_File : Iir_Design_File);
+
+   -- Just return the design_unit for NAME, or NULL if not found.
+   function Find_Primary_Unit
+     (Library: Iir_Library_Declaration; Name: Name_Id)
+     return Iir_Design_Unit;
+
+   -- Load an already analyzed primary unit NAME from library LIBRARY
+   -- and compile it.
+   -- Return NULL_IIR if not found (ie, NAME does not correspond to a
+   --   library unit identifier).
+   function Load_Primary_Unit
+     (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir)
+      return Iir_Design_Unit;
+
+   -- Find the secondary unit of PRIMARY.
+   -- If PRIMARY is a package declaration, returns the package body,
+   -- If PRIMARY is an entity declaration, returns the architecture NAME.
+   -- Return NULL_IIR if not found.
+   function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id)
+      return Iir_Design_Unit;
+
+   -- Load an secondary unit of primary unit PRIMARY and analyse it.
+   -- NAME must be set only for an architecture.
+   function Load_Secondary_Unit
+     (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir)
+     return Iir_Design_Unit;
+
+   --  Get or create a library from an identifier.
+   --  LOC is used only to report errors.
+   function Get_Library (Ident : Name_Id; Loc : Location_Type)
+                        return Iir_Library_Declaration;
+
+   --  Add or replace an design unit in the work library.
+   --  DECL must not have a chain (because it may be modified).
+   --
+   --  If the design_file of UNIT is not already in the library, a new one
+   --  is created.
+   --
+   --  Units are always appended to the design_file.  Therefore, the order is
+   --  kept.
+   --
+   --  If KEEP_OBSOLETE is True, obsoleted units are kept in the library.
+   --  This is used when a whole design file has to be added in the library and
+   --  then processed (without that feature, redefined units would disappear).
+   procedure Add_Design_Unit_Into_Library
+     (Unit : in Iir_Design_Unit; Keep_Obsolete : Boolean := False);
+
+   --  Put all design_units of FILE into the work library, by calling
+   --  Add_Design_Unit_Into_Library.
+   --  FILE is updated since it may changed (FILE is never put in the library,
+   --  a new one is created).
+   procedure Add_Design_File_Into_Library (File : in out Iir_Design_File);
+
+   -- Return the latest architecture analysed for entity ENTITY.
+   function Get_Latest_Architecture (Entity: Iir_Entity_Declaration)
+                                    return Iir_Architecture_Body;
+
+   --  Return the design unit (stubed if not loaded) from UNIT.
+   --  UNIT may be either a design unit, in this case UNIT is returned,
+   --     or a selected name, in this case the prefix is a library name and
+   --        the suffix a primary design unit name,
+   --     or an entity_aspect_entity to designate an architectrure.
+   --  Return null_iir if the design unit is not found.
+   function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit;
+
+   --  Find an entity whose name is NAME in any library.
+   --  If there is no such entity, return NULL_IIR.
+   --  If there are severals entities, return NULL_IIR;
+   function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit;
+
+   --  Get the chain of libraries.  Can be used only to read (it musn't be
+   --  modified).
+   function Get_Libraries_Chain return Iir_Library_Declaration;
+end Libraries;
diff --git a/src/lists.adb b/src/lists.adb
new file mode 100644
index 000000000..38afea595
--- /dev/null
+++ b/src/lists.adb
@@ -0,0 +1,257 @@
+--  Lists data type.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; 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 GNAT.Table;
+
+package body Lists is
+   type Node_Array_Fat is array (Natural) of Node_Type;
+   type Node_Array_Fat_Acc is access Node_Array_Fat;
+
+   type List_Record is record
+      Max : Natural;
+      Nbr : Natural;
+      Next : List_Type;
+      Els : Node_Array_Fat_Acc;
+   end record;
+
+   package Listt is new GNAT.Table
+     (Table_Component_Type => List_Record,
+      Table_Index_Type => List_Type,
+      Table_Low_Bound => 4,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --function Get_Max_Nbr_Elements (List : List_Type) return Natural;
+   --pragma Inline (Get_Max_Nbr_Elements);
+
+   --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural);
+   --pragma Inline (Set_Max_Nbr_Elements);
+
+   procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural);
+   pragma Inline (List_Set_Nbr_Elements);
+
+   function Get_Nbr_Elements (List: List_Type) return Natural is
+   begin
+      return Listt.Table (List).Nbr;
+   end Get_Nbr_Elements;
+
+   procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural) is
+   begin
+      Listt.Table (List).Nbr := Nbr;
+   end List_Set_Nbr_Elements;
+
+   --function Get_Max_Nbr_Elements (List : List_Type) return Natural is
+   --begin
+   --   return Listt.Table (List).Max;
+   --end Get_Max_Nbr_Elements;
+
+   --procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is
+   --begin
+   --   Listt.Table (List).Max := Max;
+   --end Set_Max_Nbr_Elements;
+
+   function Get_Nth_Element (List: List_Type; N: Natural)
+     return Node_Type
+   is
+   begin
+      if N >= Listt.Table (List).Nbr then
+         return Null_Node;
+      end if;
+      return Listt.Table (List).Els (N);
+   end Get_Nth_Element;
+
+   -- Replace an element selected by position.
+   procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type)
+   is
+   begin
+      if N >= Listt.Table (List).Nbr then
+         raise Program_Error;
+      end if;
+      Listt.Table (List).Els (N) := El;
+   end Replace_Nth_Element;
+
+   -- Be sure an element can be added to LIST.
+   -- It doesn't change the number of elements.
+   procedure List_Grow (List: List_Type)
+   is
+      L : List_Record renames Listt.Table (List);
+
+      --  Be careful: size in bytes.
+      function Alloc (Size : Natural) return Node_Array_Fat_Acc;
+      pragma Import (C, Alloc, "malloc");
+
+      function Realloc (Ptr : Node_Array_Fat_Acc; Size : Natural)
+        return Node_Array_Fat_Acc;
+      pragma Import (C, Realloc, "realloc");
+
+      Tmp : Node_Array_Fat_Acc;
+      N : Natural;
+   begin
+      if L.Nbr < L.Max then
+         return;
+      end if;
+      if L.Max = 0 then
+         N := 8;
+         Tmp := Alloc (N * Node_Type'Size / System.Storage_Unit);
+      else
+         N := L.Max * 2;
+         Tmp := Realloc (L.Els, N * Node_Type'Size / System.Storage_Unit);
+      end if;
+      L.Els := Tmp;
+      L.Max := N;
+   end List_Grow;
+
+   procedure Append_Element (List: List_Type; Element: Node_Type)
+   is
+      L : List_Record renames Listt.Table (List);
+   begin
+      if L.Nbr >= L.Max then
+         List_Grow (List);
+      end if;
+      L.Els (L.Nbr) := Element;
+      L.Nbr := L.Nbr + 1;
+   end Append_Element;
+
+   -- Return the last element of the list, or null.
+   function Get_Last_Element (List: List_Type) return Node_Type
+   is
+      L : List_Record renames Listt.Table (List);
+   begin
+      if L.Nbr = 0 then
+         return Null_Node;
+      else
+         return L.Els (L.Nbr - 1);
+      end if;
+   end Get_Last_Element;
+
+   -- Return the first element of the list, or null.
+   function Get_First_Element (List: List_Type) return Node_Type is
+   begin
+      if Listt.Table (List).Nbr = 0 then
+         return Null_Node;
+      else
+         return Listt.Table (List).Els (0);
+      end if;
+   end Get_First_Element;
+
+   -- Add (append) an element only if it was not already present in the list.
+   procedure Add_Element (List: List_Type; El: Node_Type)
+   is
+      Nbr : constant Natural := Get_Nbr_Elements (List);
+   begin
+      for I in 0 .. Nbr - 1 loop
+         if Listt.Table (List).Els (I) = El then
+            return;
+         end if;
+      end loop;
+
+      Append_Element (List, El);
+   end Add_Element;
+
+   procedure Remove_Nth_Element (List: List_Type; N: Natural)
+   is
+      Nbr : constant Natural := Get_Nbr_Elements (List);
+   begin
+      if N >= Nbr then
+         raise Program_Error;
+      end if;
+      for I in N .. Nbr - 2 loop
+         Listt.Table (List).Els (I) := Listt.Table (List).Els (I + 1);
+      end loop;
+      Listt.Table (List).Nbr := Nbr - 1;
+   end Remove_Nth_Element;
+
+   procedure Set_Nbr_Elements (List: List_Type; N: Natural) is
+   begin
+      if N > Get_Nbr_Elements (List) then
+         raise Program_Error;
+      end if;
+      List_Set_Nbr_Elements (List, N);
+   end Set_Nbr_Elements;
+
+   -- Return the position of the last element.
+   -- Return -1 if the list is empty.
+   function Get_Last_Element_Position (List: List_Type) return Integer is
+   begin
+      return Get_Nbr_Elements (List) - 1;
+   end Get_Last_Element_Position;
+
+   function Get_Nbr_Elements_Safe (List: List_Type) return Natural is
+   begin
+      if List = Null_List then
+         return 0;
+      else
+         return Get_Nbr_Elements (List);
+      end if;
+   end Get_Nbr_Elements_Safe;
+
+   -- Empty the list
+   procedure Empty_List (List: List_Type) is
+   begin
+      Set_Nbr_Elements (List, 0);
+   end Empty_List;
+
+   --  Chain of unused lists.
+   Free_Chain : List_Type := Null_List;
+
+   function Create_List return List_Type
+   is
+      Res : List_Type;
+   begin
+      if Free_Chain = Null_List then
+         Listt.Increment_Last;
+         Res := Listt.Last;
+      else
+         Res := Free_Chain;
+         Free_Chain := Listt.Table (Res).Next;
+      end if;
+      Listt.Table (Res) := List_Record'(Max => 0, Nbr => 0,
+                                        Next => Null_List, Els => null);
+      return Res;
+   end Create_List;
+
+   procedure Free (Ptr : Node_Array_Fat_Acc);
+   pragma Import (C, Free, "free");
+
+   procedure Destroy_List (List : in out List_Type)
+   is
+   begin
+      if List = Null_List then
+         return;
+      end if;
+      if Listt.Table (List).Max > 0 then
+         Free (Listt.Table (List).Els);
+         Listt.Table (List).Els := null;
+      end if;
+      Listt.Table (List).Next := Free_Chain;
+      Free_Chain := List;
+      List := Null_List;
+   end Destroy_List;
+
+   procedure Initialize is
+   begin
+      for I in Listt.First .. Listt.Last loop
+         if Listt.Table (I).Els /= null then
+            Free (Listt.Table (I).Els);
+         end if;
+      end loop;
+      Listt.Free;
+      Listt.Init;
+   end Initialize;
+
+end Lists;
diff --git a/src/lists.ads b/src/lists.ads
new file mode 100644
index 000000000..7645e3403
--- /dev/null
+++ b/src/lists.ads
@@ -0,0 +1,123 @@
+--  Lists data type.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Nodes; use Nodes;
+
+package Lists is
+   type List_Type is new Nat32;
+   for List_Type'Size use 32;
+
+   Null_List : constant List_Type := 0;
+
+   List_Others : constant List_Type := 1;
+   List_All : constant List_Type := 2;
+
+   -----------
+   -- Lists --
+   -----------
+
+   -- Iir_Kinds_List
+   -- Lists of elements.
+   -- index is 0 .. nbr_elements - 1.
+   --
+   -- Append an element to (the end of) the list.
+   --   procedure Append_Element (List: in Iir; Element: Iir);
+   --
+   -- Get the N th element in list, starting from 0.
+   -- Return an access to the element or null_iir, if beyond bounds.
+   --   function Get_Nth_Element (List: in Iir; N: Natural) return Iir;
+   --
+   -- Return the last element of the list, or null_iir.
+   --   function Get_Last_Element (List: in Iir) return Iir;
+   --
+   -- Return the first element of the list, or null_iir.
+   --   function Get_First_Element (List: in Iir) return Iir;
+   --
+   -- Replace an element selected by position.
+   --   procedure Replace_Nth_Element (List: in Iir_List; N: Natural; El:Iir);
+   --
+   -- Add (append) an element only if it was not already present in the list.
+   -- Return its position.
+   --   procedure Add_Element (List: in Iir; El: Iir; Position: out integer);
+   --   procedure Add_Element (List: in Iir_List; El: Iir);
+   --
+   -- Return the number of elements in the list.
+   -- This is also 1 + the position of the last element.
+   --   function Get_Nbr_Elements (List: in Iir_List) return Natural;
+   --
+   -- Set the number of elements in the list.
+   -- Can be used only to shrink the list.
+   --   procedure Set_Nbr_Elements (List: in Iir_List; N: Natural);
+   --
+   -- Remove an element from the list.
+   --   procedure remove_Nth_Element (List: in Iir_List; N: Natural);
+   --
+   -- Return the position of the last element.
+   -- Return -1 if the list is empty.
+   --   function Get_Last_Element_Position (List: in Iir_List) return Integer;
+   --
+   -- Empty the list.
+   -- This is also set_nbr_elements (list, 0);
+   --   procedure Empty_List (List: in Iir_List);
+   --
+   -- Alias a list.  TARGET must be empty.
+   --   procedure Alias_List (Target: in out Iir; Source: in Iir);
+
+   procedure Append_Element (List: List_Type; Element: Node_Type);
+
+   -- Get the N th element in list, starting from 0.
+   -- Return the element or null_iir, if beyond bounds.
+   function Get_Nth_Element (List: List_Type; N: Natural) return Node_Type;
+
+   function Get_Last_Element (List: List_Type) return Node_Type;
+
+   function Get_First_Element (List: List_Type) return Node_Type;
+
+   procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type);
+
+   procedure Add_Element (List: List_Type; El: Node_Type);
+
+   -- Return the number of elements in the list.
+   -- This is also 1 + the position of the last element.
+   function Get_Nbr_Elements (List: List_Type) return Natural;
+   pragma Inline (Get_Nbr_Elements);
+
+   --  Same as get_nbr_elements but returns 0 if LIST is NULL_IIR.
+   function Get_Nbr_Elements_Safe (List : List_Type) return Natural;
+
+   -- Set the number of elements in the list.
+   -- Can be used only to shrink the list.
+   procedure Set_Nbr_Elements (List: List_Type; N: Natural);
+
+   procedure Remove_Nth_Element (List : List_Type; N: Natural);
+
+   function Get_Last_Element_Position (List: List_Type) return Integer;
+
+   --  Clear the list.
+   procedure Empty_List (List: List_Type);
+
+   --  Create a list.
+   function Create_List return List_Type;
+
+   --  Destroy a list.
+   procedure Destroy_List (List : in out List_Type);
+
+   --  Free all the lists and reset to initial state.
+   --  Must be used to free the memory used by the lists.
+   procedure Initialize;
+end Lists;
diff --git a/src/name_table.adb b/src/name_table.adb
new file mode 100644
index 000000000..af60ec0b7
--- /dev/null
+++ b/src/name_table.adb
@@ -0,0 +1,359 @@
+--  Name table.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Table;
+
+package body Name_Table is
+   -- A flag that creates verbosity.
+   Debug_Name_Table: constant Boolean := False;
+
+   First_Character_Name_Id : constant Name_Id := 1;
+
+   type Hash_Value_Type is mod 2**32;
+
+   -- An entry in the name table.
+   type Identifier is record
+      Hash: Hash_Value_Type;
+      Next: Name_Id;
+
+      --  FIXME: to be removed (compute from name of next identifier).
+      Length: Natural;
+
+      --  Index in strings_table.
+      Name: Natural;
+
+      --  User infos.
+      Info: Int32;
+   end record;
+
+   -- Hash table.
+   -- Number of entry points.
+   Hash_Table_Size: constant Hash_Value_Type := 1024;
+   Hash_Table: array (0 .. Hash_Table_Size - 1) of Name_Id;
+
+   -- The table to store all the strings.
+   package Strings_Table is new GNAT.Table
+     (Table_Index_Type => Natural,
+      Table_Component_Type => Character,
+      Table_Low_Bound => Natural'First,
+      Table_Initial => 4096,
+      Table_Increment => 100);
+
+   -- A NUL character is stored after each word in the strings_table.
+   -- This is used for compatibility with C.
+   NUL: constant Character := Character'Val (0);
+
+   -- Allocate place in the strings_table, and store the name_buffer into it.
+   -- Also append a NUL.
+   function Store return Natural is
+      Res: Natural;
+   begin
+      Res := Strings_Table.Allocate (Name_Length + 1);
+      Strings_Table.Table (Res .. Res + Name_Length - 1) :=
+        Strings_Table.Table_Type (Name_Buffer (1 .. Name_Length));
+      Strings_Table.Table (Res + Name_Length) := NUL;
+      return Res;
+   end Store;
+
+   package Names_Table is new GNAT.Table
+     (Table_Index_Type => Name_Id,
+      Table_Component_Type => Identifier,
+      Table_Low_Bound => Name_Id'First,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   -- Initialize this package
+   -- This must be called once and only once before any use.
+   procedure Initialize is
+      Pos: Natural;
+      Id: Name_Id;
+   begin
+      Strings_Table.Init;
+      Names_Table.Init;
+      -- Reserve entry 0.
+      if Names_Table.Allocate /= Null_Identifier then
+         raise Program_Error;
+      end if;
+      Strings_Table.Set_Last (1);
+      Names_Table.Table (Null_Identifier) := (Length => 0,
+                                              Hash => 0,
+                                              Name => 1,
+                                              Next => Null_Identifier,
+                                              Info => 0);
+      -- Store characters.
+      for C in Character loop
+         Pos := Strings_Table.Allocate;
+         Strings_Table.Table (Pos) := C;
+         Id := Names_Table.Allocate;
+         Names_Table.Table (Id) := (Length => 1,
+                                    Hash => 0,
+                                    Name => Pos,
+                                    Next => Null_Identifier,
+                                    Info => 0);
+      end loop;
+      Hash_Table := (others => Null_Identifier);
+   end Initialize;
+
+   -- Compute the hash value of a string.
+   function Hash return Hash_Value_Type is
+      Res: Hash_Value_Type := 0;
+   begin
+      for I in 1 .. Name_Length loop
+         Res := Res * 7 + Character'Pos(Name_Buffer(I));
+         Res := Res + Res / 2**28;
+      end loop;
+      return Res;
+   end Hash;
+
+   -- Get the string associed to an identifier.
+   function Image (Id: Name_Id) return String is
+      Name_Entry: Identifier renames Names_Table.Table(Id);
+      subtype Result_Type is String (1 .. Name_Entry.Length);
+   begin
+      if Is_Character (Id) then
+         return ''' & Strings_Table.Table (Name_Entry.Name) & ''';
+      else
+         return Result_Type
+           (Strings_Table.Table
+            (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1));
+      end if;
+   end Image;
+
+   procedure Image (Id : Name_Id)
+   is
+      Name_Entry: Identifier renames Names_Table.Table(Id);
+   begin
+      if Is_Character (Id) then
+         Name_Buffer (1) := Get_Character (Id);
+         Name_Length := 1;
+      else
+         Name_Length := Name_Entry.Length;
+         Name_Buffer (1 .. Name_Entry.Length) := String
+           (Strings_Table.Table
+            (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1));
+      end if;
+   end Image;
+
+   -- Get the address of the first character of ID.
+   -- The string is NUL-terminated (this is done by get_identifier).
+   function Get_Address (Id: Name_Id) return System.Address is
+      Name_Entry: Identifier renames Names_Table.Table(Id);
+   begin
+      return Strings_Table.Table (Name_Entry.Name)'Address;
+   end Get_Address;
+
+   function Get_Name_Length (Id: Name_Id) return Natural is
+   begin
+      return Names_Table.Table(Id).Length;
+   end Get_Name_Length;
+
+   function Is_Character (Id: Name_Id) return Boolean is
+   begin
+      return Id >= First_Character_Name_Id and then
+        Id <= First_Character_Name_Id + Character'Pos (Character'Last);
+   end Is_Character;
+
+   -- Get the character associed to an identifier.
+   function Get_Character (Id: Name_Id) return Character is
+   begin
+      pragma Assert (Is_Character (Id));
+      return Character'Val (Id - First_Character_Name_Id);
+   end Get_Character;
+
+   -- Get and set the info field associated with each identifier.
+   -- Used to store interpretations of the name.
+   function Get_Info (Id: Name_Id) return Int32 is
+   begin
+      return Names_Table.Table (Id).Info;
+   end Get_Info;
+
+   procedure Set_Info (Id: Name_Id; Info: Int32) is
+   begin
+      Names_Table.Table (Id).Info := Info;
+   end Set_Info;
+
+   function Compare_Name_Buffer_With_Name (Id : Name_Id) return Boolean
+   is
+      Ne: Identifier renames Names_Table.Table(Id);
+   begin
+      return String (Strings_Table.Table (Ne.Name .. Ne.Name + Ne.Length - 1))
+        = Name_Buffer (1 .. Name_Length);
+   end Compare_Name_Buffer_With_Name;
+
+   -- Get or create an entry in the name table.
+   -- The string is taken from NAME_BUFFER and NAME_LENGTH.
+   function Get_Identifier return Name_Id
+   is
+      Hash_Value, Hash_Index: Hash_Value_Type;
+      Res: Name_Id;
+   begin
+      Hash_Value := Hash;
+      Hash_Index := Hash_Value mod Hash_Table_Size;
+
+      if Debug_Name_Table then
+         Put_Line ("get_identifier " & Name_Buffer (1 .. Name_Length));
+      end if;
+
+      Res := Hash_Table (Hash_Index);
+      while Res /= Null_Identifier loop
+         --Put_Line ("compare with " & Get_String (Res));
+         if Names_Table.Table (Res).Hash = Hash_Value
+           and then Names_Table.Table (Res).Length = Name_Length
+           and then Compare_Name_Buffer_With_Name (Res)
+         then
+            --Put_Line ("found");
+            return Res;
+         end if;
+         Res := Names_Table.Table (Res).Next;
+      end loop;
+      Res := Names_Table.Allocate;
+      Names_Table.Table (Res) := (Length => Name_Length,
+                                  Hash => Hash_Value,
+                                  Name => Store,
+                                  Next => Hash_Table (Hash_Index),
+                                  Info => 0);
+      Hash_Table (Hash_Index) := Res;
+      --Put_Line ("created");
+      return Res;
+   end Get_Identifier;
+
+   function Get_Identifier_No_Create return Name_Id
+   is
+      Hash_Value, Hash_Index: Hash_Value_Type;
+      Res: Name_Id;
+   begin
+      Hash_Value := Hash;
+      Hash_Index := Hash_Value mod Hash_Table_Size;
+
+      Res := Hash_Table (Hash_Index);
+      while Res /= Null_Identifier loop
+         if Names_Table.Table (Res).Hash = Hash_Value
+           and then Names_Table.Table (Res).Length = Name_Length
+           and then Compare_Name_Buffer_With_Name (Res)
+         then
+            return Res;
+         end if;
+         Res := Names_Table.Table (Res).Next;
+      end loop;
+      return Null_Identifier;
+   end Get_Identifier_No_Create;
+
+   -- Get or create an entry in the name table.
+   function Get_Identifier (Str: String) return Name_Id is
+   begin
+      Name_Length := Str'Length;
+      Name_Buffer (1 .. Name_Length) := Str;
+      return Get_Identifier;
+   end Get_Identifier;
+
+   function Get_Identifier (Char: Character) return Name_Id is
+   begin
+      return First_Character_Name_Id + Character'Pos (Char);
+   end Get_Identifier;
+
+   -- Be sure all info fields have their default value.
+   procedure Assert_No_Infos is
+      Err: Boolean := False;
+   begin
+      for I in Names_Table.First .. Names_Table.Last loop
+         if Get_Info (I) /= 0 then
+            Err := True;
+            Put_Line ("still infos in" & Name_Id'Image (I) & ", ie: "
+                      & Image (I) & ", info ="
+                      & Int32'Image (Names_Table.Table (I).Info));
+         end if;
+      end loop;
+      if Err then
+         raise Program_Error;
+      end if;
+   end Assert_No_Infos;
+
+   -- Return the latest name_id used.
+   -- kludge, use only for debugging.
+   function Last_Name_Id return Name_Id is
+   begin
+      return Names_Table.Last;
+   end Last_Name_Id;
+
+   -- Used to debug.
+   -- Disp the strings table, one word per line.
+   procedure Dump;
+   pragma Unreferenced (Dump);
+
+   procedure Dump
+   is
+      First: Natural;
+   begin
+      Put_Line ("strings_table:");
+      First := 0;
+      for I in 0 .. Strings_Table.Last loop
+         if Strings_Table.Table(I) = NUL then
+            Put_Line (Natural'Image (First) & ": "
+                      & String (Strings_Table.Table (First .. I - 1)));
+            First := I + 1;
+         end if;
+      end loop;
+   end Dump;
+
+   function Get_Hash_Entry_Length (H : Hash_Value_Type) return Natural
+   is
+      Res : Natural := 0;
+      N : Name_Id;
+   begin
+      N := Hash_Table (H);
+      while N /= Null_Identifier loop
+         Res := Res + 1;
+         N := Names_Table.Table (N).Next;
+      end loop;
+      return Res;
+   end Get_Hash_Entry_Length;
+
+   procedure Disp_Stats
+   is
+      Min : Natural;
+      Max : Natural;
+      N : Natural;
+   begin
+      Put_Line ("Name table statistics:");
+      Put_Line (" number of identifiers: " & Name_Id'Image (Last_Name_Id));
+      Put_Line (" size of strings: " & Natural'Image (Strings_Table.Last));
+      Put_Line (" hash distribution (number of entries per length):");
+      Min := Natural'Last;
+      Max := Natural'First;
+      for I in Hash_Table'Range loop
+         N := Get_Hash_Entry_Length (I);
+         Min := Natural'Min (Min, N);
+         Max := Natural'Max (Max, N);
+      end loop;
+      declare
+         type Nat_Array is array (Min .. Max) of Natural;
+         S : Nat_Array := (others => 0);
+      begin
+         for I in Hash_Table'Range loop
+            N := Get_Hash_Entry_Length (I);
+            S (N) := S (N) + 1;
+         end loop;
+         for I in S'Range loop
+            if S (I) /= 0 then
+               Put_Line ("  " & Natural'Image (I)
+                         & ":" & Natural'Image (S (I)));
+            end if;
+         end loop;
+      end;
+   end Disp_Stats;
+end Name_Table;
diff --git a/src/name_table.ads b/src/name_table.ads
new file mode 100644
index 000000000..c3d3e72f1
--- /dev/null
+++ b/src/name_table.ads
@@ -0,0 +1,98 @@
+--  Name table.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; 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 Types; use Types;
+
+-- A very simple name table.
+-- This is an hash table, such as id1=id2 <=> get_string(id1)=get_string(id2).
+
+package Name_Table is
+   -- Initialize the package, ie create tables.
+   procedure Initialize;
+
+   -- Get an entry in the name table.
+   -- (entries for characters are already built).
+   function Get_Identifier (Char: Character) return Name_Id;
+   pragma Inline (Get_Identifier);
+
+   -- Get or create an entry in the name table.
+   -- If an entry is created, its token value is tok_identifier.
+   -- Note:
+   -- an identifier is represented in all lower case letter,
+   -- an extended identifier is represented in backslashes, double internal
+   --   backslashes are simplified,
+   -- a string is represented by its contents (without the quotation
+   --  characters, and simplified),
+   -- a bit string is represented by its raw contents (no simplification).
+   function Get_Identifier (Str: String) return Name_Id;
+
+   -- Get the string associed to a name.
+   -- If the name is a character, then single quote are added.
+   function Image (Id: Name_Id) return String;
+
+   -- Get the address of the first character of ID.
+   -- The string is NUL-terminated (this is done by get_identifier).
+   function Get_Address (Id: Name_Id) return System.Address;
+
+   -- Get the length of ID.
+   function Get_Name_Length (Id: Name_Id) return Natural;
+   pragma Inline (Get_Name_Length);
+
+   -- Get the character associed to a name.
+   function Get_Character (Id: Name_Id) return Character;
+   pragma Inline (Get_Character);
+
+   --  Return TRUE iff ID is a character.
+   function Is_Character (Id: Name_Id) return Boolean;
+   pragma Inline (Is_Character);
+
+   -- Get or create an entry in the name table, use NAME_BUFFER/NAME_LENGTH.
+   function Get_Identifier return Name_Id;
+
+   --  Like GET_IDENTIFIER, but return NULL_IDENTIFIER if the identifier
+   --  is not found (and do not create an entry for it).
+   function Get_Identifier_No_Create return Name_Id;
+
+   --  Set NAME_BUFFER/NAME_LENGTH with the image of ID.
+   procedure Image (Id : Name_Id);
+
+   -- Get and set the info field associated with each identifier.
+   -- Used to store interpretations of the name.
+   function Get_Info (Id: Name_Id) return Int32;
+   pragma Inline (Get_Info);
+   procedure Set_Info (Id: Name_Id; Info: Int32);
+   pragma Inline (Set_Info);
+
+   -- Return the latest name_id used.
+   -- kludge, use only for debugging.
+   function Last_Name_Id return Name_Id;
+
+   -- Be sure all info fields have their default value.
+   procedure Assert_No_Infos;
+
+   -- This buffer is used by get_token to set the name.
+   -- This can be seen as a copy buffer but this is necessary for two reasons:
+   --  names case must be 'normalized', because VHDL is case insensitive.
+   Name_Buffer : String (1 .. 1024);
+   -- The length of the name string.
+   Name_Length: Natural;
+
+   --  Disp statistics.
+   --  Used for debugging.
+   procedure Disp_Stats;
+end Name_Table;
diff --git a/src/nodes.adb b/src/nodes.adb
new file mode 100644
index 000000000..2dc7736ce
--- /dev/null
+++ b/src/nodes.adb
@@ -0,0 +1,467 @@
+--  Internal node type and operations.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.Table;
+
+package body Nodes is
+   --  Suppress the access check of the table base.  This is really safe to
+   --  suppress this check because the table base cannot be null.
+   pragma Suppress (Access_Check);
+
+   --  Suppress the index check on the table.
+   --  Could be done during non-debug, since this may catch errors (reading
+   --  Null_Node or Error_Node).
+   --pragma Suppress (Index_Check);
+
+   --  Suppress discriminant checks on the table.  Relatively safe, since
+   --  iirs do their own checks.
+   pragma Suppress (Discriminant_Check);
+
+   package Nodet is new GNAT.Table
+     (Table_Component_Type => Node_Record,
+      Table_Index_Type => Node_Type,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   function Get_Last_Node return Node_Type is
+   begin
+      return Nodet.Last;
+   end Get_Last_Node;
+
+   Free_Chain : Node_Type := Null_Node;
+
+   --  Just to have the default value.
+   pragma Warnings (Off);
+   Init_Short  : Node_Record (Format_Short);
+   Init_Medium : Node_Record (Format_Medium);
+   Init_Fp     : Node_Record (Format_Fp);
+   Init_Int    : Node_Record (Format_Int);
+   pragma Warnings (On);
+
+   function Create_Node (Format : Format_Type) return Node_Type
+   is
+      Res : Node_Type;
+   begin
+      if Format = Format_Medium then
+         --  Allocate a first node.
+         Nodet.Increment_Last;
+         Res := Nodet.Last;
+         --  Check alignment.
+         if Res mod 2 = 1 then
+            Set_Field1 (Res, Free_Chain);
+            Free_Chain := Res;
+            Nodet.Increment_Last;
+            Res := Nodet.Last;
+         end if;
+         --  Allocate the second node.
+         Nodet.Increment_Last;
+         Nodet.Table (Res) := Init_Medium;
+         Nodet.Table (Res + 1) := Init_Medium;
+      else
+         --  Check from free pool
+         if Free_Chain = Null_Node then
+            Nodet.Increment_Last;
+            Res := Nodet.Last;
+         else
+            Res := Free_Chain;
+            Free_Chain := Get_Field1 (Res);
+         end if;
+         case Format is
+            when Format_Short =>
+               Nodet.Table (Res) := Init_Short;
+            when Format_Medium =>
+               raise Program_Error;
+            when Format_Fp =>
+               Nodet.Table (Res) := Init_Fp;
+            when Format_Int =>
+               Nodet.Table (Res) := Init_Int;
+         end case;
+      end if;
+      return Res;
+   end Create_Node;
+
+   procedure Free_Node (N : Node_Type)
+   is
+   begin
+      if N /= Null_Node then
+         Set_Nkind (N, 0);
+         Set_Field1 (N, Free_Chain);
+         Free_Chain := N;
+         if Nodet.Table (N).Format = Format_Medium then
+            Set_Field1 (N + 1, Free_Chain);
+            Free_Chain := N + 1;
+         end if;
+      end if;
+   end Free_Node;
+
+   function Next_Node (N : Node_Type) return Node_Type is
+   begin
+      case Nodet.Table (N).Format is
+         when Format_Medium =>
+            return N + 2;
+         when Format_Short
+           | Format_Int
+           | Format_Fp =>
+            return N + 1;
+      end case;
+   end Next_Node;
+
+   function Get_Nkind (N : Node_Type) return Kind_Type is
+   begin
+      return Nodet.Table (N).Kind;
+   end Get_Nkind;
+
+   procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is
+   begin
+      Nodet.Table (N).Kind := Kind;
+   end Set_Nkind;
+
+
+   procedure Set_Location (N : Node_Type; Location: Location_Type) is
+   begin
+      Nodet.Table (N).Location := Location;
+   end Set_Location;
+
+   function Get_Location (N: Node_Type) return Location_Type is
+   begin
+      return Nodet.Table (N).Location;
+   end Get_Location;
+
+
+   procedure Set_Field0 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field0 := V;
+   end Set_Field0;
+
+   function Get_Field0 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field0;
+   end Get_Field0;
+
+
+   function Get_Field1 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field1;
+   end Get_Field1;
+
+   procedure Set_Field1 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field1 := V;
+   end Set_Field1;
+
+   function Get_Field2 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field2;
+   end Get_Field2;
+
+   procedure Set_Field2 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field2 := V;
+   end Set_Field2;
+
+   function Get_Field3 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field3;
+   end Get_Field3;
+
+   procedure Set_Field3 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field3 := V;
+   end Set_Field3;
+
+   function Get_Field4 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field4;
+   end Get_Field4;
+
+   procedure Set_Field4 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field4 := V;
+   end Set_Field4;
+
+   function Get_Field5 (N : Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N).Field5;
+   end Get_Field5;
+
+   procedure Set_Field5 (N : Node_Type; V : Node_Type) is
+   begin
+      Nodet.Table (N).Field5 := V;
+   end Set_Field5;
+
+   function Get_Field6 (N: Node_Type) return Node_Type is
+   begin
+      return Node_Type (Nodet.Table (N + 1).Location);
+   end Get_Field6;
+
+   procedure Set_Field6 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Location := Location_Type (Val);
+   end Set_Field6;
+
+   function Get_Field7 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field0;
+   end Get_Field7;
+
+   procedure Set_Field7 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field0 := Val;
+   end Set_Field7;
+
+   function Get_Field8 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field1;
+   end Get_Field8;
+
+   procedure Set_Field8 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field1 := Val;
+   end Set_Field8;
+
+   function Get_Field9 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field2;
+   end Get_Field9;
+
+   procedure Set_Field9 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field2 := Val;
+   end Set_Field9;
+
+   function Get_Field10 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field3;
+   end Get_Field10;
+
+   procedure Set_Field10 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field3 := Val;
+   end Set_Field10;
+
+   function Get_Field11 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field4;
+   end Get_Field11;
+
+   procedure Set_Field11 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field4 := Val;
+   end Set_Field11;
+
+   function Get_Field12 (N: Node_Type) return Node_Type is
+   begin
+      return Nodet.Table (N + 1).Field5;
+   end Get_Field12;
+
+   procedure Set_Field12 (N: Node_Type; Val: Node_Type) is
+   begin
+      Nodet.Table (N + 1).Field5 := Val;
+   end Set_Field12;
+
+
+   function Get_Flag1 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag1;
+   end Get_Flag1;
+
+   procedure Set_Flag1 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag1 := V;
+   end Set_Flag1;
+
+   function Get_Flag2 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag2;
+   end Get_Flag2;
+
+   procedure Set_Flag2 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag2 := V;
+   end Set_Flag2;
+
+   function Get_Flag3 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag3;
+   end Get_Flag3;
+
+   procedure Set_Flag3 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag3 := V;
+   end Set_Flag3;
+
+   function Get_Flag4 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag4;
+   end Get_Flag4;
+
+   procedure Set_Flag4 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag4 := V;
+   end Set_Flag4;
+
+   function Get_Flag5 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag5;
+   end Get_Flag5;
+
+   procedure Set_Flag5 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag5 := V;
+   end Set_Flag5;
+
+   function Get_Flag6 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag6;
+   end Get_Flag6;
+
+   procedure Set_Flag6 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag6 := V;
+   end Set_Flag6;
+
+   function Get_Flag7 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag7;
+   end Get_Flag7;
+
+   procedure Set_Flag7 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag7 := V;
+   end Set_Flag7;
+
+   function Get_Flag8 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag8;
+   end Get_Flag8;
+
+   procedure Set_Flag8 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag8 := V;
+   end Set_Flag8;
+
+   function Get_Flag9 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag9;
+   end Get_Flag9;
+
+   procedure Set_Flag9 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag9 := V;
+   end Set_Flag9;
+
+   function Get_Flag10 (N : Node_Type) return Boolean is
+   begin
+      return Nodet.Table (N).Flag10;
+   end Get_Flag10;
+
+   procedure Set_Flag10 (N : Node_Type; V : Boolean) is
+   begin
+      Nodet.Table (N).Flag10 := V;
+   end Set_Flag10;
+
+
+   function Get_State1 (N : Node_Type) return Bit2_Type is
+   begin
+      return Nodet.Table (N).State1;
+   end Get_State1;
+
+   procedure Set_State1 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N).State1 := V;
+   end Set_State1;
+
+   function Get_State2 (N : Node_Type) return Bit2_Type is
+   begin
+      return Nodet.Table (N).State2;
+   end Get_State2;
+
+   procedure Set_State2 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N).State2 := V;
+   end Set_State2;
+
+   function Get_State3 (N : Node_Type) return Bit2_Type is
+   begin
+      return Nodet.Table (N + 1).State1;
+   end Get_State3;
+
+   procedure Set_State3 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N + 1).State1 := V;
+   end Set_State3;
+
+   function Get_State4 (N : Node_Type) return Bit2_Type is
+   begin
+      return Nodet.Table (N + 1).State2;
+   end Get_State4;
+
+   procedure Set_State4 (N : Node_Type; V : Bit2_Type) is
+   begin
+      Nodet.Table (N + 1).State2 := V;
+   end Set_State4;
+
+
+   function Get_Odigit1 (N : Node_Type) return Bit3_Type is
+   begin
+      return Nodet.Table (N).Odigit1;
+   end Get_Odigit1;
+
+   procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type) is
+   begin
+      Nodet.Table (N).Odigit1 := V;
+   end Set_Odigit1;
+
+   function Get_Odigit2 (N : Node_Type) return Bit3_Type is
+   begin
+      return Nodet.Table (N + 1).Odigit1;
+   end Get_Odigit2;
+
+   procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type) is
+   begin
+      Nodet.Table (N + 1).Odigit1 := V;
+   end Set_Odigit2;
+
+
+   function Get_Fp64 (N : Node_Type) return Iir_Fp64 is
+   begin
+      return Nodet.Table (N).Fp64;
+   end Get_Fp64;
+
+   procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64) is
+   begin
+      Nodet.Table (N).Fp64 := V;
+   end Set_Fp64;
+
+
+   function Get_Int64 (N : Node_Type) return Iir_Int64 is
+   begin
+      return Nodet.Table (N).Int64;
+   end Get_Int64;
+
+   procedure Set_Int64 (N : Node_Type; V : Iir_Int64) is
+   begin
+      Nodet.Table (N).Int64 := V;
+   end Set_Int64;
+
+   procedure Initialize is
+   begin
+      Nodet.Free;
+      Nodet.Init;
+   end Initialize;
+end Nodes;
diff --git a/src/nodes.ads b/src/nodes.ads
new file mode 100644
index 000000000..adf6a5ee8
--- /dev/null
+++ b/src/nodes.ads
@@ -0,0 +1,335 @@
+--  Internal node type and operations.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+
+package Nodes is
+   type Node_Type is new Int32;
+   for Node_Type'Size use 32;
+
+   Null_Node : constant Node_Type := 0;
+   Error_Node : constant Node_Type := 1;
+
+   --  A simple type that needs only 2 bits.
+   type Bit2_Type is range 0 .. 2 ** 2 - 1;
+   type Bit3_Type is range 0 .. 2 ** 3 - 1;
+
+   type Kind_Type is range 0 .. 255;
+
+   --  Format of a node.
+   type Format_Type is
+     (
+      Format_Short,
+      Format_Medium,
+      Format_Fp,
+      Format_Int
+     );
+
+   --  Future layout:    (rem)
+   --   Format: 0 bits    32
+   --   Nkind: 16 bits    16
+   --   Flags: 8*1 bits    8
+   --   State: 2*2 bits    4
+   --   Odigit is to be removed.
+
+   --  Future layout (2):(rem)
+   --   Format: 2 bits    30
+   --   Nkind:  8 bits    22 (vhdl: 216 nodes)
+   --   Flags: 8*1 bits   14
+   --   State: 2*2 bits   10
+   --   Lang:   2 bits     8
+   --   Odigit: 1*3 bits   5
+
+   -- Common fields are:
+   --   Flag1 : Boolean
+   --   Flag2 : Boolean
+   --   Flag3 : Boolean
+   --   Flag4 : Boolean
+   --   Flag5 : Boolean
+   --   Flag6 : Boolean
+   --   Flag7 : Boolean
+   --   Flag8 : Boolean
+   --   Flag9 : Boolean
+   --   Flag10 : Boolean
+   --   Nkind : Kind_Type
+   --   State1 : Bit2_Type
+   --   State2 : Bit2_Type
+   --   Location : Location_Type
+   --   Field0 : Iir
+   --   Field1 : Iir
+   --   Field2 : Iir
+   --   Field3 : Iir
+
+   -- Fields of Format_Fp:
+   --   Fp64 : Iir_Fp64
+
+   -- Fields of Format_Int:
+   --   Int64 : Iir_Int64
+
+   -- Fields of Format_Short:
+   --   Field4 : Iir
+   --   Field5 : Iir
+
+   -- Fields of Format_Medium:
+   --   Odigit1 : Bit3_Type
+   --   Odigit2 : Bit3_Type (odigit1)
+   --   State3 : Bit2_Type
+   --   State4 : Bit2_Type
+   --   Field4 : Iir
+   --   Field5 : Iir
+   --   Field6 : Iir (location)
+   --   Field7 : Iir (field0)
+   --   Field8 : Iir (field1)
+   --   Field9 : Iir (field2)
+   --   Field10 : Iir (field3)
+   --   Field11 : Iir (field4)
+   --   Field12 : Iir (field5)
+
+   function Create_Node (Format : Format_Type) return Node_Type;
+   procedure Free_Node (N : Node_Type);
+   function Next_Node (N : Node_Type) return Node_Type;
+
+   function Get_Nkind (N : Node_Type) return Kind_Type;
+   pragma Inline (Get_Nkind);
+   procedure Set_Nkind (N : Node_Type; Kind : Kind_Type);
+   pragma Inline (Set_Nkind);
+
+   function Get_Location (N: Node_Type) return Location_Type;
+   pragma Inline (Get_Location);
+   procedure Set_Location (N : Node_Type; Location: Location_Type);
+   pragma Inline (Set_Location);
+
+   function Get_Field0 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field0);
+   procedure Set_Field0 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field0);
+
+   function Get_Field1 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field1);
+   procedure Set_Field1 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field1);
+
+   function Get_Field2 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field2);
+   procedure Set_Field2 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field2);
+
+   function Get_Field3 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field3);
+   procedure Set_Field3 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field3);
+
+   function Get_Field4 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field4);
+   procedure Set_Field4 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field4);
+
+
+   function Get_Field5 (N : Node_Type) return Node_Type;
+   pragma Inline (Get_Field5);
+   procedure Set_Field5 (N : Node_Type; V : Node_Type);
+   pragma Inline (Set_Field5);
+
+   function Get_Field6 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field6);
+   procedure Set_Field6 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field6);
+
+   function Get_Field7 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field7);
+   procedure Set_Field7 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field7);
+
+   function Get_Field8 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field8);
+   procedure Set_Field8 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field8);
+
+   function Get_Field9 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field9);
+   procedure Set_Field9 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field9);
+
+   function Get_Field10 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field10);
+   procedure Set_Field10 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field10);
+
+   function Get_Field11 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field11);
+   procedure Set_Field11 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field11);
+
+   function Get_Field12 (N: Node_Type) return Node_Type;
+   pragma Inline (Get_Field12);
+   procedure Set_Field12 (N: Node_Type; Val: Node_Type);
+   pragma Inline (Set_Field12);
+
+
+   function Get_Flag1 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag1);
+   procedure Set_Flag1 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag1);
+
+   function Get_Flag2 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag2);
+   procedure Set_Flag2 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag2);
+
+   function Get_Flag3 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag3);
+   procedure Set_Flag3 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag3);
+
+   function Get_Flag4 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag4);
+   procedure Set_Flag4 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag4);
+
+   function Get_Flag5 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag5);
+   procedure Set_Flag5 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag5);
+
+   function Get_Flag6 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag6);
+   procedure Set_Flag6 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag6);
+
+   function Get_Flag7 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag7);
+   procedure Set_Flag7 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag7);
+
+   function Get_Flag8 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag8);
+   procedure Set_Flag8 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag8);
+
+   function Get_Flag9 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag9);
+   procedure Set_Flag9 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag9);
+
+   function Get_Flag10 (N : Node_Type) return Boolean;
+   pragma Inline (Get_Flag10);
+   procedure Set_Flag10 (N : Node_Type; V : Boolean);
+   pragma Inline (Set_Flag10);
+
+
+   function Get_State1 (N : Node_Type) return Bit2_Type;
+   pragma Inline (Get_State1);
+   procedure Set_State1 (N : Node_Type; V : Bit2_Type);
+   pragma Inline (Set_State1);
+
+   function Get_State2 (N : Node_Type) return Bit2_Type;
+   pragma Inline (Get_State2);
+   procedure Set_State2 (N : Node_Type; V : Bit2_Type);
+   pragma Inline (Set_State2);
+
+   function Get_State3 (N : Node_Type) return Bit2_Type;
+   pragma Inline (Get_State3);
+   procedure Set_State3 (N : Node_Type; V : Bit2_Type);
+   pragma Inline (Set_State3);
+
+   function Get_State4 (N : Node_Type) return Bit2_Type;
+   pragma Inline (Get_State4);
+   procedure Set_State4 (N : Node_Type; V : Bit2_Type);
+   pragma Inline (Set_State4);
+
+
+   function Get_Odigit1 (N : Node_Type) return Bit3_Type;
+   pragma Inline (Get_Odigit1);
+   procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type);
+   pragma Inline (Set_Odigit1);
+
+   function Get_Odigit2 (N : Node_Type) return Bit3_Type;
+   pragma Inline (Get_Odigit2);
+   procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type);
+   pragma Inline (Set_Odigit2);
+
+
+   function Get_Fp64 (N : Node_Type) return Iir_Fp64;
+   pragma Inline (Get_Fp64);
+   procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64);
+   pragma Inline (Set_Fp64);
+
+   function Get_Int64 (N : Node_Type) return Iir_Int64;
+   pragma Inline (Get_Int64);
+   procedure Set_Int64 (N : Node_Type; V : Iir_Int64);
+   pragma Inline (Set_Int64);
+
+   --  Get the last node allocated.
+   function Get_Last_Node return Node_Type;
+   pragma Inline (Get_Last_Node);
+
+   --  Free all and reinit.
+   procedure Initialize;
+private
+   type Node_Record (Format : Format_Type := Format_Short) is record
+      Flag1 : Boolean := False;
+      Flag2 : Boolean := False;
+      Flag3 : Boolean := False;
+      Flag4 : Boolean := False;
+      Flag5 : Boolean := False;
+      Flag6 : Boolean := False;
+
+      --  Kind field use 8 bits.
+      --  So, on 32 bits systems, there are 24 bits left.
+      --  + 8 (8 * 1)
+      --  + 10 (5 * 2)
+      --  + 6 (2 * 3)
+      --  = 24
+
+      Kind : Kind_Type;
+
+      State1 : Bit2_Type := 0;
+      State2 : Bit2_Type := 0;
+      Flag7 : Boolean := False;
+      Flag8 : Boolean := False;
+      Flag9 : Boolean := False;
+      Flag10 : Boolean := False;
+
+      Flag11 : Boolean := False;
+      Flag12 : Boolean := False;
+      Odigit1 : Bit3_Type := 0;
+      Unused_Odigit2 : Bit3_Type := 0;
+
+      -- Location.
+      Location: Location_Type := Location_Nil;
+
+      Field0 : Node_Type := Null_Node;
+      Field1: Node_Type := Null_Node;
+      Field2: Node_Type := Null_Node;
+      Field3: Node_Type := Null_Node;
+
+      case Format is
+         when Format_Short
+           | Format_Medium =>
+            Field4: Node_Type := Null_Node;
+            Field5: Node_Type := Null_Node;
+         when Format_Fp =>
+            Fp64 : Iir_Fp64;
+         when Format_Int =>
+            Int64 : Iir_Int64;
+      end case;
+   end record;
+
+   pragma Pack (Node_Record);
+   for Node_Record'Size use 8*32;
+   for Node_Record'Alignment use 4;
+end Nodes;
diff --git a/src/nodes_gc.adb b/src/nodes_gc.adb
new file mode 100644
index 000000000..38966f27c
--- /dev/null
+++ b/src/nodes_gc.adb
@@ -0,0 +1,206 @@
+--  Node garbage collector (for debugging).
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Text_IO;
+with Types; use Types;
+with Nodes;
+with Nodes_Meta;
+with Iirs; use Iirs;
+with Libraries;
+with Disp_Tree;
+with Std_Package;
+
+package body Nodes_GC is
+
+   type Marker_Array is array (Iir range <>) of Boolean;
+   type Marker_Array_Acc is access Marker_Array;
+
+   Markers : Marker_Array_Acc;
+
+   procedure Mark_Iir (N : Iir);
+
+   procedure Mark_Iir_List (N : Iir_List)
+   is
+      El : Iir;
+   begin
+      case N is
+         when Null_Iir_List
+           | Iir_List_All
+           | Iir_List_Others =>
+            null;
+         when others =>
+            for I in Natural loop
+               El := Get_Nth_Element (N, I);
+               exit when El = Null_Iir;
+               Mark_Iir (El);
+            end loop;
+      end case;
+   end Mark_Iir_List;
+
+   procedure Mark_PSL_Node (N : PSL_Node) is
+   begin
+      null;
+   end Mark_PSL_Node;
+
+   procedure Mark_PSL_NFA (N : PSL_NFA) is
+   begin
+      null;
+   end Mark_PSL_NFA;
+
+   procedure Report_Already_Marked (N : Iir)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Tree.Disp_Tree (N, True);
+      return;
+   end Report_Already_Marked;
+
+   procedure Already_Marked (N : Iir) is
+   begin
+      --  An unused node mustn't be referenced.
+      if Get_Kind (N) = Iir_Kind_Unused then
+         raise Internal_Error;
+      end if;
+
+      if not Flag_Disp_Multiref then
+         return;
+      end if;
+
+      case Get_Kind (N) is
+         when Iir_Kind_Interface_Constant_Declaration =>
+            if Get_Identifier (N) = Null_Identifier then
+               --  Anonymous interfaces are shared by predefined functions.
+               return;
+            end if;
+         when Iir_Kind_Enumeration_Literal =>
+            if Get_Enum_Pos (N) = 0
+              or else N = Get_Right_Limit (Get_Range_Constraint
+                                             (Get_Type (N)))
+            then
+               return;
+            end if;
+         when others =>
+            null;
+      end case;
+
+      Report_Already_Marked (N);
+   end Already_Marked;
+
+   procedure Mark_Chain (Head : Iir)
+   is
+      El : Iir;
+   begin
+      El := Head;
+      while El /= Null_Iir loop
+         Mark_Iir (El);
+         El := Get_Chain (El);
+      end loop;
+   end Mark_Chain;
+
+   procedure Report_Unreferenced_Node (N : Iir) is
+   begin
+      Disp_Tree.Disp_Tree (N, True);
+   end Report_Unreferenced_Node;
+
+   procedure Mark_Iir (N : Iir) is
+   begin
+      if N = Null_Iir then
+         return;
+      elsif Markers (N) then
+         Already_Marked (N);
+         return;
+      else
+         Markers (N) := True;
+      end if;
+
+      declare
+         use Nodes_Meta;
+         Fields : constant Fields_Array := Get_Fields (Get_Kind (N));
+         F : Fields_Enum;
+      begin
+         for I in Fields'Range loop
+            F := Fields (I);
+            case Get_Field_Attribute (F) is
+               when Attr_Ref
+                 | Attr_Chain_Next =>
+                  null;
+               when Attr_Maybe_Ref =>
+                  if not Get_Is_Ref (N) then
+                     Mark_Iir (Get_Iir (N, F));
+                  end if;
+               when Attr_Chain =>
+                  Mark_Chain (Get_Iir (N, F));
+               when Attr_None =>
+                  case Get_Field_Type (F) is
+                     when Type_Iir =>
+                        Mark_Iir (Get_Iir (N, F));
+                     when Type_Iir_List =>
+                        Mark_Iir_List (Get_Iir_List (N, F));
+                     when Type_PSL_Node =>
+                        Mark_PSL_Node (Get_PSL_Node (N, F));
+                     when Type_PSL_NFA =>
+                        Mark_PSL_NFA (Get_PSL_NFA (N, F));
+                     when others =>
+                        null;
+                  end case;
+               when Attr_Of_Ref =>
+                  raise Internal_Error;
+            end case;
+         end loop;
+      end;
+   end Mark_Iir;
+
+   procedure Report_Unreferenced
+   is
+      use Ada.Text_IO;
+      use Std_Package;
+      El : Iir;
+      Nbr_Unreferenced : Natural;
+   begin
+      Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False);
+
+      if Flag_Disp_Multiref then
+         Put_Line ("** nodes already marked:");
+      end if;
+
+      Mark_Chain (Libraries.Get_Libraries_Chain);
+      Mark_Chain (Libraries.Obsoleted_Design_Units);
+      Mark_Iir (Convertible_Integer_Type_Declaration);
+      Mark_Iir (Convertible_Integer_Subtype_Declaration);
+      Mark_Iir (Convertible_Real_Type_Declaration);
+      Mark_Iir (Universal_Integer_One);
+      Mark_Iir (Error_Mark);
+
+      El := Error_Mark;
+      Nbr_Unreferenced := 0;
+      while El in Markers'Range loop
+         if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then
+            if Nbr_Unreferenced = 0 then
+               Put_Line ("** unreferenced nodes:");
+            end if;
+            Nbr_Unreferenced := Nbr_Unreferenced + 1;
+            Report_Unreferenced_Node (El);
+         end if;
+         El := Iir (Nodes.Next_Node (Nodes.Node_Type (El)));
+      end loop;
+
+      if Nbr_Unreferenced /= 0 then
+         raise Internal_Error;
+      end if;
+   end Report_Unreferenced;
+end Nodes_GC;
diff --git a/src/nodes_gc.adb.in b/src/nodes_gc.adb.in
new file mode 100644
index 000000000..7c4303bc5
--- /dev/null
+++ b/src/nodes_gc.adb.in
@@ -0,0 +1,159 @@
+--  Node garbage collector (for debugging).
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Text_IO;
+with Types; use Types;
+with Nodes;
+with Iirs; use Iirs;
+with Libraries;
+with Disp_Tree;
+with Std_Package;
+
+package body Nodes_GC is
+
+   type Marker_Array is array (Iir range <>) of Boolean;
+   type Marker_Array_Acc is access Marker_Array;
+
+   Markers : Marker_Array_Acc;
+
+   procedure Mark_Iir (N : Iir);
+
+   procedure Mark_Iir_List (N : Iir_List)
+   is
+      El : Iir;
+   begin
+      case N is
+         when Null_Iir_List
+           | Iir_List_All
+           | Iir_List_Others =>
+            null;
+         when others =>
+            for I in Natural loop
+               El := Get_Nth_Element (N, I);
+               exit when El = Null_Iir;
+               Mark_Iir (El);
+            end loop;
+      end case;
+   end Mark_Iir_List;
+
+   procedure Mark_PSL_Node (N : PSL_Node) is
+   begin
+      null;
+   end Mark_PSL_Node;
+
+   procedure Mark_PSL_NFA (N : PSL_NFA) is
+   begin
+      null;
+   end Mark_PSL_NFA;
+
+   procedure Report_Already_Marked (N : Iir)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Tree.Disp_Tree (N, True);
+      return;
+   end Report_Already_Marked;
+
+   procedure Already_Marked (N : Iir) is
+   begin
+      --  An unused node mustn't be referenced.
+      if Get_Kind (N) = Iir_Kind_Unused then
+         raise Internal_Error;
+      end if;
+
+      if not Flag_Disp_Multiref then
+         return;
+      end if;
+
+      case Get_Kind (N) is
+         when Iir_Kind_Constant_Interface_Declaration =>
+            if Get_Identifier (N) = Null_Identifier then
+               --  Anonymous interfaces are shared by predefined functions.
+               return;
+            end if;
+         when Iir_Kind_Enumeration_Literal =>
+            if Get_Enum_Pos (N) = 0
+              or else N = Get_Right_Limit (Get_Range_Constraint
+                                             (Get_Type (N)))
+            then
+               return;
+            end if;
+         when others =>
+            null;
+      end case;
+
+      Report_Already_Marked (N);
+   end Already_Marked;
+
+   procedure Mark_Chain (Head : Iir)
+   is
+      El : Iir;
+   begin
+      El := Head;
+      while El /= Null_Iir loop
+         Mark_Iir (El);
+         El := Get_Chain (El);
+      end loop;
+   end Mark_Chain;
+
+   procedure Report_Unreferenced_Node (N : Iir) is
+   begin
+      Disp_Tree.Disp_Tree (N, True);
+   end Report_Unreferenced_Node;
+
+   --  Subprograms
+
+   procedure Report_Unreferenced
+   is
+      use Ada.Text_IO;
+      use Std_Package;
+      El : Iir;
+      Nbr_Unreferenced : Natural;
+   begin
+      Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False);
+
+      if Flag_Disp_Multiref then
+         Put_Line ("** nodes already marked:");
+      end if;
+
+      Mark_Chain (Libraries.Get_Libraries_Chain);
+      Mark_Chain (Libraries.Obsoleted_Design_Units);
+      Mark_Iir (Convertible_Integer_Type_Declaration);
+      Mark_Iir (Convertible_Integer_Subtype_Declaration);
+      Mark_Iir (Convertible_Real_Type_Declaration);
+      Mark_Iir (Universal_Integer_One);
+      Mark_Iir (Error_Mark);
+
+      El := Error_Mark;
+      Nbr_Unreferenced := 0;
+      while El in Markers'Range loop
+         if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then
+            if Nbr_Unreferenced = 0 then
+               Put_Line ("** unreferenced nodes:");
+            end if;
+            Nbr_Unreferenced := Nbr_Unreferenced + 1;
+            Report_Unreferenced_Node (El);
+         end if;
+         El := Iir (Nodes.Next_Node (Nodes.Node_Type (El)));
+      end loop;
+
+      if Nbr_Unreferenced /= 0 then
+         raise Internal_Error;
+      end if;
+   end Report_Unreferenced;
+end Nodes_GC;
diff --git a/src/nodes_gc.ads b/src/nodes_gc.ads
new file mode 100644
index 000000000..ef8e647c3
--- /dev/null
+++ b/src/nodes_gc.ads
@@ -0,0 +1,24 @@
+--  Node garbage collector (for debugging).
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Nodes_GC is
+   Flag_Disp_Multiref : Boolean := False;
+
+   procedure Report_Unreferenced;
+   --  Display nodes that aren't referenced.
+end Nodes_GC;
diff --git a/src/nodes_meta.adb b/src/nodes_meta.adb
new file mode 100644
index 000000000..3e038f549
--- /dev/null
+++ b/src/nodes_meta.adb
@@ -0,0 +1,9409 @@
+--  Meta description of nodes.
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Nodes_Meta is
+   Fields_Type : constant array (Fields_Enum) of Types_Enum :=
+     (
+      Field_First_Design_Unit => Type_Iir,
+      Field_Last_Design_Unit => Type_Iir,
+      Field_Library_Declaration => Type_Iir,
+      Field_File_Time_Stamp => Type_Time_Stamp_Id,
+      Field_Analysis_Time_Stamp => Type_Time_Stamp_Id,
+      Field_Library => Type_Iir,
+      Field_File_Dependence_List => Type_Iir_List,
+      Field_Design_File_Filename => Type_Name_Id,
+      Field_Design_File_Directory => Type_Name_Id,
+      Field_Design_File => Type_Iir,
+      Field_Design_File_Chain => Type_Iir,
+      Field_Library_Directory => Type_Name_Id,
+      Field_Date => Type_Date_Type,
+      Field_Context_Items => Type_Iir,
+      Field_Dependence_List => Type_Iir_List,
+      Field_Analysis_Checks_List => Type_Iir_List,
+      Field_Date_State => Type_Date_State_Type,
+      Field_Guarded_Target_State => Type_Tri_State_Type,
+      Field_Library_Unit => Type_Iir,
+      Field_Hash_Chain => Type_Iir,
+      Field_Design_Unit_Source_Pos => Type_Source_Ptr,
+      Field_Design_Unit_Source_Line => Type_Int32,
+      Field_Design_Unit_Source_Col => Type_Int32,
+      Field_Value => Type_Iir_Int64,
+      Field_Enum_Pos => Type_Iir_Int32,
+      Field_Physical_Literal => Type_Iir,
+      Field_Physical_Unit_Value => Type_Iir,
+      Field_Fp_Value => Type_Iir_Fp64,
+      Field_Enumeration_Decl => Type_Iir,
+      Field_Simple_Aggregate_List => Type_Iir_List,
+      Field_Bit_String_Base => Type_Base_Type,
+      Field_Bit_String_0 => Type_Iir,
+      Field_Bit_String_1 => Type_Iir,
+      Field_Literal_Origin => Type_Iir,
+      Field_Range_Origin => Type_Iir,
+      Field_Literal_Subtype => Type_Iir,
+      Field_Entity_Class => Type_Token_Type,
+      Field_Entity_Name_List => Type_Iir_List,
+      Field_Attribute_Designator => Type_Iir,
+      Field_Attribute_Specification_Chain => Type_Iir,
+      Field_Attribute_Specification => Type_Iir,
+      Field_Signal_List => Type_Iir_List,
+      Field_Designated_Entity => Type_Iir,
+      Field_Formal => Type_Iir,
+      Field_Actual => Type_Iir,
+      Field_In_Conversion => Type_Iir,
+      Field_Out_Conversion => Type_Iir,
+      Field_Whole_Association_Flag => Type_Boolean,
+      Field_Collapse_Signal_Flag => Type_Boolean,
+      Field_Artificial_Flag => Type_Boolean,
+      Field_Open_Flag => Type_Boolean,
+      Field_After_Drivers_Flag => Type_Boolean,
+      Field_We_Value => Type_Iir,
+      Field_Time => Type_Iir,
+      Field_Associated_Expr => Type_Iir,
+      Field_Associated_Chain => Type_Iir,
+      Field_Choice_Name => Type_Iir,
+      Field_Choice_Expression => Type_Iir,
+      Field_Choice_Range => Type_Iir,
+      Field_Same_Alternative_Flag => Type_Boolean,
+      Field_Architecture => Type_Iir,
+      Field_Block_Specification => Type_Iir,
+      Field_Prev_Block_Configuration => Type_Iir,
+      Field_Configuration_Item_Chain => Type_Iir,
+      Field_Attribute_Value_Chain => Type_Iir,
+      Field_Spec_Chain => Type_Iir,
+      Field_Attribute_Value_Spec_Chain => Type_Iir,
+      Field_Entity_Name => Type_Iir,
+      Field_Package => Type_Iir,
+      Field_Package_Body => Type_Iir,
+      Field_Need_Body => Type_Boolean,
+      Field_Block_Configuration => Type_Iir,
+      Field_Concurrent_Statement_Chain => Type_Iir,
+      Field_Chain => Type_Iir,
+      Field_Port_Chain => Type_Iir,
+      Field_Generic_Chain => Type_Iir,
+      Field_Type => Type_Iir,
+      Field_Subtype_Indication => Type_Iir,
+      Field_Discrete_Range => Type_Iir,
+      Field_Type_Definition => Type_Iir,
+      Field_Subtype_Definition => Type_Iir,
+      Field_Nature => Type_Iir,
+      Field_Mode => Type_Iir_Mode,
+      Field_Signal_Kind => Type_Iir_Signal_Kind,
+      Field_Base_Name => Type_Iir,
+      Field_Interface_Declaration_Chain => Type_Iir,
+      Field_Subprogram_Specification => Type_Iir,
+      Field_Sequential_Statement_Chain => Type_Iir,
+      Field_Subprogram_Body => Type_Iir,
+      Field_Overload_Number => Type_Iir_Int32,
+      Field_Subprogram_Depth => Type_Iir_Int32,
+      Field_Subprogram_Hash => Type_Iir_Int32,
+      Field_Impure_Depth => Type_Iir_Int32,
+      Field_Return_Type => Type_Iir,
+      Field_Implicit_Definition => Type_Iir_Predefined_Functions,
+      Field_Type_Reference => Type_Iir,
+      Field_Default_Value => Type_Iir,
+      Field_Deferred_Declaration => Type_Iir,
+      Field_Deferred_Declaration_Flag => Type_Boolean,
+      Field_Shared_Flag => Type_Boolean,
+      Field_Design_Unit => Type_Iir,
+      Field_Block_Statement => Type_Iir,
+      Field_Signal_Driver => Type_Iir,
+      Field_Declaration_Chain => Type_Iir,
+      Field_File_Logical_Name => Type_Iir,
+      Field_File_Open_Kind => Type_Iir,
+      Field_Element_Position => Type_Iir_Index32,
+      Field_Element_Declaration => Type_Iir,
+      Field_Selected_Element => Type_Iir,
+      Field_Use_Clause_Chain => Type_Iir,
+      Field_Selected_Name => Type_Iir,
+      Field_Type_Declarator => Type_Iir,
+      Field_Enumeration_Literal_List => Type_Iir_List,
+      Field_Entity_Class_Entry_Chain => Type_Iir,
+      Field_Group_Constituent_List => Type_Iir_List,
+      Field_Unit_Chain => Type_Iir,
+      Field_Primary_Unit => Type_Iir,
+      Field_Identifier => Type_Name_Id,
+      Field_Label => Type_Name_Id,
+      Field_Visible_Flag => Type_Boolean,
+      Field_Range_Constraint => Type_Iir,
+      Field_Direction => Type_Iir_Direction,
+      Field_Left_Limit => Type_Iir,
+      Field_Right_Limit => Type_Iir,
+      Field_Base_Type => Type_Iir,
+      Field_Resolution_Indication => Type_Iir,
+      Field_Record_Element_Resolution_Chain => Type_Iir,
+      Field_Tolerance => Type_Iir,
+      Field_Plus_Terminal => Type_Iir,
+      Field_Minus_Terminal => Type_Iir,
+      Field_Simultaneous_Left => Type_Iir,
+      Field_Simultaneous_Right => Type_Iir,
+      Field_Text_File_Flag => Type_Boolean,
+      Field_Only_Characters_Flag => Type_Boolean,
+      Field_Type_Staticness => Type_Iir_Staticness,
+      Field_Constraint_State => Type_Iir_Constraint,
+      Field_Index_Subtype_List => Type_Iir_List,
+      Field_Index_Subtype_Definition_List => Type_Iir_List,
+      Field_Element_Subtype_Indication => Type_Iir,
+      Field_Element_Subtype => Type_Iir,
+      Field_Index_Constraint_List => Type_Iir_List,
+      Field_Array_Element_Constraint => Type_Iir,
+      Field_Elements_Declaration_List => Type_Iir_List,
+      Field_Designated_Type => Type_Iir,
+      Field_Designated_Subtype_Indication => Type_Iir,
+      Field_Index_List => Type_Iir_List,
+      Field_Reference => Type_Iir,
+      Field_Nature_Declarator => Type_Iir,
+      Field_Across_Type => Type_Iir,
+      Field_Through_Type => Type_Iir,
+      Field_Target => Type_Iir,
+      Field_Waveform_Chain => Type_Iir,
+      Field_Guard => Type_Iir,
+      Field_Delay_Mechanism => Type_Iir_Delay_Mechanism,
+      Field_Reject_Time_Expression => Type_Iir,
+      Field_Sensitivity_List => Type_Iir_List,
+      Field_Process_Origin => Type_Iir,
+      Field_Condition_Clause => Type_Iir,
+      Field_Timeout_Clause => Type_Iir,
+      Field_Postponed_Flag => Type_Boolean,
+      Field_Callees_List => Type_Iir_List,
+      Field_Passive_Flag => Type_Boolean,
+      Field_Resolution_Function_Flag => Type_Boolean,
+      Field_Wait_State => Type_Tri_State_Type,
+      Field_All_Sensitized_State => Type_Iir_All_Sensitized,
+      Field_Seen_Flag => Type_Boolean,
+      Field_Pure_Flag => Type_Boolean,
+      Field_Foreign_Flag => Type_Boolean,
+      Field_Resolved_Flag => Type_Boolean,
+      Field_Signal_Type_Flag => Type_Boolean,
+      Field_Has_Signal_Flag => Type_Boolean,
+      Field_Purity_State => Type_Iir_Pure_State,
+      Field_Elab_Flag => Type_Boolean,
+      Field_Index_Constraint_Flag => Type_Boolean,
+      Field_Assertion_Condition => Type_Iir,
+      Field_Report_Expression => Type_Iir,
+      Field_Severity_Expression => Type_Iir,
+      Field_Instantiated_Unit => Type_Iir,
+      Field_Generic_Map_Aspect_Chain => Type_Iir,
+      Field_Port_Map_Aspect_Chain => Type_Iir,
+      Field_Configuration_Name => Type_Iir,
+      Field_Component_Configuration => Type_Iir,
+      Field_Configuration_Specification => Type_Iir,
+      Field_Default_Binding_Indication => Type_Iir,
+      Field_Default_Configuration_Declaration => Type_Iir,
+      Field_Expression => Type_Iir,
+      Field_Allocator_Designated_Type => Type_Iir,
+      Field_Selected_Waveform_Chain => Type_Iir,
+      Field_Conditional_Waveform_Chain => Type_Iir,
+      Field_Guard_Expression => Type_Iir,
+      Field_Guard_Decl => Type_Iir,
+      Field_Guard_Sensitivity_List => Type_Iir_List,
+      Field_Block_Block_Configuration => Type_Iir,
+      Field_Package_Header => Type_Iir,
+      Field_Block_Header => Type_Iir,
+      Field_Uninstantiated_Package_Name => Type_Iir,
+      Field_Generate_Block_Configuration => Type_Iir,
+      Field_Generation_Scheme => Type_Iir,
+      Field_Condition => Type_Iir,
+      Field_Else_Clause => Type_Iir,
+      Field_Parameter_Specification => Type_Iir,
+      Field_Parent => Type_Iir,
+      Field_Loop_Label => Type_Iir,
+      Field_Component_Name => Type_Iir,
+      Field_Instantiation_List => Type_Iir_List,
+      Field_Entity_Aspect => Type_Iir,
+      Field_Default_Entity_Aspect => Type_Iir,
+      Field_Default_Generic_Map_Aspect_Chain => Type_Iir,
+      Field_Default_Port_Map_Aspect_Chain => Type_Iir,
+      Field_Binding_Indication => Type_Iir,
+      Field_Named_Entity => Type_Iir,
+      Field_Alias_Declaration => Type_Iir,
+      Field_Expr_Staticness => Type_Iir_Staticness,
+      Field_Error_Origin => Type_Iir,
+      Field_Operand => Type_Iir,
+      Field_Left => Type_Iir,
+      Field_Right => Type_Iir,
+      Field_Unit_Name => Type_Iir,
+      Field_Name => Type_Iir,
+      Field_Group_Template_Name => Type_Iir,
+      Field_Name_Staticness => Type_Iir_Staticness,
+      Field_Prefix => Type_Iir,
+      Field_Signature_Prefix => Type_Iir,
+      Field_Slice_Subtype => Type_Iir,
+      Field_Suffix => Type_Iir,
+      Field_Index_Subtype => Type_Iir,
+      Field_Parameter => Type_Iir,
+      Field_Actual_Type => Type_Iir,
+      Field_Associated_Interface => Type_Iir,
+      Field_Association_Chain => Type_Iir,
+      Field_Individual_Association_Chain => Type_Iir,
+      Field_Aggregate_Info => Type_Iir,
+      Field_Sub_Aggregate_Info => Type_Iir,
+      Field_Aggr_Dynamic_Flag => Type_Boolean,
+      Field_Aggr_Min_Length => Type_Iir_Int32,
+      Field_Aggr_Low_Limit => Type_Iir,
+      Field_Aggr_High_Limit => Type_Iir,
+      Field_Aggr_Others_Flag => Type_Boolean,
+      Field_Aggr_Named_Flag => Type_Boolean,
+      Field_Value_Staticness => Type_Iir_Staticness,
+      Field_Association_Choices_Chain => Type_Iir,
+      Field_Case_Statement_Alternative_Chain => Type_Iir,
+      Field_Choice_Staticness => Type_Iir_Staticness,
+      Field_Procedure_Call => Type_Iir,
+      Field_Implementation => Type_Iir,
+      Field_Parameter_Association_Chain => Type_Iir,
+      Field_Method_Object => Type_Iir,
+      Field_Subtype_Type_Mark => Type_Iir,
+      Field_Type_Conversion_Subtype => Type_Iir,
+      Field_Type_Mark => Type_Iir,
+      Field_File_Type_Mark => Type_Iir,
+      Field_Return_Type_Mark => Type_Iir,
+      Field_Lexical_Layout => Type_Iir_Lexical_Layout_Type,
+      Field_Incomplete_Type_List => Type_Iir_List,
+      Field_Has_Disconnect_Flag => Type_Boolean,
+      Field_Has_Active_Flag => Type_Boolean,
+      Field_Is_Within_Flag => Type_Boolean,
+      Field_Type_Marks_List => Type_Iir_List,
+      Field_Implicit_Alias_Flag => Type_Boolean,
+      Field_Alias_Signature => Type_Iir,
+      Field_Attribute_Signature => Type_Iir,
+      Field_Overload_List => Type_Iir_List,
+      Field_Simple_Name_Identifier => Type_Name_Id,
+      Field_Simple_Name_Subtype => Type_Iir,
+      Field_Protected_Type_Body => Type_Iir,
+      Field_Protected_Type_Declaration => Type_Iir,
+      Field_End_Location => Type_Location_Type,
+      Field_String_Id => Type_String_Id,
+      Field_String_Length => Type_Int32,
+      Field_Use_Flag => Type_Boolean,
+      Field_End_Has_Reserved_Id => Type_Boolean,
+      Field_End_Has_Identifier => Type_Boolean,
+      Field_End_Has_Postponed => Type_Boolean,
+      Field_Has_Begin => Type_Boolean,
+      Field_Has_Is => Type_Boolean,
+      Field_Has_Pure => Type_Boolean,
+      Field_Has_Body => Type_Boolean,
+      Field_Has_Identifier_List => Type_Boolean,
+      Field_Has_Mode => Type_Boolean,
+      Field_Is_Ref => Type_Boolean,
+      Field_Psl_Property => Type_PSL_Node,
+      Field_Psl_Declaration => Type_PSL_Node,
+      Field_Psl_Expression => Type_PSL_Node,
+      Field_Psl_Boolean => Type_PSL_Node,
+      Field_PSL_Clock => Type_PSL_Node,
+      Field_PSL_NFA => Type_PSL_NFA
+     );
+
+   function Get_Field_Type (F : Fields_Enum) return Types_Enum is
+   begin
+      return Fields_Type (F);
+   end Get_Field_Type;
+
+   function Get_Field_Image (F : Fields_Enum) return String is
+   begin
+      case F is
+         when Field_First_Design_Unit =>
+            return "first_design_unit";
+         when Field_Last_Design_Unit =>
+            return "last_design_unit";
+         when Field_Library_Declaration =>
+            return "library_declaration";
+         when Field_File_Time_Stamp =>
+            return "file_time_stamp";
+         when Field_Analysis_Time_Stamp =>
+            return "analysis_time_stamp";
+         when Field_Library =>
+            return "library";
+         when Field_File_Dependence_List =>
+            return "file_dependence_list";
+         when Field_Design_File_Filename =>
+            return "design_file_filename";
+         when Field_Design_File_Directory =>
+            return "design_file_directory";
+         when Field_Design_File =>
+            return "design_file";
+         when Field_Design_File_Chain =>
+            return "design_file_chain";
+         when Field_Library_Directory =>
+            return "library_directory";
+         when Field_Date =>
+            return "date";
+         when Field_Context_Items =>
+            return "context_items";
+         when Field_Dependence_List =>
+            return "dependence_list";
+         when Field_Analysis_Checks_List =>
+            return "analysis_checks_list";
+         when Field_Date_State =>
+            return "date_state";
+         when Field_Guarded_Target_State =>
+            return "guarded_target_state";
+         when Field_Library_Unit =>
+            return "library_unit";
+         when Field_Hash_Chain =>
+            return "hash_chain";
+         when Field_Design_Unit_Source_Pos =>
+            return "design_unit_source_pos";
+         when Field_Design_Unit_Source_Line =>
+            return "design_unit_source_line";
+         when Field_Design_Unit_Source_Col =>
+            return "design_unit_source_col";
+         when Field_Value =>
+            return "value";
+         when Field_Enum_Pos =>
+            return "enum_pos";
+         when Field_Physical_Literal =>
+            return "physical_literal";
+         when Field_Physical_Unit_Value =>
+            return "physical_unit_value";
+         when Field_Fp_Value =>
+            return "fp_value";
+         when Field_Enumeration_Decl =>
+            return "enumeration_decl";
+         when Field_Simple_Aggregate_List =>
+            return "simple_aggregate_list";
+         when Field_Bit_String_Base =>
+            return "bit_string_base";
+         when Field_Bit_String_0 =>
+            return "bit_string_0";
+         when Field_Bit_String_1 =>
+            return "bit_string_1";
+         when Field_Literal_Origin =>
+            return "literal_origin";
+         when Field_Range_Origin =>
+            return "range_origin";
+         when Field_Literal_Subtype =>
+            return "literal_subtype";
+         when Field_Entity_Class =>
+            return "entity_class";
+         when Field_Entity_Name_List =>
+            return "entity_name_list";
+         when Field_Attribute_Designator =>
+            return "attribute_designator";
+         when Field_Attribute_Specification_Chain =>
+            return "attribute_specification_chain";
+         when Field_Attribute_Specification =>
+            return "attribute_specification";
+         when Field_Signal_List =>
+            return "signal_list";
+         when Field_Designated_Entity =>
+            return "designated_entity";
+         when Field_Formal =>
+            return "formal";
+         when Field_Actual =>
+            return "actual";
+         when Field_In_Conversion =>
+            return "in_conversion";
+         when Field_Out_Conversion =>
+            return "out_conversion";
+         when Field_Whole_Association_Flag =>
+            return "whole_association_flag";
+         when Field_Collapse_Signal_Flag =>
+            return "collapse_signal_flag";
+         when Field_Artificial_Flag =>
+            return "artificial_flag";
+         when Field_Open_Flag =>
+            return "open_flag";
+         when Field_After_Drivers_Flag =>
+            return "after_drivers_flag";
+         when Field_We_Value =>
+            return "we_value";
+         when Field_Time =>
+            return "time";
+         when Field_Associated_Expr =>
+            return "associated_expr";
+         when Field_Associated_Chain =>
+            return "associated_chain";
+         when Field_Choice_Name =>
+            return "choice_name";
+         when Field_Choice_Expression =>
+            return "choice_expression";
+         when Field_Choice_Range =>
+            return "choice_range";
+         when Field_Same_Alternative_Flag =>
+            return "same_alternative_flag";
+         when Field_Architecture =>
+            return "architecture";
+         when Field_Block_Specification =>
+            return "block_specification";
+         when Field_Prev_Block_Configuration =>
+            return "prev_block_configuration";
+         when Field_Configuration_Item_Chain =>
+            return "configuration_item_chain";
+         when Field_Attribute_Value_Chain =>
+            return "attribute_value_chain";
+         when Field_Spec_Chain =>
+            return "spec_chain";
+         when Field_Attribute_Value_Spec_Chain =>
+            return "attribute_value_spec_chain";
+         when Field_Entity_Name =>
+            return "entity_name";
+         when Field_Package =>
+            return "package";
+         when Field_Package_Body =>
+            return "package_body";
+         when Field_Need_Body =>
+            return "need_body";
+         when Field_Block_Configuration =>
+            return "block_configuration";
+         when Field_Concurrent_Statement_Chain =>
+            return "concurrent_statement_chain";
+         when Field_Chain =>
+            return "chain";
+         when Field_Port_Chain =>
+            return "port_chain";
+         when Field_Generic_Chain =>
+            return "generic_chain";
+         when Field_Type =>
+            return "type";
+         when Field_Subtype_Indication =>
+            return "subtype_indication";
+         when Field_Discrete_Range =>
+            return "discrete_range";
+         when Field_Type_Definition =>
+            return "type_definition";
+         when Field_Subtype_Definition =>
+            return "subtype_definition";
+         when Field_Nature =>
+            return "nature";
+         when Field_Mode =>
+            return "mode";
+         when Field_Signal_Kind =>
+            return "signal_kind";
+         when Field_Base_Name =>
+            return "base_name";
+         when Field_Interface_Declaration_Chain =>
+            return "interface_declaration_chain";
+         when Field_Subprogram_Specification =>
+            return "subprogram_specification";
+         when Field_Sequential_Statement_Chain =>
+            return "sequential_statement_chain";
+         when Field_Subprogram_Body =>
+            return "subprogram_body";
+         when Field_Overload_Number =>
+            return "overload_number";
+         when Field_Subprogram_Depth =>
+            return "subprogram_depth";
+         when Field_Subprogram_Hash =>
+            return "subprogram_hash";
+         when Field_Impure_Depth =>
+            return "impure_depth";
+         when Field_Return_Type =>
+            return "return_type";
+         when Field_Implicit_Definition =>
+            return "implicit_definition";
+         when Field_Type_Reference =>
+            return "type_reference";
+         when Field_Default_Value =>
+            return "default_value";
+         when Field_Deferred_Declaration =>
+            return "deferred_declaration";
+         when Field_Deferred_Declaration_Flag =>
+            return "deferred_declaration_flag";
+         when Field_Shared_Flag =>
+            return "shared_flag";
+         when Field_Design_Unit =>
+            return "design_unit";
+         when Field_Block_Statement =>
+            return "block_statement";
+         when Field_Signal_Driver =>
+            return "signal_driver";
+         when Field_Declaration_Chain =>
+            return "declaration_chain";
+         when Field_File_Logical_Name =>
+            return "file_logical_name";
+         when Field_File_Open_Kind =>
+            return "file_open_kind";
+         when Field_Element_Position =>
+            return "element_position";
+         when Field_Element_Declaration =>
+            return "element_declaration";
+         when Field_Selected_Element =>
+            return "selected_element";
+         when Field_Use_Clause_Chain =>
+            return "use_clause_chain";
+         when Field_Selected_Name =>
+            return "selected_name";
+         when Field_Type_Declarator =>
+            return "type_declarator";
+         when Field_Enumeration_Literal_List =>
+            return "enumeration_literal_list";
+         when Field_Entity_Class_Entry_Chain =>
+            return "entity_class_entry_chain";
+         when Field_Group_Constituent_List =>
+            return "group_constituent_list";
+         when Field_Unit_Chain =>
+            return "unit_chain";
+         when Field_Primary_Unit =>
+            return "primary_unit";
+         when Field_Identifier =>
+            return "identifier";
+         when Field_Label =>
+            return "label";
+         when Field_Visible_Flag =>
+            return "visible_flag";
+         when Field_Range_Constraint =>
+            return "range_constraint";
+         when Field_Direction =>
+            return "direction";
+         when Field_Left_Limit =>
+            return "left_limit";
+         when Field_Right_Limit =>
+            return "right_limit";
+         when Field_Base_Type =>
+            return "base_type";
+         when Field_Resolution_Indication =>
+            return "resolution_indication";
+         when Field_Record_Element_Resolution_Chain =>
+            return "record_element_resolution_chain";
+         when Field_Tolerance =>
+            return "tolerance";
+         when Field_Plus_Terminal =>
+            return "plus_terminal";
+         when Field_Minus_Terminal =>
+            return "minus_terminal";
+         when Field_Simultaneous_Left =>
+            return "simultaneous_left";
+         when Field_Simultaneous_Right =>
+            return "simultaneous_right";
+         when Field_Text_File_Flag =>
+            return "text_file_flag";
+         when Field_Only_Characters_Flag =>
+            return "only_characters_flag";
+         when Field_Type_Staticness =>
+            return "type_staticness";
+         when Field_Constraint_State =>
+            return "constraint_state";
+         when Field_Index_Subtype_List =>
+            return "index_subtype_list";
+         when Field_Index_Subtype_Definition_List =>
+            return "index_subtype_definition_list";
+         when Field_Element_Subtype_Indication =>
+            return "element_subtype_indication";
+         when Field_Element_Subtype =>
+            return "element_subtype";
+         when Field_Index_Constraint_List =>
+            return "index_constraint_list";
+         when Field_Array_Element_Constraint =>
+            return "array_element_constraint";
+         when Field_Elements_Declaration_List =>
+            return "elements_declaration_list";
+         when Field_Designated_Type =>
+            return "designated_type";
+         when Field_Designated_Subtype_Indication =>
+            return "designated_subtype_indication";
+         when Field_Index_List =>
+            return "index_list";
+         when Field_Reference =>
+            return "reference";
+         when Field_Nature_Declarator =>
+            return "nature_declarator";
+         when Field_Across_Type =>
+            return "across_type";
+         when Field_Through_Type =>
+            return "through_type";
+         when Field_Target =>
+            return "target";
+         when Field_Waveform_Chain =>
+            return "waveform_chain";
+         when Field_Guard =>
+            return "guard";
+         when Field_Delay_Mechanism =>
+            return "delay_mechanism";
+         when Field_Reject_Time_Expression =>
+            return "reject_time_expression";
+         when Field_Sensitivity_List =>
+            return "sensitivity_list";
+         when Field_Process_Origin =>
+            return "process_origin";
+         when Field_Condition_Clause =>
+            return "condition_clause";
+         when Field_Timeout_Clause =>
+            return "timeout_clause";
+         when Field_Postponed_Flag =>
+            return "postponed_flag";
+         when Field_Callees_List =>
+            return "callees_list";
+         when Field_Passive_Flag =>
+            return "passive_flag";
+         when Field_Resolution_Function_Flag =>
+            return "resolution_function_flag";
+         when Field_Wait_State =>
+            return "wait_state";
+         when Field_All_Sensitized_State =>
+            return "all_sensitized_state";
+         when Field_Seen_Flag =>
+            return "seen_flag";
+         when Field_Pure_Flag =>
+            return "pure_flag";
+         when Field_Foreign_Flag =>
+            return "foreign_flag";
+         when Field_Resolved_Flag =>
+            return "resolved_flag";
+         when Field_Signal_Type_Flag =>
+            return "signal_type_flag";
+         when Field_Has_Signal_Flag =>
+            return "has_signal_flag";
+         when Field_Purity_State =>
+            return "purity_state";
+         when Field_Elab_Flag =>
+            return "elab_flag";
+         when Field_Index_Constraint_Flag =>
+            return "index_constraint_flag";
+         when Field_Assertion_Condition =>
+            return "assertion_condition";
+         when Field_Report_Expression =>
+            return "report_expression";
+         when Field_Severity_Expression =>
+            return "severity_expression";
+         when Field_Instantiated_Unit =>
+            return "instantiated_unit";
+         when Field_Generic_Map_Aspect_Chain =>
+            return "generic_map_aspect_chain";
+         when Field_Port_Map_Aspect_Chain =>
+            return "port_map_aspect_chain";
+         when Field_Configuration_Name =>
+            return "configuration_name";
+         when Field_Component_Configuration =>
+            return "component_configuration";
+         when Field_Configuration_Specification =>
+            return "configuration_specification";
+         when Field_Default_Binding_Indication =>
+            return "default_binding_indication";
+         when Field_Default_Configuration_Declaration =>
+            return "default_configuration_declaration";
+         when Field_Expression =>
+            return "expression";
+         when Field_Allocator_Designated_Type =>
+            return "allocator_designated_type";
+         when Field_Selected_Waveform_Chain =>
+            return "selected_waveform_chain";
+         when Field_Conditional_Waveform_Chain =>
+            return "conditional_waveform_chain";
+         when Field_Guard_Expression =>
+            return "guard_expression";
+         when Field_Guard_Decl =>
+            return "guard_decl";
+         when Field_Guard_Sensitivity_List =>
+            return "guard_sensitivity_list";
+         when Field_Block_Block_Configuration =>
+            return "block_block_configuration";
+         when Field_Package_Header =>
+            return "package_header";
+         when Field_Block_Header =>
+            return "block_header";
+         when Field_Uninstantiated_Package_Name =>
+            return "uninstantiated_package_name";
+         when Field_Generate_Block_Configuration =>
+            return "generate_block_configuration";
+         when Field_Generation_Scheme =>
+            return "generation_scheme";
+         when Field_Condition =>
+            return "condition";
+         when Field_Else_Clause =>
+            return "else_clause";
+         when Field_Parameter_Specification =>
+            return "parameter_specification";
+         when Field_Parent =>
+            return "parent";
+         when Field_Loop_Label =>
+            return "loop_label";
+         when Field_Component_Name =>
+            return "component_name";
+         when Field_Instantiation_List =>
+            return "instantiation_list";
+         when Field_Entity_Aspect =>
+            return "entity_aspect";
+         when Field_Default_Entity_Aspect =>
+            return "default_entity_aspect";
+         when Field_Default_Generic_Map_Aspect_Chain =>
+            return "default_generic_map_aspect_chain";
+         when Field_Default_Port_Map_Aspect_Chain =>
+            return "default_port_map_aspect_chain";
+         when Field_Binding_Indication =>
+            return "binding_indication";
+         when Field_Named_Entity =>
+            return "named_entity";
+         when Field_Alias_Declaration =>
+            return "alias_declaration";
+         when Field_Expr_Staticness =>
+            return "expr_staticness";
+         when Field_Error_Origin =>
+            return "error_origin";
+         when Field_Operand =>
+            return "operand";
+         when Field_Left =>
+            return "left";
+         when Field_Right =>
+            return "right";
+         when Field_Unit_Name =>
+            return "unit_name";
+         when Field_Name =>
+            return "name";
+         when Field_Group_Template_Name =>
+            return "group_template_name";
+         when Field_Name_Staticness =>
+            return "name_staticness";
+         when Field_Prefix =>
+            return "prefix";
+         when Field_Signature_Prefix =>
+            return "signature_prefix";
+         when Field_Slice_Subtype =>
+            return "slice_subtype";
+         when Field_Suffix =>
+            return "suffix";
+         when Field_Index_Subtype =>
+            return "index_subtype";
+         when Field_Parameter =>
+            return "parameter";
+         when Field_Actual_Type =>
+            return "actual_type";
+         when Field_Associated_Interface =>
+            return "associated_interface";
+         when Field_Association_Chain =>
+            return "association_chain";
+         when Field_Individual_Association_Chain =>
+            return "individual_association_chain";
+         when Field_Aggregate_Info =>
+            return "aggregate_info";
+         when Field_Sub_Aggregate_Info =>
+            return "sub_aggregate_info";
+         when Field_Aggr_Dynamic_Flag =>
+            return "aggr_dynamic_flag";
+         when Field_Aggr_Min_Length =>
+            return "aggr_min_length";
+         when Field_Aggr_Low_Limit =>
+            return "aggr_low_limit";
+         when Field_Aggr_High_Limit =>
+            return "aggr_high_limit";
+         when Field_Aggr_Others_Flag =>
+            return "aggr_others_flag";
+         when Field_Aggr_Named_Flag =>
+            return "aggr_named_flag";
+         when Field_Value_Staticness =>
+            return "value_staticness";
+         when Field_Association_Choices_Chain =>
+            return "association_choices_chain";
+         when Field_Case_Statement_Alternative_Chain =>
+            return "case_statement_alternative_chain";
+         when Field_Choice_Staticness =>
+            return "choice_staticness";
+         when Field_Procedure_Call =>
+            return "procedure_call";
+         when Field_Implementation =>
+            return "implementation";
+         when Field_Parameter_Association_Chain =>
+            return "parameter_association_chain";
+         when Field_Method_Object =>
+            return "method_object";
+         when Field_Subtype_Type_Mark =>
+            return "subtype_type_mark";
+         when Field_Type_Conversion_Subtype =>
+            return "type_conversion_subtype";
+         when Field_Type_Mark =>
+            return "type_mark";
+         when Field_File_Type_Mark =>
+            return "file_type_mark";
+         when Field_Return_Type_Mark =>
+            return "return_type_mark";
+         when Field_Lexical_Layout =>
+            return "lexical_layout";
+         when Field_Incomplete_Type_List =>
+            return "incomplete_type_list";
+         when Field_Has_Disconnect_Flag =>
+            return "has_disconnect_flag";
+         when Field_Has_Active_Flag =>
+            return "has_active_flag";
+         when Field_Is_Within_Flag =>
+            return "is_within_flag";
+         when Field_Type_Marks_List =>
+            return "type_marks_list";
+         when Field_Implicit_Alias_Flag =>
+            return "implicit_alias_flag";
+         when Field_Alias_Signature =>
+            return "alias_signature";
+         when Field_Attribute_Signature =>
+            return "attribute_signature";
+         when Field_Overload_List =>
+            return "overload_list";
+         when Field_Simple_Name_Identifier =>
+            return "simple_name_identifier";
+         when Field_Simple_Name_Subtype =>
+            return "simple_name_subtype";
+         when Field_Protected_Type_Body =>
+            return "protected_type_body";
+         when Field_Protected_Type_Declaration =>
+            return "protected_type_declaration";
+         when Field_End_Location =>
+            return "end_location";
+         when Field_String_Id =>
+            return "string_id";
+         when Field_String_Length =>
+            return "string_length";
+         when Field_Use_Flag =>
+            return "use_flag";
+         when Field_End_Has_Reserved_Id =>
+            return "end_has_reserved_id";
+         when Field_End_Has_Identifier =>
+            return "end_has_identifier";
+         when Field_End_Has_Postponed =>
+            return "end_has_postponed";
+         when Field_Has_Begin =>
+            return "has_begin";
+         when Field_Has_Is =>
+            return "has_is";
+         when Field_Has_Pure =>
+            return "has_pure";
+         when Field_Has_Body =>
+            return "has_body";
+         when Field_Has_Identifier_List =>
+            return "has_identifier_list";
+         when Field_Has_Mode =>
+            return "has_mode";
+         when Field_Is_Ref =>
+            return "is_ref";
+         when Field_Psl_Property =>
+            return "psl_property";
+         when Field_Psl_Declaration =>
+            return "psl_declaration";
+         when Field_Psl_Expression =>
+            return "psl_expression";
+         when Field_Psl_Boolean =>
+            return "psl_boolean";
+         when Field_PSL_Clock =>
+            return "psl_clock";
+         when Field_PSL_NFA =>
+            return "psl_nfa";
+      end case;
+   end Get_Field_Image;
+
+   function Get_Iir_Image (K : Iir_Kind) return String is
+   begin
+      case K is
+         when Iir_Kind_Unused =>
+            return "unused";
+         when Iir_Kind_Error =>
+            return "error";
+         when Iir_Kind_Design_File =>
+            return "design_file";
+         when Iir_Kind_Design_Unit =>
+            return "design_unit";
+         when Iir_Kind_Library_Clause =>
+            return "library_clause";
+         when Iir_Kind_Use_Clause =>
+            return "use_clause";
+         when Iir_Kind_Integer_Literal =>
+            return "integer_literal";
+         when Iir_Kind_Floating_Point_Literal =>
+            return "floating_point_literal";
+         when Iir_Kind_Null_Literal =>
+            return "null_literal";
+         when Iir_Kind_String_Literal =>
+            return "string_literal";
+         when Iir_Kind_Physical_Int_Literal =>
+            return "physical_int_literal";
+         when Iir_Kind_Physical_Fp_Literal =>
+            return "physical_fp_literal";
+         when Iir_Kind_Bit_String_Literal =>
+            return "bit_string_literal";
+         when Iir_Kind_Simple_Aggregate =>
+            return "simple_aggregate";
+         when Iir_Kind_Overflow_Literal =>
+            return "overflow_literal";
+         when Iir_Kind_Waveform_Element =>
+            return "waveform_element";
+         when Iir_Kind_Conditional_Waveform =>
+            return "conditional_waveform";
+         when Iir_Kind_Association_Element_By_Expression =>
+            return "association_element_by_expression";
+         when Iir_Kind_Association_Element_By_Individual =>
+            return "association_element_by_individual";
+         when Iir_Kind_Association_Element_Open =>
+            return "association_element_open";
+         when Iir_Kind_Association_Element_Package =>
+            return "association_element_package";
+         when Iir_Kind_Choice_By_Others =>
+            return "choice_by_others";
+         when Iir_Kind_Choice_By_Expression =>
+            return "choice_by_expression";
+         when Iir_Kind_Choice_By_Range =>
+            return "choice_by_range";
+         when Iir_Kind_Choice_By_None =>
+            return "choice_by_none";
+         when Iir_Kind_Choice_By_Name =>
+            return "choice_by_name";
+         when Iir_Kind_Entity_Aspect_Entity =>
+            return "entity_aspect_entity";
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            return "entity_aspect_configuration";
+         when Iir_Kind_Entity_Aspect_Open =>
+            return "entity_aspect_open";
+         when Iir_Kind_Block_Configuration =>
+            return "block_configuration";
+         when Iir_Kind_Block_Header =>
+            return "block_header";
+         when Iir_Kind_Component_Configuration =>
+            return "component_configuration";
+         when Iir_Kind_Binding_Indication =>
+            return "binding_indication";
+         when Iir_Kind_Entity_Class =>
+            return "entity_class";
+         when Iir_Kind_Attribute_Value =>
+            return "attribute_value";
+         when Iir_Kind_Signature =>
+            return "signature";
+         when Iir_Kind_Aggregate_Info =>
+            return "aggregate_info";
+         when Iir_Kind_Procedure_Call =>
+            return "procedure_call";
+         when Iir_Kind_Record_Element_Constraint =>
+            return "record_element_constraint";
+         when Iir_Kind_Array_Element_Resolution =>
+            return "array_element_resolution";
+         when Iir_Kind_Record_Resolution =>
+            return "record_resolution";
+         when Iir_Kind_Record_Element_Resolution =>
+            return "record_element_resolution";
+         when Iir_Kind_Attribute_Specification =>
+            return "attribute_specification";
+         when Iir_Kind_Disconnection_Specification =>
+            return "disconnection_specification";
+         when Iir_Kind_Configuration_Specification =>
+            return "configuration_specification";
+         when Iir_Kind_Access_Type_Definition =>
+            return "access_type_definition";
+         when Iir_Kind_Incomplete_Type_Definition =>
+            return "incomplete_type_definition";
+         when Iir_Kind_File_Type_Definition =>
+            return "file_type_definition";
+         when Iir_Kind_Protected_Type_Declaration =>
+            return "protected_type_declaration";
+         when Iir_Kind_Record_Type_Definition =>
+            return "record_type_definition";
+         when Iir_Kind_Array_Type_Definition =>
+            return "array_type_definition";
+         when Iir_Kind_Array_Subtype_Definition =>
+            return "array_subtype_definition";
+         when Iir_Kind_Record_Subtype_Definition =>
+            return "record_subtype_definition";
+         when Iir_Kind_Access_Subtype_Definition =>
+            return "access_subtype_definition";
+         when Iir_Kind_Physical_Subtype_Definition =>
+            return "physical_subtype_definition";
+         when Iir_Kind_Floating_Subtype_Definition =>
+            return "floating_subtype_definition";
+         when Iir_Kind_Integer_Subtype_Definition =>
+            return "integer_subtype_definition";
+         when Iir_Kind_Enumeration_Subtype_Definition =>
+            return "enumeration_subtype_definition";
+         when Iir_Kind_Enumeration_Type_Definition =>
+            return "enumeration_type_definition";
+         when Iir_Kind_Integer_Type_Definition =>
+            return "integer_type_definition";
+         when Iir_Kind_Floating_Type_Definition =>
+            return "floating_type_definition";
+         when Iir_Kind_Physical_Type_Definition =>
+            return "physical_type_definition";
+         when Iir_Kind_Range_Expression =>
+            return "range_expression";
+         when Iir_Kind_Protected_Type_Body =>
+            return "protected_type_body";
+         when Iir_Kind_Subtype_Definition =>
+            return "subtype_definition";
+         when Iir_Kind_Scalar_Nature_Definition =>
+            return "scalar_nature_definition";
+         when Iir_Kind_Overload_List =>
+            return "overload_list";
+         when Iir_Kind_Type_Declaration =>
+            return "type_declaration";
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            return "anonymous_type_declaration";
+         when Iir_Kind_Subtype_Declaration =>
+            return "subtype_declaration";
+         when Iir_Kind_Nature_Declaration =>
+            return "nature_declaration";
+         when Iir_Kind_Subnature_Declaration =>
+            return "subnature_declaration";
+         when Iir_Kind_Package_Declaration =>
+            return "package_declaration";
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            return "package_instantiation_declaration";
+         when Iir_Kind_Package_Body =>
+            return "package_body";
+         when Iir_Kind_Configuration_Declaration =>
+            return "configuration_declaration";
+         when Iir_Kind_Entity_Declaration =>
+            return "entity_declaration";
+         when Iir_Kind_Architecture_Body =>
+            return "architecture_body";
+         when Iir_Kind_Package_Header =>
+            return "package_header";
+         when Iir_Kind_Unit_Declaration =>
+            return "unit_declaration";
+         when Iir_Kind_Library_Declaration =>
+            return "library_declaration";
+         when Iir_Kind_Component_Declaration =>
+            return "component_declaration";
+         when Iir_Kind_Attribute_Declaration =>
+            return "attribute_declaration";
+         when Iir_Kind_Group_Template_Declaration =>
+            return "group_template_declaration";
+         when Iir_Kind_Group_Declaration =>
+            return "group_declaration";
+         when Iir_Kind_Element_Declaration =>
+            return "element_declaration";
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            return "non_object_alias_declaration";
+         when Iir_Kind_Psl_Declaration =>
+            return "psl_declaration";
+         when Iir_Kind_Terminal_Declaration =>
+            return "terminal_declaration";
+         when Iir_Kind_Free_Quantity_Declaration =>
+            return "free_quantity_declaration";
+         when Iir_Kind_Across_Quantity_Declaration =>
+            return "across_quantity_declaration";
+         when Iir_Kind_Through_Quantity_Declaration =>
+            return "through_quantity_declaration";
+         when Iir_Kind_Enumeration_Literal =>
+            return "enumeration_literal";
+         when Iir_Kind_Function_Declaration =>
+            return "function_declaration";
+         when Iir_Kind_Implicit_Function_Declaration =>
+            return "implicit_function_declaration";
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            return "implicit_procedure_declaration";
+         when Iir_Kind_Procedure_Declaration =>
+            return "procedure_declaration";
+         when Iir_Kind_Function_Body =>
+            return "function_body";
+         when Iir_Kind_Procedure_Body =>
+            return "procedure_body";
+         when Iir_Kind_Object_Alias_Declaration =>
+            return "object_alias_declaration";
+         when Iir_Kind_File_Declaration =>
+            return "file_declaration";
+         when Iir_Kind_Guard_Signal_Declaration =>
+            return "guard_signal_declaration";
+         when Iir_Kind_Signal_Declaration =>
+            return "signal_declaration";
+         when Iir_Kind_Variable_Declaration =>
+            return "variable_declaration";
+         when Iir_Kind_Constant_Declaration =>
+            return "constant_declaration";
+         when Iir_Kind_Iterator_Declaration =>
+            return "iterator_declaration";
+         when Iir_Kind_Interface_Constant_Declaration =>
+            return "interface_constant_declaration";
+         when Iir_Kind_Interface_Variable_Declaration =>
+            return "interface_variable_declaration";
+         when Iir_Kind_Interface_Signal_Declaration =>
+            return "interface_signal_declaration";
+         when Iir_Kind_Interface_File_Declaration =>
+            return "interface_file_declaration";
+         when Iir_Kind_Interface_Package_Declaration =>
+            return "interface_package_declaration";
+         when Iir_Kind_Identity_Operator =>
+            return "identity_operator";
+         when Iir_Kind_Negation_Operator =>
+            return "negation_operator";
+         when Iir_Kind_Absolute_Operator =>
+            return "absolute_operator";
+         when Iir_Kind_Not_Operator =>
+            return "not_operator";
+         when Iir_Kind_Condition_Operator =>
+            return "condition_operator";
+         when Iir_Kind_Reduction_And_Operator =>
+            return "reduction_and_operator";
+         when Iir_Kind_Reduction_Or_Operator =>
+            return "reduction_or_operator";
+         when Iir_Kind_Reduction_Nand_Operator =>
+            return "reduction_nand_operator";
+         when Iir_Kind_Reduction_Nor_Operator =>
+            return "reduction_nor_operator";
+         when Iir_Kind_Reduction_Xor_Operator =>
+            return "reduction_xor_operator";
+         when Iir_Kind_Reduction_Xnor_Operator =>
+            return "reduction_xnor_operator";
+         when Iir_Kind_And_Operator =>
+            return "and_operator";
+         when Iir_Kind_Or_Operator =>
+            return "or_operator";
+         when Iir_Kind_Nand_Operator =>
+            return "nand_operator";
+         when Iir_Kind_Nor_Operator =>
+            return "nor_operator";
+         when Iir_Kind_Xor_Operator =>
+            return "xor_operator";
+         when Iir_Kind_Xnor_Operator =>
+            return "xnor_operator";
+         when Iir_Kind_Equality_Operator =>
+            return "equality_operator";
+         when Iir_Kind_Inequality_Operator =>
+            return "inequality_operator";
+         when Iir_Kind_Less_Than_Operator =>
+            return "less_than_operator";
+         when Iir_Kind_Less_Than_Or_Equal_Operator =>
+            return "less_than_or_equal_operator";
+         when Iir_Kind_Greater_Than_Operator =>
+            return "greater_than_operator";
+         when Iir_Kind_Greater_Than_Or_Equal_Operator =>
+            return "greater_than_or_equal_operator";
+         when Iir_Kind_Match_Equality_Operator =>
+            return "match_equality_operator";
+         when Iir_Kind_Match_Inequality_Operator =>
+            return "match_inequality_operator";
+         when Iir_Kind_Match_Less_Than_Operator =>
+            return "match_less_than_operator";
+         when Iir_Kind_Match_Less_Than_Or_Equal_Operator =>
+            return "match_less_than_or_equal_operator";
+         when Iir_Kind_Match_Greater_Than_Operator =>
+            return "match_greater_than_operator";
+         when Iir_Kind_Match_Greater_Than_Or_Equal_Operator =>
+            return "match_greater_than_or_equal_operator";
+         when Iir_Kind_Sll_Operator =>
+            return "sll_operator";
+         when Iir_Kind_Sla_Operator =>
+            return "sla_operator";
+         when Iir_Kind_Srl_Operator =>
+            return "srl_operator";
+         when Iir_Kind_Sra_Operator =>
+            return "sra_operator";
+         when Iir_Kind_Rol_Operator =>
+            return "rol_operator";
+         when Iir_Kind_Ror_Operator =>
+            return "ror_operator";
+         when Iir_Kind_Addition_Operator =>
+            return "addition_operator";
+         when Iir_Kind_Substraction_Operator =>
+            return "substraction_operator";
+         when Iir_Kind_Concatenation_Operator =>
+            return "concatenation_operator";
+         when Iir_Kind_Multiplication_Operator =>
+            return "multiplication_operator";
+         when Iir_Kind_Division_Operator =>
+            return "division_operator";
+         when Iir_Kind_Modulus_Operator =>
+            return "modulus_operator";
+         when Iir_Kind_Remainder_Operator =>
+            return "remainder_operator";
+         when Iir_Kind_Exponentiation_Operator =>
+            return "exponentiation_operator";
+         when Iir_Kind_Function_Call =>
+            return "function_call";
+         when Iir_Kind_Aggregate =>
+            return "aggregate";
+         when Iir_Kind_Parenthesis_Expression =>
+            return "parenthesis_expression";
+         when Iir_Kind_Qualified_Expression =>
+            return "qualified_expression";
+         when Iir_Kind_Type_Conversion =>
+            return "type_conversion";
+         when Iir_Kind_Allocator_By_Expression =>
+            return "allocator_by_expression";
+         when Iir_Kind_Allocator_By_Subtype =>
+            return "allocator_by_subtype";
+         when Iir_Kind_Selected_Element =>
+            return "selected_element";
+         when Iir_Kind_Dereference =>
+            return "dereference";
+         when Iir_Kind_Implicit_Dereference =>
+            return "implicit_dereference";
+         when Iir_Kind_Slice_Name =>
+            return "slice_name";
+         when Iir_Kind_Indexed_Name =>
+            return "indexed_name";
+         when Iir_Kind_Psl_Expression =>
+            return "psl_expression";
+         when Iir_Kind_Sensitized_Process_Statement =>
+            return "sensitized_process_statement";
+         when Iir_Kind_Process_Statement =>
+            return "process_statement";
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+            return "concurrent_conditional_signal_assignment";
+         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            return "concurrent_selected_signal_assignment";
+         when Iir_Kind_Concurrent_Assertion_Statement =>
+            return "concurrent_assertion_statement";
+         when Iir_Kind_Psl_Default_Clock =>
+            return "psl_default_clock";
+         when Iir_Kind_Psl_Assert_Statement =>
+            return "psl_assert_statement";
+         when Iir_Kind_Psl_Cover_Statement =>
+            return "psl_cover_statement";
+         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            return "concurrent_procedure_call_statement";
+         when Iir_Kind_Block_Statement =>
+            return "block_statement";
+         when Iir_Kind_Generate_Statement =>
+            return "generate_statement";
+         when Iir_Kind_Component_Instantiation_Statement =>
+            return "component_instantiation_statement";
+         when Iir_Kind_Simple_Simultaneous_Statement =>
+            return "simple_simultaneous_statement";
+         when Iir_Kind_Signal_Assignment_Statement =>
+            return "signal_assignment_statement";
+         when Iir_Kind_Null_Statement =>
+            return "null_statement";
+         when Iir_Kind_Assertion_Statement =>
+            return "assertion_statement";
+         when Iir_Kind_Report_Statement =>
+            return "report_statement";
+         when Iir_Kind_Wait_Statement =>
+            return "wait_statement";
+         when Iir_Kind_Variable_Assignment_Statement =>
+            return "variable_assignment_statement";
+         when Iir_Kind_Return_Statement =>
+            return "return_statement";
+         when Iir_Kind_For_Loop_Statement =>
+            return "for_loop_statement";
+         when Iir_Kind_While_Loop_Statement =>
+            return "while_loop_statement";
+         when Iir_Kind_Next_Statement =>
+            return "next_statement";
+         when Iir_Kind_Exit_Statement =>
+            return "exit_statement";
+         when Iir_Kind_Case_Statement =>
+            return "case_statement";
+         when Iir_Kind_Procedure_Call_Statement =>
+            return "procedure_call_statement";
+         when Iir_Kind_If_Statement =>
+            return "if_statement";
+         when Iir_Kind_Elsif =>
+            return "elsif";
+         when Iir_Kind_Character_Literal =>
+            return "character_literal";
+         when Iir_Kind_Simple_Name =>
+            return "simple_name";
+         when Iir_Kind_Selected_Name =>
+            return "selected_name";
+         when Iir_Kind_Operator_Symbol =>
+            return "operator_symbol";
+         when Iir_Kind_Selected_By_All_Name =>
+            return "selected_by_all_name";
+         when Iir_Kind_Parenthesis_Name =>
+            return "parenthesis_name";
+         when Iir_Kind_Base_Attribute =>
+            return "base_attribute";
+         when Iir_Kind_Left_Type_Attribute =>
+            return "left_type_attribute";
+         when Iir_Kind_Right_Type_Attribute =>
+            return "right_type_attribute";
+         when Iir_Kind_High_Type_Attribute =>
+            return "high_type_attribute";
+         when Iir_Kind_Low_Type_Attribute =>
+            return "low_type_attribute";
+         when Iir_Kind_Ascending_Type_Attribute =>
+            return "ascending_type_attribute";
+         when Iir_Kind_Image_Attribute =>
+            return "image_attribute";
+         when Iir_Kind_Value_Attribute =>
+            return "value_attribute";
+         when Iir_Kind_Pos_Attribute =>
+            return "pos_attribute";
+         when Iir_Kind_Val_Attribute =>
+            return "val_attribute";
+         when Iir_Kind_Succ_Attribute =>
+            return "succ_attribute";
+         when Iir_Kind_Pred_Attribute =>
+            return "pred_attribute";
+         when Iir_Kind_Leftof_Attribute =>
+            return "leftof_attribute";
+         when Iir_Kind_Rightof_Attribute =>
+            return "rightof_attribute";
+         when Iir_Kind_Delayed_Attribute =>
+            return "delayed_attribute";
+         when Iir_Kind_Stable_Attribute =>
+            return "stable_attribute";
+         when Iir_Kind_Quiet_Attribute =>
+            return "quiet_attribute";
+         when Iir_Kind_Transaction_Attribute =>
+            return "transaction_attribute";
+         when Iir_Kind_Event_Attribute =>
+            return "event_attribute";
+         when Iir_Kind_Active_Attribute =>
+            return "active_attribute";
+         when Iir_Kind_Last_Event_Attribute =>
+            return "last_event_attribute";
+         when Iir_Kind_Last_Active_Attribute =>
+            return "last_active_attribute";
+         when Iir_Kind_Last_Value_Attribute =>
+            return "last_value_attribute";
+         when Iir_Kind_Driving_Attribute =>
+            return "driving_attribute";
+         when Iir_Kind_Driving_Value_Attribute =>
+            return "driving_value_attribute";
+         when Iir_Kind_Behavior_Attribute =>
+            return "behavior_attribute";
+         when Iir_Kind_Structure_Attribute =>
+            return "structure_attribute";
+         when Iir_Kind_Simple_Name_Attribute =>
+            return "simple_name_attribute";
+         when Iir_Kind_Instance_Name_Attribute =>
+            return "instance_name_attribute";
+         when Iir_Kind_Path_Name_Attribute =>
+            return "path_name_attribute";
+         when Iir_Kind_Left_Array_Attribute =>
+            return "left_array_attribute";
+         when Iir_Kind_Right_Array_Attribute =>
+            return "right_array_attribute";
+         when Iir_Kind_High_Array_Attribute =>
+            return "high_array_attribute";
+         when Iir_Kind_Low_Array_Attribute =>
+            return "low_array_attribute";
+         when Iir_Kind_Length_Array_Attribute =>
+            return "length_array_attribute";
+         when Iir_Kind_Ascending_Array_Attribute =>
+            return "ascending_array_attribute";
+         when Iir_Kind_Range_Array_Attribute =>
+            return "range_array_attribute";
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            return "reverse_range_array_attribute";
+         when Iir_Kind_Attribute_Name =>
+            return "attribute_name";
+      end case;
+   end Get_Iir_Image;
+
+   function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is
+   begin
+      case F is
+         when Field_First_Design_Unit =>
+            return Attr_Chain;
+         when Field_Last_Design_Unit =>
+            return Attr_Ref;
+         when Field_Library_Declaration =>
+            return Attr_None;
+         when Field_File_Time_Stamp =>
+            return Attr_None;
+         when Field_Analysis_Time_Stamp =>
+            return Attr_None;
+         when Field_Library =>
+            return Attr_Ref;
+         when Field_File_Dependence_List =>
+            return Attr_None;
+         when Field_Design_File_Filename =>
+            return Attr_None;
+         when Field_Design_File_Directory =>
+            return Attr_None;
+         when Field_Design_File =>
+            return Attr_Ref;
+         when Field_Design_File_Chain =>
+            return Attr_Chain;
+         when Field_Library_Directory =>
+            return Attr_None;
+         when Field_Date =>
+            return Attr_None;
+         when Field_Context_Items =>
+            return Attr_Chain;
+         when Field_Dependence_List =>
+            return Attr_Of_Ref;
+         when Field_Analysis_Checks_List =>
+            return Attr_None;
+         when Field_Date_State =>
+            return Attr_None;
+         when Field_Guarded_Target_State =>
+            return Attr_None;
+         when Field_Library_Unit =>
+            return Attr_None;
+         when Field_Hash_Chain =>
+            return Attr_Ref;
+         when Field_Design_Unit_Source_Pos =>
+            return Attr_None;
+         when Field_Design_Unit_Source_Line =>
+            return Attr_None;
+         when Field_Design_Unit_Source_Col =>
+            return Attr_None;
+         when Field_Value =>
+            return Attr_None;
+         when Field_Enum_Pos =>
+            return Attr_None;
+         when Field_Physical_Literal =>
+            return Attr_None;
+         when Field_Physical_Unit_Value =>
+            return Attr_None;
+         when Field_Fp_Value =>
+            return Attr_None;
+         when Field_Enumeration_Decl =>
+            return Attr_Ref;
+         when Field_Simple_Aggregate_List =>
+            return Attr_None;
+         when Field_Bit_String_Base =>
+            return Attr_None;
+         when Field_Bit_String_0 =>
+            return Attr_None;
+         when Field_Bit_String_1 =>
+            return Attr_None;
+         when Field_Literal_Origin =>
+            return Attr_None;
+         when Field_Range_Origin =>
+            return Attr_None;
+         when Field_Literal_Subtype =>
+            return Attr_None;
+         when Field_Entity_Class =>
+            return Attr_None;
+         when Field_Entity_Name_List =>
+            return Attr_None;
+         when Field_Attribute_Designator =>
+            return Attr_None;
+         when Field_Attribute_Specification_Chain =>
+            return Attr_None;
+         when Field_Attribute_Specification =>
+            return Attr_Ref;
+         when Field_Signal_List =>
+            return Attr_None;
+         when Field_Designated_Entity =>
+            return Attr_Ref;
+         when Field_Formal =>
+            return Attr_None;
+         when Field_Actual =>
+            return Attr_None;
+         when Field_In_Conversion =>
+            return Attr_None;
+         when Field_Out_Conversion =>
+            return Attr_None;
+         when Field_Whole_Association_Flag =>
+            return Attr_None;
+         when Field_Collapse_Signal_Flag =>
+            return Attr_None;
+         when Field_Artificial_Flag =>
+            return Attr_None;
+         when Field_Open_Flag =>
+            return Attr_None;
+         when Field_After_Drivers_Flag =>
+            return Attr_None;
+         when Field_We_Value =>
+            return Attr_None;
+         when Field_Time =>
+            return Attr_None;
+         when Field_Associated_Expr =>
+            return Attr_None;
+         when Field_Associated_Chain =>
+            return Attr_Chain;
+         when Field_Choice_Name =>
+            return Attr_None;
+         when Field_Choice_Expression =>
+            return Attr_None;
+         when Field_Choice_Range =>
+            return Attr_None;
+         when Field_Same_Alternative_Flag =>
+            return Attr_None;
+         when Field_Architecture =>
+            return Attr_None;
+         when Field_Block_Specification =>
+            return Attr_None;
+         when Field_Prev_Block_Configuration =>
+            return Attr_Ref;
+         when Field_Configuration_Item_Chain =>
+            return Attr_Chain;
+         when Field_Attribute_Value_Chain =>
+            return Attr_Chain;
+         when Field_Spec_Chain =>
+            return Attr_None;
+         when Field_Attribute_Value_Spec_Chain =>
+            return Attr_None;
+         when Field_Entity_Name =>
+            return Attr_None;
+         when Field_Package =>
+            return Attr_Ref;
+         when Field_Package_Body =>
+            return Attr_Ref;
+         when Field_Need_Body =>
+            return Attr_None;
+         when Field_Block_Configuration =>
+            return Attr_None;
+         when Field_Concurrent_Statement_Chain =>
+            return Attr_Chain;
+         when Field_Chain =>
+            return Attr_Chain_Next;
+         when Field_Port_Chain =>
+            return Attr_Chain;
+         when Field_Generic_Chain =>
+            return Attr_Chain;
+         when Field_Type =>
+            return Attr_Ref;
+         when Field_Subtype_Indication =>
+            return Attr_Maybe_Ref;
+         when Field_Discrete_Range =>
+            return Attr_None;
+         when Field_Type_Definition =>
+            return Attr_None;
+         when Field_Subtype_Definition =>
+            return Attr_None;
+         when Field_Nature =>
+            return Attr_None;
+         when Field_Mode =>
+            return Attr_None;
+         when Field_Signal_Kind =>
+            return Attr_None;
+         when Field_Base_Name =>
+            return Attr_Ref;
+         when Field_Interface_Declaration_Chain =>
+            return Attr_Chain;
+         when Field_Subprogram_Specification =>
+            return Attr_Ref;
+         when Field_Sequential_Statement_Chain =>
+            return Attr_Chain;
+         when Field_Subprogram_Body =>
+            return Attr_Ref;
+         when Field_Overload_Number =>
+            return Attr_None;
+         when Field_Subprogram_Depth =>
+            return Attr_None;
+         when Field_Subprogram_Hash =>
+            return Attr_None;
+         when Field_Impure_Depth =>
+            return Attr_None;
+         when Field_Return_Type =>
+            return Attr_Ref;
+         when Field_Implicit_Definition =>
+            return Attr_None;
+         when Field_Type_Reference =>
+            return Attr_Ref;
+         when Field_Default_Value =>
+            return Attr_Maybe_Ref;
+         when Field_Deferred_Declaration =>
+            return Attr_None;
+         when Field_Deferred_Declaration_Flag =>
+            return Attr_None;
+         when Field_Shared_Flag =>
+            return Attr_None;
+         when Field_Design_Unit =>
+            return Attr_None;
+         when Field_Block_Statement =>
+            return Attr_None;
+         when Field_Signal_Driver =>
+            return Attr_None;
+         when Field_Declaration_Chain =>
+            return Attr_Chain;
+         when Field_File_Logical_Name =>
+            return Attr_None;
+         when Field_File_Open_Kind =>
+            return Attr_None;
+         when Field_Element_Position =>
+            return Attr_None;
+         when Field_Element_Declaration =>
+            return Attr_None;
+         when Field_Selected_Element =>
+            return Attr_Ref;
+         when Field_Use_Clause_Chain =>
+            return Attr_None;
+         when Field_Selected_Name =>
+            return Attr_None;
+         when Field_Type_Declarator =>
+            return Attr_Ref;
+         when Field_Enumeration_Literal_List =>
+            return Attr_None;
+         when Field_Entity_Class_Entry_Chain =>
+            return Attr_Chain;
+         when Field_Group_Constituent_List =>
+            return Attr_None;
+         when Field_Unit_Chain =>
+            return Attr_Chain;
+         when Field_Primary_Unit =>
+            return Attr_Ref;
+         when Field_Identifier =>
+            return Attr_None;
+         when Field_Label =>
+            return Attr_None;
+         when Field_Visible_Flag =>
+            return Attr_None;
+         when Field_Range_Constraint =>
+            return Attr_None;
+         when Field_Direction =>
+            return Attr_None;
+         when Field_Left_Limit =>
+            return Attr_None;
+         when Field_Right_Limit =>
+            return Attr_None;
+         when Field_Base_Type =>
+            return Attr_Ref;
+         when Field_Resolution_Indication =>
+            return Attr_None;
+         when Field_Record_Element_Resolution_Chain =>
+            return Attr_Chain;
+         when Field_Tolerance =>
+            return Attr_None;
+         when Field_Plus_Terminal =>
+            return Attr_None;
+         when Field_Minus_Terminal =>
+            return Attr_None;
+         when Field_Simultaneous_Left =>
+            return Attr_None;
+         when Field_Simultaneous_Right =>
+            return Attr_None;
+         when Field_Text_File_Flag =>
+            return Attr_None;
+         when Field_Only_Characters_Flag =>
+            return Attr_None;
+         when Field_Type_Staticness =>
+            return Attr_None;
+         when Field_Constraint_State =>
+            return Attr_None;
+         when Field_Index_Subtype_List =>
+            return Attr_Ref;
+         when Field_Index_Subtype_Definition_List =>
+            return Attr_None;
+         when Field_Element_Subtype_Indication =>
+            return Attr_None;
+         when Field_Element_Subtype =>
+            return Attr_Ref;
+         when Field_Index_Constraint_List =>
+            return Attr_None;
+         when Field_Array_Element_Constraint =>
+            return Attr_None;
+         when Field_Elements_Declaration_List =>
+            return Attr_None;
+         when Field_Designated_Type =>
+            return Attr_Ref;
+         when Field_Designated_Subtype_Indication =>
+            return Attr_None;
+         when Field_Index_List =>
+            return Attr_None;
+         when Field_Reference =>
+            return Attr_None;
+         when Field_Nature_Declarator =>
+            return Attr_None;
+         when Field_Across_Type =>
+            return Attr_None;
+         when Field_Through_Type =>
+            return Attr_None;
+         when Field_Target =>
+            return Attr_None;
+         when Field_Waveform_Chain =>
+            return Attr_Chain;
+         when Field_Guard =>
+            return Attr_None;
+         when Field_Delay_Mechanism =>
+            return Attr_None;
+         when Field_Reject_Time_Expression =>
+            return Attr_None;
+         when Field_Sensitivity_List =>
+            return Attr_None;
+         when Field_Process_Origin =>
+            return Attr_None;
+         when Field_Condition_Clause =>
+            return Attr_None;
+         when Field_Timeout_Clause =>
+            return Attr_None;
+         when Field_Postponed_Flag =>
+            return Attr_None;
+         when Field_Callees_List =>
+            return Attr_Of_Ref;
+         when Field_Passive_Flag =>
+            return Attr_None;
+         when Field_Resolution_Function_Flag =>
+            return Attr_None;
+         when Field_Wait_State =>
+            return Attr_None;
+         when Field_All_Sensitized_State =>
+            return Attr_None;
+         when Field_Seen_Flag =>
+            return Attr_None;
+         when Field_Pure_Flag =>
+            return Attr_None;
+         when Field_Foreign_Flag =>
+            return Attr_None;
+         when Field_Resolved_Flag =>
+            return Attr_None;
+         when Field_Signal_Type_Flag =>
+            return Attr_None;
+         when Field_Has_Signal_Flag =>
+            return Attr_None;
+         when Field_Purity_State =>
+            return Attr_None;
+         when Field_Elab_Flag =>
+            return Attr_None;
+         when Field_Index_Constraint_Flag =>
+            return Attr_None;
+         when Field_Assertion_Condition =>
+            return Attr_None;
+         when Field_Report_Expression =>
+            return Attr_None;
+         when Field_Severity_Expression =>
+            return Attr_None;
+         when Field_Instantiated_Unit =>
+            return Attr_None;
+         when Field_Generic_Map_Aspect_Chain =>
+            return Attr_Chain;
+         when Field_Port_Map_Aspect_Chain =>
+            return Attr_Chain;
+         when Field_Configuration_Name =>
+            return Attr_None;
+         when Field_Component_Configuration =>
+            return Attr_None;
+         when Field_Configuration_Specification =>
+            return Attr_None;
+         when Field_Default_Binding_Indication =>
+            return Attr_None;
+         when Field_Default_Configuration_Declaration =>
+            return Attr_None;
+         when Field_Expression =>
+            return Attr_None;
+         when Field_Allocator_Designated_Type =>
+            return Attr_Ref;
+         when Field_Selected_Waveform_Chain =>
+            return Attr_Chain;
+         when Field_Conditional_Waveform_Chain =>
+            return Attr_Chain;
+         when Field_Guard_Expression =>
+            return Attr_None;
+         when Field_Guard_Decl =>
+            return Attr_None;
+         when Field_Guard_Sensitivity_List =>
+            return Attr_None;
+         when Field_Block_Block_Configuration =>
+            return Attr_None;
+         when Field_Package_Header =>
+            return Attr_None;
+         when Field_Block_Header =>
+            return Attr_None;
+         when Field_Uninstantiated_Package_Name =>
+            return Attr_None;
+         when Field_Generate_Block_Configuration =>
+            return Attr_None;
+         when Field_Generation_Scheme =>
+            return Attr_None;
+         when Field_Condition =>
+            return Attr_None;
+         when Field_Else_Clause =>
+            return Attr_None;
+         when Field_Parameter_Specification =>
+            return Attr_None;
+         when Field_Parent =>
+            return Attr_Ref;
+         when Field_Loop_Label =>
+            return Attr_None;
+         when Field_Component_Name =>
+            return Attr_None;
+         when Field_Instantiation_List =>
+            return Attr_None;
+         when Field_Entity_Aspect =>
+            return Attr_None;
+         when Field_Default_Entity_Aspect =>
+            return Attr_None;
+         when Field_Default_Generic_Map_Aspect_Chain =>
+            return Attr_Chain;
+         when Field_Default_Port_Map_Aspect_Chain =>
+            return Attr_Chain;
+         when Field_Binding_Indication =>
+            return Attr_None;
+         when Field_Named_Entity =>
+            return Attr_Ref;
+         when Field_Alias_Declaration =>
+            return Attr_None;
+         when Field_Expr_Staticness =>
+            return Attr_None;
+         when Field_Error_Origin =>
+            return Attr_None;
+         when Field_Operand =>
+            return Attr_None;
+         when Field_Left =>
+            return Attr_None;
+         when Field_Right =>
+            return Attr_None;
+         when Field_Unit_Name =>
+            return Attr_None;
+         when Field_Name =>
+            return Attr_None;
+         when Field_Group_Template_Name =>
+            return Attr_None;
+         when Field_Name_Staticness =>
+            return Attr_None;
+         when Field_Prefix =>
+            return Attr_None;
+         when Field_Signature_Prefix =>
+            return Attr_Ref;
+         when Field_Slice_Subtype =>
+            return Attr_None;
+         when Field_Suffix =>
+            return Attr_None;
+         when Field_Index_Subtype =>
+            return Attr_None;
+         when Field_Parameter =>
+            return Attr_None;
+         when Field_Actual_Type =>
+            return Attr_None;
+         when Field_Associated_Interface =>
+            return Attr_Ref;
+         when Field_Association_Chain =>
+            return Attr_Chain;
+         when Field_Individual_Association_Chain =>
+            return Attr_Chain;
+         when Field_Aggregate_Info =>
+            return Attr_None;
+         when Field_Sub_Aggregate_Info =>
+            return Attr_None;
+         when Field_Aggr_Dynamic_Flag =>
+            return Attr_None;
+         when Field_Aggr_Min_Length =>
+            return Attr_None;
+         when Field_Aggr_Low_Limit =>
+            return Attr_None;
+         when Field_Aggr_High_Limit =>
+            return Attr_None;
+         when Field_Aggr_Others_Flag =>
+            return Attr_None;
+         when Field_Aggr_Named_Flag =>
+            return Attr_None;
+         when Field_Value_Staticness =>
+            return Attr_None;
+         when Field_Association_Choices_Chain =>
+            return Attr_Chain;
+         when Field_Case_Statement_Alternative_Chain =>
+            return Attr_Chain;
+         when Field_Choice_Staticness =>
+            return Attr_None;
+         when Field_Procedure_Call =>
+            return Attr_None;
+         when Field_Implementation =>
+            return Attr_Ref;
+         when Field_Parameter_Association_Chain =>
+            return Attr_Chain;
+         when Field_Method_Object =>
+            return Attr_None;
+         when Field_Subtype_Type_Mark =>
+            return Attr_None;
+         when Field_Type_Conversion_Subtype =>
+            return Attr_None;
+         when Field_Type_Mark =>
+            return Attr_None;
+         when Field_File_Type_Mark =>
+            return Attr_None;
+         when Field_Return_Type_Mark =>
+            return Attr_None;
+         when Field_Lexical_Layout =>
+            return Attr_None;
+         when Field_Incomplete_Type_List =>
+            return Attr_None;
+         when Field_Has_Disconnect_Flag =>
+            return Attr_None;
+         when Field_Has_Active_Flag =>
+            return Attr_None;
+         when Field_Is_Within_Flag =>
+            return Attr_None;
+         when Field_Type_Marks_List =>
+            return Attr_None;
+         when Field_Implicit_Alias_Flag =>
+            return Attr_None;
+         when Field_Alias_Signature =>
+            return Attr_None;
+         when Field_Attribute_Signature =>
+            return Attr_None;
+         when Field_Overload_List =>
+            return Attr_Of_Ref;
+         when Field_Simple_Name_Identifier =>
+            return Attr_None;
+         when Field_Simple_Name_Subtype =>
+            return Attr_None;
+         when Field_Protected_Type_Body =>
+            return Attr_None;
+         when Field_Protected_Type_Declaration =>
+            return Attr_None;
+         when Field_End_Location =>
+            return Attr_None;
+         when Field_String_Id =>
+            return Attr_None;
+         when Field_String_Length =>
+            return Attr_None;
+         when Field_Use_Flag =>
+            return Attr_None;
+         when Field_End_Has_Reserved_Id =>
+            return Attr_None;
+         when Field_End_Has_Identifier =>
+            return Attr_None;
+         when Field_End_Has_Postponed =>
+            return Attr_None;
+         when Field_Has_Begin =>
+            return Attr_None;
+         when Field_Has_Is =>
+            return Attr_None;
+         when Field_Has_Pure =>
+            return Attr_None;
+         when Field_Has_Body =>
+            return Attr_None;
+         when Field_Has_Identifier_List =>
+            return Attr_None;
+         when Field_Has_Mode =>
+            return Attr_None;
+         when Field_Is_Ref =>
+            return Attr_None;
+         when Field_Psl_Property =>
+            return Attr_None;
+         when Field_Psl_Declaration =>
+            return Attr_None;
+         when Field_Psl_Expression =>
+            return Attr_None;
+         when Field_Psl_Boolean =>
+            return Attr_None;
+         when Field_PSL_Clock =>
+            return Attr_None;
+         when Field_PSL_NFA =>
+            return Attr_None;
+      end case;
+   end Get_Field_Attribute;
+
+   Fields_Of_Iir : constant Fields_Array :=
+     (
+      --  Iir_Kind_Unused
+      --  Iir_Kind_Error
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Expr_Staticness,
+      Field_Error_Origin,
+      Field_Type,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Design_File
+      Field_Design_File_Directory,
+      Field_Design_File_Filename,
+      Field_Analysis_Time_Stamp,
+      Field_File_Time_Stamp,
+      Field_Elab_Flag,
+      Field_File_Dependence_List,
+      Field_Chain,
+      Field_First_Design_Unit,
+      Field_Library,
+      Field_Last_Design_Unit,
+      --  Iir_Kind_Design_Unit
+      Field_Date,
+      Field_Design_Unit_Source_Line,
+      Field_Design_Unit_Source_Col,
+      Field_Identifier,
+      Field_Design_Unit_Source_Pos,
+      Field_End_Location,
+      Field_Elab_Flag,
+      Field_Date_State,
+      Field_Context_Items,
+      Field_Chain,
+      Field_Library_Unit,
+      Field_Analysis_Checks_List,
+      Field_Design_File,
+      Field_Hash_Chain,
+      Field_Dependence_List,
+      --  Iir_Kind_Library_Clause
+      Field_Identifier,
+      Field_Has_Identifier_List,
+      Field_Library_Declaration,
+      Field_Chain,
+      Field_Parent,
+      --  Iir_Kind_Use_Clause
+      Field_Selected_Name,
+      Field_Chain,
+      Field_Use_Clause_Chain,
+      Field_Parent,
+      --  Iir_Kind_Integer_Literal
+      Field_Value,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Type,
+      --  Iir_Kind_Floating_Point_Literal
+      Field_Fp_Value,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Type,
+      --  Iir_Kind_Null_Literal
+      Field_Expr_Staticness,
+      Field_Type,
+      --  Iir_Kind_String_Literal
+      Field_String_Id,
+      Field_String_Length,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Literal_Subtype,
+      Field_Type,
+      --  Iir_Kind_Physical_Int_Literal
+      Field_Value,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Unit_Name,
+      Field_Type,
+      --  Iir_Kind_Physical_Fp_Literal
+      Field_Fp_Value,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Unit_Name,
+      Field_Type,
+      --  Iir_Kind_Bit_String_Literal
+      Field_String_Id,
+      Field_String_Length,
+      Field_Bit_String_Base,
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Literal_Subtype,
+      Field_Bit_String_0,
+      Field_Bit_String_1,
+      Field_Type,
+      --  Iir_Kind_Simple_Aggregate
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Simple_Aggregate_List,
+      Field_Literal_Subtype,
+      Field_Type,
+      --  Iir_Kind_Overflow_Literal
+      Field_Expr_Staticness,
+      Field_Literal_Origin,
+      Field_Type,
+      --  Iir_Kind_Waveform_Element
+      Field_We_Value,
+      Field_Chain,
+      Field_Time,
+      --  Iir_Kind_Conditional_Waveform
+      Field_Condition,
+      Field_Chain,
+      Field_Waveform_Chain,
+      --  Iir_Kind_Association_Element_By_Expression
+      Field_Whole_Association_Flag,
+      Field_Collapse_Signal_Flag,
+      Field_Formal,
+      Field_Chain,
+      Field_Actual,
+      Field_In_Conversion,
+      Field_Out_Conversion,
+      --  Iir_Kind_Association_Element_By_Individual
+      Field_Whole_Association_Flag,
+      Field_Collapse_Signal_Flag,
+      Field_Formal,
+      Field_Chain,
+      Field_Actual_Type,
+      Field_Individual_Association_Chain,
+      --  Iir_Kind_Association_Element_Open
+      Field_Whole_Association_Flag,
+      Field_Collapse_Signal_Flag,
+      Field_Artificial_Flag,
+      Field_Formal,
+      Field_Chain,
+      --  Iir_Kind_Association_Element_Package
+      Field_Whole_Association_Flag,
+      Field_Collapse_Signal_Flag,
+      Field_Formal,
+      Field_Chain,
+      Field_Actual,
+      Field_Associated_Interface,
+      --  Iir_Kind_Choice_By_Others
+      Field_Same_Alternative_Flag,
+      Field_Chain,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Parent,
+      --  Iir_Kind_Choice_By_Expression
+      Field_Same_Alternative_Flag,
+      Field_Choice_Staticness,
+      Field_Chain,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Choice_Expression,
+      Field_Parent,
+      --  Iir_Kind_Choice_By_Range
+      Field_Same_Alternative_Flag,
+      Field_Choice_Staticness,
+      Field_Chain,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Choice_Range,
+      Field_Parent,
+      --  Iir_Kind_Choice_By_None
+      Field_Same_Alternative_Flag,
+      Field_Chain,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Parent,
+      --  Iir_Kind_Choice_By_Name
+      Field_Same_Alternative_Flag,
+      Field_Chain,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Choice_Name,
+      Field_Parent,
+      --  Iir_Kind_Entity_Aspect_Entity
+      Field_Entity_Name,
+      Field_Architecture,
+      --  Iir_Kind_Entity_Aspect_Configuration
+      Field_Configuration_Name,
+      --  Iir_Kind_Entity_Aspect_Open
+      --  Iir_Kind_Block_Configuration
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Configuration_Item_Chain,
+      Field_Block_Specification,
+      Field_Parent,
+      Field_Prev_Block_Configuration,
+      --  Iir_Kind_Block_Header
+      Field_Generic_Chain,
+      Field_Port_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Port_Map_Aspect_Chain,
+      --  Iir_Kind_Component_Configuration
+      Field_Instantiation_List,
+      Field_Chain,
+      Field_Binding_Indication,
+      Field_Component_Name,
+      Field_Block_Configuration,
+      Field_Parent,
+      --  Iir_Kind_Binding_Indication
+      Field_Default_Entity_Aspect,
+      Field_Entity_Aspect,
+      Field_Default_Generic_Map_Aspect_Chain,
+      Field_Default_Port_Map_Aspect_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Port_Map_Aspect_Chain,
+      --  Iir_Kind_Entity_Class
+      Field_Entity_Class,
+      Field_Chain,
+      --  Iir_Kind_Attribute_Value
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Spec_Chain,
+      Field_Chain,
+      Field_Type,
+      Field_Designated_Entity,
+      Field_Attribute_Specification,
+      Field_Base_Name,
+      --  Iir_Kind_Signature
+      Field_Type_Marks_List,
+      Field_Return_Type_Mark,
+      Field_Signature_Prefix,
+      --  Iir_Kind_Aggregate_Info
+      Field_Aggr_Min_Length,
+      Field_Aggr_Others_Flag,
+      Field_Aggr_Dynamic_Flag,
+      Field_Aggr_Named_Flag,
+      Field_Sub_Aggregate_Info,
+      Field_Aggr_Low_Limit,
+      Field_Aggr_High_Limit,
+      --  Iir_Kind_Procedure_Call
+      Field_Prefix,
+      Field_Parameter_Association_Chain,
+      Field_Method_Object,
+      Field_Implementation,
+      --  Iir_Kind_Record_Element_Constraint
+      Field_Identifier,
+      Field_Element_Position,
+      Field_Visible_Flag,
+      Field_Element_Declaration,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Array_Element_Resolution
+      Field_Resolution_Indication,
+      --  Iir_Kind_Record_Resolution
+      Field_Record_Element_Resolution_Chain,
+      --  Iir_Kind_Record_Element_Resolution
+      Field_Identifier,
+      Field_Chain,
+      Field_Resolution_Indication,
+      --  Iir_Kind_Attribute_Specification
+      Field_Entity_Class,
+      Field_Entity_Name_List,
+      Field_Chain,
+      Field_Attribute_Value_Spec_Chain,
+      Field_Expression,
+      Field_Attribute_Designator,
+      Field_Attribute_Specification_Chain,
+      Field_Parent,
+      --  Iir_Kind_Disconnection_Specification
+      Field_Chain,
+      Field_Signal_List,
+      Field_Type_Mark,
+      Field_Expression,
+      Field_Parent,
+      --  Iir_Kind_Configuration_Specification
+      Field_Instantiation_List,
+      Field_Chain,
+      Field_Binding_Indication,
+      Field_Component_Name,
+      Field_Parent,
+      --  Iir_Kind_Access_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Type_Staticness,
+      Field_Designated_Subtype_Indication,
+      Field_Designated_Type,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Incomplete_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Incomplete_Type_List,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_File_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Text_File_Flag,
+      Field_Type_Staticness,
+      Field_File_Type_Mark,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Protected_Type_Declaration
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Type_Staticness,
+      Field_Declaration_Chain,
+      Field_Protected_Type_Body,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Record_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Type_Staticness,
+      Field_Constraint_State,
+      Field_Elements_Declaration_List,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Array_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Index_Constraint_Flag,
+      Field_Type_Staticness,
+      Field_Constraint_State,
+      Field_Element_Subtype_Indication,
+      Field_Index_Subtype_Definition_List,
+      Field_Element_Subtype,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      Field_Index_Subtype_List,
+      --  Iir_Kind_Array_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Index_Constraint_Flag,
+      Field_Type_Staticness,
+      Field_Constraint_State,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Index_Constraint_List,
+      Field_Tolerance,
+      Field_Array_Element_Constraint,
+      Field_Element_Subtype,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      Field_Index_Subtype_List,
+      --  Iir_Kind_Record_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Constraint_State,
+      Field_Elements_Declaration_List,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Tolerance,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Access_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Type_Staticness,
+      Field_Subtype_Type_Mark,
+      Field_Designated_Subtype_Indication,
+      Field_Designated_Type,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Physical_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Range_Constraint,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Floating_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Range_Constraint,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Tolerance,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Integer_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Range_Constraint,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Enumeration_Subtype_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Range_Constraint,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Enumeration_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Only_Characters_Flag,
+      Field_Type_Staticness,
+      Field_Range_Constraint,
+      Field_Enumeration_Literal_List,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Integer_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Floating_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Type_Staticness,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Physical_Type_Definition
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Type_Staticness,
+      Field_Unit_Chain,
+      Field_Type_Declarator,
+      Field_Base_Type,
+      --  Iir_Kind_Range_Expression
+      Field_Expr_Staticness,
+      Field_Direction,
+      Field_Left_Limit,
+      Field_Right_Limit,
+      Field_Range_Origin,
+      Field_Type,
+      --  Iir_Kind_Protected_Type_Body
+      Field_Identifier,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Protected_Type_Declaration,
+      Field_Parent,
+      --  Iir_Kind_Subtype_Definition
+      Field_Range_Constraint,
+      Field_Subtype_Type_Mark,
+      Field_Resolution_Indication,
+      Field_Tolerance,
+      --  Iir_Kind_Scalar_Nature_Definition
+      Field_Reference,
+      Field_Nature_Declarator,
+      Field_Across_Type,
+      Field_Through_Type,
+      --  Iir_Kind_Overload_List
+      Field_Overload_List,
+      --  Iir_Kind_Type_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Type_Definition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_Anonymous_Type_Declaration
+      Field_Identifier,
+      Field_Type_Definition,
+      Field_Chain,
+      Field_Subtype_Definition,
+      Field_Parent,
+      --  Iir_Kind_Subtype_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Nature_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Nature,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_Subnature_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Nature,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_Package_Declaration
+      Field_Identifier,
+      Field_Need_Body,
+      Field_Visible_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Package_Header,
+      Field_Parent,
+      Field_Package_Body,
+      --  Iir_Kind_Package_Instantiation_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Uninstantiated_Package_Name,
+      Field_Generic_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Parent,
+      Field_Package_Body,
+      --  Iir_Kind_Package_Body
+      Field_Identifier,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Parent,
+      Field_Package,
+      --  Iir_Kind_Configuration_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Entity_Name,
+      Field_Attribute_Value_Chain,
+      Field_Block_Configuration,
+      Field_Parent,
+      --  Iir_Kind_Entity_Declaration
+      Field_Identifier,
+      Field_Has_Begin,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Concurrent_Statement_Chain,
+      Field_Generic_Chain,
+      Field_Port_Chain,
+      Field_Parent,
+      --  Iir_Kind_Architecture_Body
+      Field_Identifier,
+      Field_Foreign_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Entity_Name,
+      Field_Attribute_Value_Chain,
+      Field_Concurrent_Statement_Chain,
+      Field_Default_Configuration_Declaration,
+      Field_Parent,
+      --  Iir_Kind_Package_Header
+      Field_Generic_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      --  Iir_Kind_Unit_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Physical_Literal,
+      Field_Physical_Unit_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Library_Declaration
+      Field_Date,
+      Field_Library_Directory,
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Design_File_Chain,
+      Field_Chain,
+      --  Iir_Kind_Component_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Has_Is,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Generic_Chain,
+      Field_Port_Chain,
+      Field_Parent,
+      --  Iir_Kind_Attribute_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Chain,
+      Field_Type_Mark,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Group_Template_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Entity_Class_Entry_Chain,
+      Field_Chain,
+      Field_Parent,
+      --  Iir_Kind_Group_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Group_Constituent_List,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Group_Template_Name,
+      Field_Parent,
+      --  Iir_Kind_Element_Declaration
+      Field_Identifier,
+      Field_Element_Position,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_Is_Ref,
+      Field_Subtype_Indication,
+      Field_Type,
+      --  Iir_Kind_Non_Object_Alias_Declaration
+      Field_Identifier,
+      Field_Implicit_Alias_Flag,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Chain,
+      Field_Name,
+      Field_Alias_Signature,
+      Field_Parent,
+      --  Iir_Kind_Psl_Declaration
+      Field_Psl_Declaration,
+      Field_Identifier,
+      Field_PSL_Clock,
+      Field_PSL_NFA,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Chain,
+      Field_Parent,
+      --  Iir_Kind_Terminal_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Nature,
+      Field_Chain,
+      Field_Parent,
+      --  Iir_Kind_Free_Quantity_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Across_Quantity_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Tolerance,
+      Field_Plus_Terminal,
+      Field_Minus_Terminal,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Through_Quantity_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Tolerance,
+      Field_Plus_Terminal,
+      Field_Minus_Terminal,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Enumeration_Literal
+      Field_Enum_Pos,
+      Field_Subprogram_Hash,
+      Field_Identifier,
+      Field_Seen_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Literal_Origin,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      Field_Type,
+      Field_Enumeration_Decl,
+      --  Iir_Kind_Function_Declaration
+      Field_Subprogram_Depth,
+      Field_Subprogram_Hash,
+      Field_Overload_Number,
+      Field_Identifier,
+      Field_Seen_Flag,
+      Field_Pure_Flag,
+      Field_Foreign_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Use_Flag,
+      Field_Resolution_Function_Flag,
+      Field_Has_Pure,
+      Field_Has_Body,
+      Field_Wait_State,
+      Field_All_Sensitized_State,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Interface_Declaration_Chain,
+      Field_Generic_Chain,
+      Field_Return_Type_Mark,
+      Field_Parent,
+      Field_Return_Type,
+      Field_Subprogram_Body,
+      --  Iir_Kind_Implicit_Function_Declaration
+      Field_Subprogram_Hash,
+      Field_Overload_Number,
+      Field_Identifier,
+      Field_Implicit_Definition,
+      Field_Seen_Flag,
+      Field_Pure_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Use_Flag,
+      Field_Wait_State,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Interface_Declaration_Chain,
+      Field_Generic_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Parent,
+      Field_Return_Type,
+      Field_Type_Reference,
+      --  Iir_Kind_Implicit_Procedure_Declaration
+      Field_Subprogram_Hash,
+      Field_Overload_Number,
+      Field_Identifier,
+      Field_Implicit_Definition,
+      Field_Seen_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Use_Flag,
+      Field_Wait_State,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Interface_Declaration_Chain,
+      Field_Generic_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Parent,
+      Field_Type_Reference,
+      --  Iir_Kind_Procedure_Declaration
+      Field_Subprogram_Depth,
+      Field_Subprogram_Hash,
+      Field_Overload_Number,
+      Field_Identifier,
+      Field_Seen_Flag,
+      Field_Passive_Flag,
+      Field_Foreign_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Use_Flag,
+      Field_Has_Body,
+      Field_Wait_State,
+      Field_Purity_State,
+      Field_All_Sensitized_State,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Interface_Declaration_Chain,
+      Field_Generic_Chain,
+      Field_Return_Type_Mark,
+      Field_Parent,
+      Field_Subprogram_Body,
+      --  Iir_Kind_Function_Body
+      Field_Impure_Depth,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Parent,
+      Field_Subprogram_Specification,
+      Field_Callees_List,
+      --  Iir_Kind_Procedure_Body
+      Field_Impure_Depth,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Parent,
+      Field_Subprogram_Specification,
+      Field_Callees_List,
+      --  Iir_Kind_Object_Alias_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Name,
+      Field_Subtype_Indication,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_File_Declaration
+      Field_Identifier,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Has_Mode,
+      Field_Mode,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_File_Logical_Name,
+      Field_File_Open_Kind,
+      Field_Subtype_Indication,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Guard_Signal_Declaration
+      Field_Identifier,
+      Field_Has_Active_Flag,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Signal_Kind,
+      Field_Guard_Expression,
+      Field_Attribute_Value_Chain,
+      Field_Guard_Sensitivity_List,
+      Field_Block_Statement,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Signal_Declaration
+      Field_Identifier,
+      Field_Has_Disconnect_Flag,
+      Field_Has_Active_Flag,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Signal_Kind,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Signal_Driver,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Variable_Declaration
+      Field_Identifier,
+      Field_Shared_Flag,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Constant_Declaration
+      Field_Identifier,
+      Field_Deferred_Declaration_Flag,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Deferred_Declaration,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Iterator_Declaration
+      Field_Identifier,
+      Field_Has_Identifier_List,
+      Field_Visible_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Discrete_Range,
+      Field_Subtype_Indication,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Interface_Constant_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Mode,
+      Field_Lexical_Layout,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Interface_Variable_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Mode,
+      Field_Lexical_Layout,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Interface_Signal_Declaration
+      Field_Identifier,
+      Field_Has_Disconnect_Flag,
+      Field_Has_Active_Flag,
+      Field_Open_Flag,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Mode,
+      Field_Lexical_Layout,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Signal_Kind,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Interface_File_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_After_Drivers_Flag,
+      Field_Use_Flag,
+      Field_Is_Ref,
+      Field_Mode,
+      Field_Lexical_Layout,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Subtype_Indication,
+      Field_Default_Value,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_Interface_Package_Declaration
+      Field_Identifier,
+      Field_Visible_Flag,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Uninstantiated_Package_Name,
+      Field_Generic_Chain,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Parent,
+      --  Iir_Kind_Identity_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Negation_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Absolute_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Not_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Condition_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_And_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_Or_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_Nand_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_Nor_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_Xor_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Reduction_Xnor_Operator
+      Field_Expr_Staticness,
+      Field_Operand,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_And_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Or_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Nand_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Nor_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Xor_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Xnor_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Equality_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Inequality_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Less_Than_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Less_Than_Or_Equal_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Greater_Than_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Greater_Than_Or_Equal_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Equality_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Inequality_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Less_Than_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Less_Than_Or_Equal_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Greater_Than_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Sll_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Sla_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Srl_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Sra_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Rol_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Ror_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Addition_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Substraction_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Concatenation_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Multiplication_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Division_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Modulus_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Remainder_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Exponentiation_Operator
+      Field_Expr_Staticness,
+      Field_Left,
+      Field_Right,
+      Field_Type,
+      Field_Implementation,
+      --  Iir_Kind_Function_Call
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter_Association_Chain,
+      Field_Method_Object,
+      Field_Type,
+      Field_Implementation,
+      Field_Base_Name,
+      --  Iir_Kind_Aggregate
+      Field_Expr_Staticness,
+      Field_Value_Staticness,
+      Field_Aggregate_Info,
+      Field_Association_Choices_Chain,
+      Field_Literal_Subtype,
+      Field_Type,
+      --  Iir_Kind_Parenthesis_Expression
+      Field_Expr_Staticness,
+      Field_Expression,
+      Field_Type,
+      --  Iir_Kind_Qualified_Expression
+      Field_Expr_Staticness,
+      Field_Type_Mark,
+      Field_Expression,
+      Field_Type,
+      --  Iir_Kind_Type_Conversion
+      Field_Expr_Staticness,
+      Field_Type_Conversion_Subtype,
+      Field_Type_Mark,
+      Field_Expression,
+      Field_Type,
+      --  Iir_Kind_Allocator_By_Expression
+      Field_Expr_Staticness,
+      Field_Expression,
+      Field_Type,
+      Field_Allocator_Designated_Type,
+      --  Iir_Kind_Allocator_By_Subtype
+      Field_Expr_Staticness,
+      Field_Subtype_Indication,
+      Field_Type,
+      Field_Allocator_Designated_Type,
+      --  Iir_Kind_Selected_Element
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Selected_Element,
+      Field_Base_Name,
+      --  Iir_Kind_Dereference
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Implicit_Dereference
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Slice_Name
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Suffix,
+      Field_Slice_Subtype,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Indexed_Name
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_List,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Psl_Expression
+      Field_Psl_Expression,
+      Field_Type,
+      --  Iir_Kind_Sensitized_Process_Statement
+      Field_Label,
+      Field_Seen_Flag,
+      Field_End_Has_Postponed,
+      Field_Passive_Flag,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Has_Is,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Wait_State,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Sensitivity_List,
+      Field_Process_Origin,
+      Field_Parent,
+      Field_Callees_List,
+      --  Iir_Kind_Process_Statement
+      Field_Label,
+      Field_Seen_Flag,
+      Field_End_Has_Postponed,
+      Field_Passive_Flag,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_Has_Is,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Wait_State,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Process_Origin,
+      Field_Parent,
+      Field_Callees_List,
+      --  Iir_Kind_Concurrent_Conditional_Signal_Assignment
+      Field_Delay_Mechanism,
+      Field_Label,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Guarded_Target_State,
+      Field_Target,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Reject_Time_Expression,
+      Field_Conditional_Waveform_Chain,
+      Field_Guard,
+      Field_Parent,
+      --  Iir_Kind_Concurrent_Selected_Signal_Assignment
+      Field_Delay_Mechanism,
+      Field_Label,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Guarded_Target_State,
+      Field_Target,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Expression,
+      Field_Reject_Time_Expression,
+      Field_Selected_Waveform_Chain,
+      Field_Guard,
+      Field_Parent,
+      --  Iir_Kind_Concurrent_Assertion_Statement
+      Field_Label,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Assertion_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Severity_Expression,
+      Field_Report_Expression,
+      Field_Parent,
+      --  Iir_Kind_Psl_Default_Clock
+      Field_Psl_Boolean,
+      Field_Label,
+      Field_Chain,
+      Field_Parent,
+      --  Iir_Kind_Psl_Assert_Statement
+      Field_Psl_Property,
+      Field_Label,
+      Field_PSL_Clock,
+      Field_PSL_NFA,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Severity_Expression,
+      Field_Report_Expression,
+      Field_Parent,
+      --  Iir_Kind_Psl_Cover_Statement
+      Field_Psl_Property,
+      Field_Label,
+      Field_PSL_Clock,
+      Field_PSL_NFA,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Severity_Expression,
+      Field_Report_Expression,
+      Field_Parent,
+      --  Iir_Kind_Concurrent_Procedure_Call_Statement
+      Field_Label,
+      Field_Postponed_Flag,
+      Field_Visible_Flag,
+      Field_Procedure_Call,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_Block_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Concurrent_Statement_Chain,
+      Field_Block_Block_Configuration,
+      Field_Block_Header,
+      Field_Guard_Decl,
+      Field_Parent,
+      --  Iir_Kind_Generate_Statement
+      Field_Label,
+      Field_Has_Begin,
+      Field_Visible_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Declaration_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Concurrent_Statement_Chain,
+      Field_Generation_Scheme,
+      Field_Generate_Block_Configuration,
+      Field_Parent,
+      --  Iir_Kind_Component_Instantiation_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Instantiated_Unit,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Default_Binding_Indication,
+      Field_Component_Configuration,
+      Field_Configuration_Specification,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Port_Map_Aspect_Chain,
+      Field_Parent,
+      --  Iir_Kind_Simple_Simultaneous_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Simultaneous_Left,
+      Field_Simultaneous_Right,
+      Field_Tolerance,
+      Field_Parent,
+      --  Iir_Kind_Signal_Assignment_Statement
+      Field_Delay_Mechanism,
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Guarded_Target_State,
+      Field_Target,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Waveform_Chain,
+      Field_Reject_Time_Expression,
+      Field_Parent,
+      --  Iir_Kind_Null_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_Assertion_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Assertion_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Severity_Expression,
+      Field_Report_Expression,
+      Field_Parent,
+      --  Iir_Kind_Report_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Severity_Expression,
+      Field_Report_Expression,
+      Field_Parent,
+      --  Iir_Kind_Wait_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Timeout_Clause,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Condition_Clause,
+      Field_Sensitivity_List,
+      Field_Parent,
+      --  Iir_Kind_Variable_Assignment_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Target,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Expression,
+      Field_Parent,
+      --  Iir_Kind_Return_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Expression,
+      Field_Parent,
+      Field_Type,
+      --  Iir_Kind_For_Loop_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_End_Has_Identifier,
+      Field_Parameter_Specification,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Parent,
+      --  Iir_Kind_While_Loop_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_End_Has_Identifier,
+      Field_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Parent,
+      --  Iir_Kind_Next_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Loop_Label,
+      Field_Parent,
+      --  Iir_Kind_Exit_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Loop_Label,
+      Field_Parent,
+      --  Iir_Kind_Case_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_End_Has_Identifier,
+      Field_Case_Statement_Alternative_Chain,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Expression,
+      Field_Parent,
+      --  Iir_Kind_Procedure_Call_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Procedure_Call,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Parent,
+      --  Iir_Kind_If_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_End_Has_Identifier,
+      Field_Condition,
+      Field_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Sequential_Statement_Chain,
+      Field_Else_Clause,
+      Field_Parent,
+      --  Iir_Kind_Elsif
+      Field_End_Has_Identifier,
+      Field_Condition,
+      Field_Sequential_Statement_Chain,
+      Field_Else_Clause,
+      Field_Parent,
+      --  Iir_Kind_Character_Literal
+      Field_Identifier,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Alias_Declaration,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name,
+      --  Iir_Kind_Simple_Name
+      Field_Identifier,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Alias_Declaration,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name,
+      --  Iir_Kind_Selected_Name
+      Field_Identifier,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Alias_Declaration,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name,
+      --  Iir_Kind_Operator_Symbol
+      Field_Identifier,
+      Field_Alias_Declaration,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name,
+      --  Iir_Kind_Selected_By_All_Name
+      Field_Expr_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name,
+      --  Iir_Kind_Parenthesis_Name
+      Field_Prefix,
+      Field_Association_Chain,
+      Field_Type,
+      Field_Named_Entity,
+      --  Iir_Kind_Base_Attribute
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Left_Type_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Right_Type_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_High_Type_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Low_Type_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Ascending_Type_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Image_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Value_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Pos_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Val_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Succ_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Pred_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Leftof_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Rightof_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Delayed_Attribute
+      Field_Has_Active_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Chain,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Stable_Attribute
+      Field_Has_Active_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Chain,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Quiet_Attribute
+      Field_Has_Active_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Chain,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Transaction_Attribute
+      Field_Has_Active_Flag,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Chain,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Event_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Active_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Last_Event_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Last_Active_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Last_Value_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Driving_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Driving_Value_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      --  Iir_Kind_Behavior_Attribute
+      --  Iir_Kind_Structure_Attribute
+      --  Iir_Kind_Simple_Name_Attribute
+      Field_Simple_Name_Identifier,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Simple_Name_Subtype,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Instance_Name_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Path_Name_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Left_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Right_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_High_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Low_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Length_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Ascending_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Range_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Reverse_Range_Array_Attribute
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Type,
+      Field_Base_Name,
+      --  Iir_Kind_Attribute_Name
+      Field_Identifier,
+      Field_Expr_Staticness,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Attribute_Signature,
+      Field_Type,
+      Field_Named_Entity,
+      Field_Base_Name
+     );
+
+   Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer :=
+     (
+      Iir_Kind_Unused => -1,
+      Iir_Kind_Error => 7,
+      Iir_Kind_Design_File => 17,
+      Iir_Kind_Design_Unit => 32,
+      Iir_Kind_Library_Clause => 37,
+      Iir_Kind_Use_Clause => 41,
+      Iir_Kind_Integer_Literal => 45,
+      Iir_Kind_Floating_Point_Literal => 49,
+      Iir_Kind_Null_Literal => 51,
+      Iir_Kind_String_Literal => 57,
+      Iir_Kind_Physical_Int_Literal => 62,
+      Iir_Kind_Physical_Fp_Literal => 67,
+      Iir_Kind_Bit_String_Literal => 76,
+      Iir_Kind_Simple_Aggregate => 81,
+      Iir_Kind_Overflow_Literal => 84,
+      Iir_Kind_Waveform_Element => 87,
+      Iir_Kind_Conditional_Waveform => 90,
+      Iir_Kind_Association_Element_By_Expression => 97,
+      Iir_Kind_Association_Element_By_Individual => 103,
+      Iir_Kind_Association_Element_Open => 108,
+      Iir_Kind_Association_Element_Package => 114,
+      Iir_Kind_Choice_By_Others => 119,
+      Iir_Kind_Choice_By_Expression => 126,
+      Iir_Kind_Choice_By_Range => 133,
+      Iir_Kind_Choice_By_None => 138,
+      Iir_Kind_Choice_By_Name => 144,
+      Iir_Kind_Entity_Aspect_Entity => 146,
+      Iir_Kind_Entity_Aspect_Configuration => 147,
+      Iir_Kind_Entity_Aspect_Open => 147,
+      Iir_Kind_Block_Configuration => 153,
+      Iir_Kind_Block_Header => 157,
+      Iir_Kind_Component_Configuration => 163,
+      Iir_Kind_Binding_Indication => 169,
+      Iir_Kind_Entity_Class => 171,
+      Iir_Kind_Attribute_Value => 179,
+      Iir_Kind_Signature => 182,
+      Iir_Kind_Aggregate_Info => 189,
+      Iir_Kind_Procedure_Call => 193,
+      Iir_Kind_Record_Element_Constraint => 199,
+      Iir_Kind_Array_Element_Resolution => 200,
+      Iir_Kind_Record_Resolution => 201,
+      Iir_Kind_Record_Element_Resolution => 204,
+      Iir_Kind_Attribute_Specification => 212,
+      Iir_Kind_Disconnection_Specification => 217,
+      Iir_Kind_Configuration_Specification => 222,
+      Iir_Kind_Access_Type_Definition => 229,
+      Iir_Kind_Incomplete_Type_Definition => 236,
+      Iir_Kind_File_Type_Definition => 243,
+      Iir_Kind_Protected_Type_Declaration => 252,
+      Iir_Kind_Record_Type_Definition => 262,
+      Iir_Kind_Array_Type_Definition => 274,
+      Iir_Kind_Array_Subtype_Definition => 289,
+      Iir_Kind_Record_Subtype_Definition => 300,
+      Iir_Kind_Access_Subtype_Definition => 308,
+      Iir_Kind_Physical_Subtype_Definition => 317,
+      Iir_Kind_Floating_Subtype_Definition => 327,
+      Iir_Kind_Integer_Subtype_Definition => 336,
+      Iir_Kind_Enumeration_Subtype_Definition => 345,
+      Iir_Kind_Enumeration_Type_Definition => 354,
+      Iir_Kind_Integer_Type_Definition => 360,
+      Iir_Kind_Floating_Type_Definition => 366,
+      Iir_Kind_Physical_Type_Definition => 375,
+      Iir_Kind_Range_Expression => 381,
+      Iir_Kind_Protected_Type_Body => 388,
+      Iir_Kind_Subtype_Definition => 392,
+      Iir_Kind_Scalar_Nature_Definition => 396,
+      Iir_Kind_Overload_List => 397,
+      Iir_Kind_Type_Declaration => 404,
+      Iir_Kind_Anonymous_Type_Declaration => 409,
+      Iir_Kind_Subtype_Declaration => 418,
+      Iir_Kind_Nature_Declaration => 425,
+      Iir_Kind_Subnature_Declaration => 432,
+      Iir_Kind_Package_Declaration => 442,
+      Iir_Kind_Package_Instantiation_Declaration => 453,
+      Iir_Kind_Package_Body => 459,
+      Iir_Kind_Configuration_Declaration => 468,
+      Iir_Kind_Entity_Declaration => 480,
+      Iir_Kind_Architecture_Body => 492,
+      Iir_Kind_Package_Header => 494,
+      Iir_Kind_Unit_Declaration => 504,
+      Iir_Kind_Library_Declaration => 510,
+      Iir_Kind_Component_Declaration => 521,
+      Iir_Kind_Attribute_Declaration => 528,
+      Iir_Kind_Group_Template_Declaration => 534,
+      Iir_Kind_Group_Declaration => 542,
+      Iir_Kind_Element_Declaration => 549,
+      Iir_Kind_Non_Object_Alias_Declaration => 557,
+      Iir_Kind_Psl_Declaration => 565,
+      Iir_Kind_Terminal_Declaration => 571,
+      Iir_Kind_Free_Quantity_Declaration => 581,
+      Iir_Kind_Across_Quantity_Declaration => 594,
+      Iir_Kind_Through_Quantity_Declaration => 607,
+      Iir_Kind_Enumeration_Literal => 620,
+      Iir_Kind_Function_Declaration => 643,
+      Iir_Kind_Implicit_Function_Declaration => 661,
+      Iir_Kind_Implicit_Procedure_Declaration => 677,
+      Iir_Kind_Procedure_Declaration => 698,
+      Iir_Kind_Function_Body => 707,
+      Iir_Kind_Procedure_Body => 716,
+      Iir_Kind_Object_Alias_Declaration => 728,
+      Iir_Kind_File_Declaration => 744,
+      Iir_Kind_Guard_Signal_Declaration => 757,
+      Iir_Kind_Signal_Declaration => 775,
+      Iir_Kind_Variable_Declaration => 789,
+      Iir_Kind_Constant_Declaration => 804,
+      Iir_Kind_Iterator_Declaration => 817,
+      Iir_Kind_Interface_Constant_Declaration => 832,
+      Iir_Kind_Interface_Variable_Declaration => 847,
+      Iir_Kind_Interface_Signal_Declaration => 866,
+      Iir_Kind_Interface_File_Declaration => 881,
+      Iir_Kind_Interface_Package_Declaration => 890,
+      Iir_Kind_Identity_Operator => 894,
+      Iir_Kind_Negation_Operator => 898,
+      Iir_Kind_Absolute_Operator => 902,
+      Iir_Kind_Not_Operator => 906,
+      Iir_Kind_Condition_Operator => 910,
+      Iir_Kind_Reduction_And_Operator => 914,
+      Iir_Kind_Reduction_Or_Operator => 918,
+      Iir_Kind_Reduction_Nand_Operator => 922,
+      Iir_Kind_Reduction_Nor_Operator => 926,
+      Iir_Kind_Reduction_Xor_Operator => 930,
+      Iir_Kind_Reduction_Xnor_Operator => 934,
+      Iir_Kind_And_Operator => 939,
+      Iir_Kind_Or_Operator => 944,
+      Iir_Kind_Nand_Operator => 949,
+      Iir_Kind_Nor_Operator => 954,
+      Iir_Kind_Xor_Operator => 959,
+      Iir_Kind_Xnor_Operator => 964,
+      Iir_Kind_Equality_Operator => 969,
+      Iir_Kind_Inequality_Operator => 974,
+      Iir_Kind_Less_Than_Operator => 979,
+      Iir_Kind_Less_Than_Or_Equal_Operator => 984,
+      Iir_Kind_Greater_Than_Operator => 989,
+      Iir_Kind_Greater_Than_Or_Equal_Operator => 994,
+      Iir_Kind_Match_Equality_Operator => 999,
+      Iir_Kind_Match_Inequality_Operator => 1004,
+      Iir_Kind_Match_Less_Than_Operator => 1009,
+      Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1014,
+      Iir_Kind_Match_Greater_Than_Operator => 1019,
+      Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1024,
+      Iir_Kind_Sll_Operator => 1029,
+      Iir_Kind_Sla_Operator => 1034,
+      Iir_Kind_Srl_Operator => 1039,
+      Iir_Kind_Sra_Operator => 1044,
+      Iir_Kind_Rol_Operator => 1049,
+      Iir_Kind_Ror_Operator => 1054,
+      Iir_Kind_Addition_Operator => 1059,
+      Iir_Kind_Substraction_Operator => 1064,
+      Iir_Kind_Concatenation_Operator => 1069,
+      Iir_Kind_Multiplication_Operator => 1074,
+      Iir_Kind_Division_Operator => 1079,
+      Iir_Kind_Modulus_Operator => 1084,
+      Iir_Kind_Remainder_Operator => 1089,
+      Iir_Kind_Exponentiation_Operator => 1094,
+      Iir_Kind_Function_Call => 1102,
+      Iir_Kind_Aggregate => 1108,
+      Iir_Kind_Parenthesis_Expression => 1111,
+      Iir_Kind_Qualified_Expression => 1115,
+      Iir_Kind_Type_Conversion => 1120,
+      Iir_Kind_Allocator_By_Expression => 1124,
+      Iir_Kind_Allocator_By_Subtype => 1128,
+      Iir_Kind_Selected_Element => 1134,
+      Iir_Kind_Dereference => 1139,
+      Iir_Kind_Implicit_Dereference => 1144,
+      Iir_Kind_Slice_Name => 1151,
+      Iir_Kind_Indexed_Name => 1157,
+      Iir_Kind_Psl_Expression => 1159,
+      Iir_Kind_Sensitized_Process_Statement => 1178,
+      Iir_Kind_Process_Statement => 1196,
+      Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1208,
+      Iir_Kind_Concurrent_Selected_Signal_Assignment => 1221,
+      Iir_Kind_Concurrent_Assertion_Statement => 1230,
+      Iir_Kind_Psl_Default_Clock => 1234,
+      Iir_Kind_Psl_Assert_Statement => 1244,
+      Iir_Kind_Psl_Cover_Statement => 1254,
+      Iir_Kind_Concurrent_Procedure_Call_Statement => 1261,
+      Iir_Kind_Block_Statement => 1274,
+      Iir_Kind_Generate_Statement => 1286,
+      Iir_Kind_Component_Instantiation_Statement => 1297,
+      Iir_Kind_Simple_Simultaneous_Statement => 1305,
+      Iir_Kind_Signal_Assignment_Statement => 1315,
+      Iir_Kind_Null_Statement => 1320,
+      Iir_Kind_Assertion_Statement => 1328,
+      Iir_Kind_Report_Statement => 1335,
+      Iir_Kind_Wait_Statement => 1343,
+      Iir_Kind_Variable_Assignment_Statement => 1350,
+      Iir_Kind_Return_Statement => 1357,
+      Iir_Kind_For_Loop_Statement => 1366,
+      Iir_Kind_While_Loop_Statement => 1374,
+      Iir_Kind_Next_Statement => 1381,
+      Iir_Kind_Exit_Statement => 1388,
+      Iir_Kind_Case_Statement => 1396,
+      Iir_Kind_Procedure_Call_Statement => 1402,
+      Iir_Kind_If_Statement => 1411,
+      Iir_Kind_Elsif => 1416,
+      Iir_Kind_Character_Literal => 1423,
+      Iir_Kind_Simple_Name => 1430,
+      Iir_Kind_Selected_Name => 1438,
+      Iir_Kind_Operator_Symbol => 1443,
+      Iir_Kind_Selected_By_All_Name => 1448,
+      Iir_Kind_Parenthesis_Name => 1452,
+      Iir_Kind_Base_Attribute => 1454,
+      Iir_Kind_Left_Type_Attribute => 1459,
+      Iir_Kind_Right_Type_Attribute => 1464,
+      Iir_Kind_High_Type_Attribute => 1469,
+      Iir_Kind_Low_Type_Attribute => 1474,
+      Iir_Kind_Ascending_Type_Attribute => 1479,
+      Iir_Kind_Image_Attribute => 1485,
+      Iir_Kind_Value_Attribute => 1491,
+      Iir_Kind_Pos_Attribute => 1497,
+      Iir_Kind_Val_Attribute => 1503,
+      Iir_Kind_Succ_Attribute => 1509,
+      Iir_Kind_Pred_Attribute => 1515,
+      Iir_Kind_Leftof_Attribute => 1521,
+      Iir_Kind_Rightof_Attribute => 1527,
+      Iir_Kind_Delayed_Attribute => 1535,
+      Iir_Kind_Stable_Attribute => 1543,
+      Iir_Kind_Quiet_Attribute => 1551,
+      Iir_Kind_Transaction_Attribute => 1559,
+      Iir_Kind_Event_Attribute => 1563,
+      Iir_Kind_Active_Attribute => 1567,
+      Iir_Kind_Last_Event_Attribute => 1571,
+      Iir_Kind_Last_Active_Attribute => 1575,
+      Iir_Kind_Last_Value_Attribute => 1579,
+      Iir_Kind_Driving_Attribute => 1583,
+      Iir_Kind_Driving_Value_Attribute => 1587,
+      Iir_Kind_Behavior_Attribute => 1587,
+      Iir_Kind_Structure_Attribute => 1587,
+      Iir_Kind_Simple_Name_Attribute => 1594,
+      Iir_Kind_Instance_Name_Attribute => 1599,
+      Iir_Kind_Path_Name_Attribute => 1604,
+      Iir_Kind_Left_Array_Attribute => 1611,
+      Iir_Kind_Right_Array_Attribute => 1618,
+      Iir_Kind_High_Array_Attribute => 1625,
+      Iir_Kind_Low_Array_Attribute => 1632,
+      Iir_Kind_Length_Array_Attribute => 1639,
+      Iir_Kind_Ascending_Array_Attribute => 1646,
+      Iir_Kind_Range_Array_Attribute => 1653,
+      Iir_Kind_Reverse_Range_Array_Attribute => 1660,
+      Iir_Kind_Attribute_Name => 1668
+     );
+
+   function Get_Fields (K : Iir_Kind) return Fields_Array
+   is
+      First : Natural;
+      Last : Integer;
+   begin
+      if K = Iir_Kind'First then
+         First := Fields_Of_Iir'First;
+      else
+         First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1;
+      end if;
+      Last := Fields_Of_Iir_Last (K);
+      return Fields_Of_Iir (First .. Last);
+   end Get_Fields;
+
+   function Get_Base_Type
+      (N : Iir; F : Fields_Enum) return Base_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Base_Type);
+      case F is
+         when Field_Bit_String_Base =>
+            return Get_Bit_String_Base (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Base_Type;
+
+   procedure Set_Base_Type
+      (N : Iir; F : Fields_Enum; V: Base_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Base_Type);
+      case F is
+         when Field_Bit_String_Base =>
+            Set_Bit_String_Base (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Base_Type;
+
+   function Get_Boolean
+      (N : Iir; F : Fields_Enum) return Boolean is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Boolean);
+      case F is
+         when Field_Whole_Association_Flag =>
+            return Get_Whole_Association_Flag (N);
+         when Field_Collapse_Signal_Flag =>
+            return Get_Collapse_Signal_Flag (N);
+         when Field_Artificial_Flag =>
+            return Get_Artificial_Flag (N);
+         when Field_Open_Flag =>
+            return Get_Open_Flag (N);
+         when Field_After_Drivers_Flag =>
+            return Get_After_Drivers_Flag (N);
+         when Field_Same_Alternative_Flag =>
+            return Get_Same_Alternative_Flag (N);
+         when Field_Need_Body =>
+            return Get_Need_Body (N);
+         when Field_Deferred_Declaration_Flag =>
+            return Get_Deferred_Declaration_Flag (N);
+         when Field_Shared_Flag =>
+            return Get_Shared_Flag (N);
+         when Field_Visible_Flag =>
+            return Get_Visible_Flag (N);
+         when Field_Text_File_Flag =>
+            return Get_Text_File_Flag (N);
+         when Field_Only_Characters_Flag =>
+            return Get_Only_Characters_Flag (N);
+         when Field_Postponed_Flag =>
+            return Get_Postponed_Flag (N);
+         when Field_Passive_Flag =>
+            return Get_Passive_Flag (N);
+         when Field_Resolution_Function_Flag =>
+            return Get_Resolution_Function_Flag (N);
+         when Field_Seen_Flag =>
+            return Get_Seen_Flag (N);
+         when Field_Pure_Flag =>
+            return Get_Pure_Flag (N);
+         when Field_Foreign_Flag =>
+            return Get_Foreign_Flag (N);
+         when Field_Resolved_Flag =>
+            return Get_Resolved_Flag (N);
+         when Field_Signal_Type_Flag =>
+            return Get_Signal_Type_Flag (N);
+         when Field_Has_Signal_Flag =>
+            return Get_Has_Signal_Flag (N);
+         when Field_Elab_Flag =>
+            return Get_Elab_Flag (N);
+         when Field_Index_Constraint_Flag =>
+            return Get_Index_Constraint_Flag (N);
+         when Field_Aggr_Dynamic_Flag =>
+            return Get_Aggr_Dynamic_Flag (N);
+         when Field_Aggr_Others_Flag =>
+            return Get_Aggr_Others_Flag (N);
+         when Field_Aggr_Named_Flag =>
+            return Get_Aggr_Named_Flag (N);
+         when Field_Has_Disconnect_Flag =>
+            return Get_Has_Disconnect_Flag (N);
+         when Field_Has_Active_Flag =>
+            return Get_Has_Active_Flag (N);
+         when Field_Is_Within_Flag =>
+            return Get_Is_Within_Flag (N);
+         when Field_Implicit_Alias_Flag =>
+            return Get_Implicit_Alias_Flag (N);
+         when Field_Use_Flag =>
+            return Get_Use_Flag (N);
+         when Field_End_Has_Reserved_Id =>
+            return Get_End_Has_Reserved_Id (N);
+         when Field_End_Has_Identifier =>
+            return Get_End_Has_Identifier (N);
+         when Field_End_Has_Postponed =>
+            return Get_End_Has_Postponed (N);
+         when Field_Has_Begin =>
+            return Get_Has_Begin (N);
+         when Field_Has_Is =>
+            return Get_Has_Is (N);
+         when Field_Has_Pure =>
+            return Get_Has_Pure (N);
+         when Field_Has_Body =>
+            return Get_Has_Body (N);
+         when Field_Has_Identifier_List =>
+            return Get_Has_Identifier_List (N);
+         when Field_Has_Mode =>
+            return Get_Has_Mode (N);
+         when Field_Is_Ref =>
+            return Get_Is_Ref (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Boolean;
+
+   procedure Set_Boolean
+      (N : Iir; F : Fields_Enum; V: Boolean) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Boolean);
+      case F is
+         when Field_Whole_Association_Flag =>
+            Set_Whole_Association_Flag (N, V);
+         when Field_Collapse_Signal_Flag =>
+            Set_Collapse_Signal_Flag (N, V);
+         when Field_Artificial_Flag =>
+            Set_Artificial_Flag (N, V);
+         when Field_Open_Flag =>
+            Set_Open_Flag (N, V);
+         when Field_After_Drivers_Flag =>
+            Set_After_Drivers_Flag (N, V);
+         when Field_Same_Alternative_Flag =>
+            Set_Same_Alternative_Flag (N, V);
+         when Field_Need_Body =>
+            Set_Need_Body (N, V);
+         when Field_Deferred_Declaration_Flag =>
+            Set_Deferred_Declaration_Flag (N, V);
+         when Field_Shared_Flag =>
+            Set_Shared_Flag (N, V);
+         when Field_Visible_Flag =>
+            Set_Visible_Flag (N, V);
+         when Field_Text_File_Flag =>
+            Set_Text_File_Flag (N, V);
+         when Field_Only_Characters_Flag =>
+            Set_Only_Characters_Flag (N, V);
+         when Field_Postponed_Flag =>
+            Set_Postponed_Flag (N, V);
+         when Field_Passive_Flag =>
+            Set_Passive_Flag (N, V);
+         when Field_Resolution_Function_Flag =>
+            Set_Resolution_Function_Flag (N, V);
+         when Field_Seen_Flag =>
+            Set_Seen_Flag (N, V);
+         when Field_Pure_Flag =>
+            Set_Pure_Flag (N, V);
+         when Field_Foreign_Flag =>
+            Set_Foreign_Flag (N, V);
+         when Field_Resolved_Flag =>
+            Set_Resolved_Flag (N, V);
+         when Field_Signal_Type_Flag =>
+            Set_Signal_Type_Flag (N, V);
+         when Field_Has_Signal_Flag =>
+            Set_Has_Signal_Flag (N, V);
+         when Field_Elab_Flag =>
+            Set_Elab_Flag (N, V);
+         when Field_Index_Constraint_Flag =>
+            Set_Index_Constraint_Flag (N, V);
+         when Field_Aggr_Dynamic_Flag =>
+            Set_Aggr_Dynamic_Flag (N, V);
+         when Field_Aggr_Others_Flag =>
+            Set_Aggr_Others_Flag (N, V);
+         when Field_Aggr_Named_Flag =>
+            Set_Aggr_Named_Flag (N, V);
+         when Field_Has_Disconnect_Flag =>
+            Set_Has_Disconnect_Flag (N, V);
+         when Field_Has_Active_Flag =>
+            Set_Has_Active_Flag (N, V);
+         when Field_Is_Within_Flag =>
+            Set_Is_Within_Flag (N, V);
+         when Field_Implicit_Alias_Flag =>
+            Set_Implicit_Alias_Flag (N, V);
+         when Field_Use_Flag =>
+            Set_Use_Flag (N, V);
+         when Field_End_Has_Reserved_Id =>
+            Set_End_Has_Reserved_Id (N, V);
+         when Field_End_Has_Identifier =>
+            Set_End_Has_Identifier (N, V);
+         when Field_End_Has_Postponed =>
+            Set_End_Has_Postponed (N, V);
+         when Field_Has_Begin =>
+            Set_Has_Begin (N, V);
+         when Field_Has_Is =>
+            Set_Has_Is (N, V);
+         when Field_Has_Pure =>
+            Set_Has_Pure (N, V);
+         when Field_Has_Body =>
+            Set_Has_Body (N, V);
+         when Field_Has_Identifier_List =>
+            Set_Has_Identifier_List (N, V);
+         when Field_Has_Mode =>
+            Set_Has_Mode (N, V);
+         when Field_Is_Ref =>
+            Set_Is_Ref (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Boolean;
+
+   function Get_Date_State_Type
+      (N : Iir; F : Fields_Enum) return Date_State_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Date_State_Type);
+      case F is
+         when Field_Date_State =>
+            return Get_Date_State (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Date_State_Type;
+
+   procedure Set_Date_State_Type
+      (N : Iir; F : Fields_Enum; V: Date_State_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Date_State_Type);
+      case F is
+         when Field_Date_State =>
+            Set_Date_State (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Date_State_Type;
+
+   function Get_Date_Type
+      (N : Iir; F : Fields_Enum) return Date_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Date_Type);
+      case F is
+         when Field_Date =>
+            return Get_Date (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Date_Type;
+
+   procedure Set_Date_Type
+      (N : Iir; F : Fields_Enum; V: Date_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Date_Type);
+      case F is
+         when Field_Date =>
+            Set_Date (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Date_Type;
+
+   function Get_Iir
+      (N : Iir; F : Fields_Enum) return Iir is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir);
+      case F is
+         when Field_First_Design_Unit =>
+            return Get_First_Design_Unit (N);
+         when Field_Last_Design_Unit =>
+            return Get_Last_Design_Unit (N);
+         when Field_Library_Declaration =>
+            return Get_Library_Declaration (N);
+         when Field_Library =>
+            return Get_Library (N);
+         when Field_Design_File =>
+            return Get_Design_File (N);
+         when Field_Design_File_Chain =>
+            return Get_Design_File_Chain (N);
+         when Field_Context_Items =>
+            return Get_Context_Items (N);
+         when Field_Library_Unit =>
+            return Get_Library_Unit (N);
+         when Field_Hash_Chain =>
+            return Get_Hash_Chain (N);
+         when Field_Physical_Literal =>
+            return Get_Physical_Literal (N);
+         when Field_Physical_Unit_Value =>
+            return Get_Physical_Unit_Value (N);
+         when Field_Enumeration_Decl =>
+            return Get_Enumeration_Decl (N);
+         when Field_Bit_String_0 =>
+            return Get_Bit_String_0 (N);
+         when Field_Bit_String_1 =>
+            return Get_Bit_String_1 (N);
+         when Field_Literal_Origin =>
+            return Get_Literal_Origin (N);
+         when Field_Range_Origin =>
+            return Get_Range_Origin (N);
+         when Field_Literal_Subtype =>
+            return Get_Literal_Subtype (N);
+         when Field_Attribute_Designator =>
+            return Get_Attribute_Designator (N);
+         when Field_Attribute_Specification_Chain =>
+            return Get_Attribute_Specification_Chain (N);
+         when Field_Attribute_Specification =>
+            return Get_Attribute_Specification (N);
+         when Field_Designated_Entity =>
+            return Get_Designated_Entity (N);
+         when Field_Formal =>
+            return Get_Formal (N);
+         when Field_Actual =>
+            return Get_Actual (N);
+         when Field_In_Conversion =>
+            return Get_In_Conversion (N);
+         when Field_Out_Conversion =>
+            return Get_Out_Conversion (N);
+         when Field_We_Value =>
+            return Get_We_Value (N);
+         when Field_Time =>
+            return Get_Time (N);
+         when Field_Associated_Expr =>
+            return Get_Associated_Expr (N);
+         when Field_Associated_Chain =>
+            return Get_Associated_Chain (N);
+         when Field_Choice_Name =>
+            return Get_Choice_Name (N);
+         when Field_Choice_Expression =>
+            return Get_Choice_Expression (N);
+         when Field_Choice_Range =>
+            return Get_Choice_Range (N);
+         when Field_Architecture =>
+            return Get_Architecture (N);
+         when Field_Block_Specification =>
+            return Get_Block_Specification (N);
+         when Field_Prev_Block_Configuration =>
+            return Get_Prev_Block_Configuration (N);
+         when Field_Configuration_Item_Chain =>
+            return Get_Configuration_Item_Chain (N);
+         when Field_Attribute_Value_Chain =>
+            return Get_Attribute_Value_Chain (N);
+         when Field_Spec_Chain =>
+            return Get_Spec_Chain (N);
+         when Field_Attribute_Value_Spec_Chain =>
+            return Get_Attribute_Value_Spec_Chain (N);
+         when Field_Entity_Name =>
+            return Get_Entity_Name (N);
+         when Field_Package =>
+            return Get_Package (N);
+         when Field_Package_Body =>
+            return Get_Package_Body (N);
+         when Field_Block_Configuration =>
+            return Get_Block_Configuration (N);
+         when Field_Concurrent_Statement_Chain =>
+            return Get_Concurrent_Statement_Chain (N);
+         when Field_Chain =>
+            return Get_Chain (N);
+         when Field_Port_Chain =>
+            return Get_Port_Chain (N);
+         when Field_Generic_Chain =>
+            return Get_Generic_Chain (N);
+         when Field_Type =>
+            return Get_Type (N);
+         when Field_Subtype_Indication =>
+            return Get_Subtype_Indication (N);
+         when Field_Discrete_Range =>
+            return Get_Discrete_Range (N);
+         when Field_Type_Definition =>
+            return Get_Type_Definition (N);
+         when Field_Subtype_Definition =>
+            return Get_Subtype_Definition (N);
+         when Field_Nature =>
+            return Get_Nature (N);
+         when Field_Base_Name =>
+            return Get_Base_Name (N);
+         when Field_Interface_Declaration_Chain =>
+            return Get_Interface_Declaration_Chain (N);
+         when Field_Subprogram_Specification =>
+            return Get_Subprogram_Specification (N);
+         when Field_Sequential_Statement_Chain =>
+            return Get_Sequential_Statement_Chain (N);
+         when Field_Subprogram_Body =>
+            return Get_Subprogram_Body (N);
+         when Field_Return_Type =>
+            return Get_Return_Type (N);
+         when Field_Type_Reference =>
+            return Get_Type_Reference (N);
+         when Field_Default_Value =>
+            return Get_Default_Value (N);
+         when Field_Deferred_Declaration =>
+            return Get_Deferred_Declaration (N);
+         when Field_Design_Unit =>
+            return Get_Design_Unit (N);
+         when Field_Block_Statement =>
+            return Get_Block_Statement (N);
+         when Field_Signal_Driver =>
+            return Get_Signal_Driver (N);
+         when Field_Declaration_Chain =>
+            return Get_Declaration_Chain (N);
+         when Field_File_Logical_Name =>
+            return Get_File_Logical_Name (N);
+         when Field_File_Open_Kind =>
+            return Get_File_Open_Kind (N);
+         when Field_Element_Declaration =>
+            return Get_Element_Declaration (N);
+         when Field_Selected_Element =>
+            return Get_Selected_Element (N);
+         when Field_Use_Clause_Chain =>
+            return Get_Use_Clause_Chain (N);
+         when Field_Selected_Name =>
+            return Get_Selected_Name (N);
+         when Field_Type_Declarator =>
+            return Get_Type_Declarator (N);
+         when Field_Entity_Class_Entry_Chain =>
+            return Get_Entity_Class_Entry_Chain (N);
+         when Field_Unit_Chain =>
+            return Get_Unit_Chain (N);
+         when Field_Primary_Unit =>
+            return Get_Primary_Unit (N);
+         when Field_Range_Constraint =>
+            return Get_Range_Constraint (N);
+         when Field_Left_Limit =>
+            return Get_Left_Limit (N);
+         when Field_Right_Limit =>
+            return Get_Right_Limit (N);
+         when Field_Base_Type =>
+            return Get_Base_Type (N);
+         when Field_Resolution_Indication =>
+            return Get_Resolution_Indication (N);
+         when Field_Record_Element_Resolution_Chain =>
+            return Get_Record_Element_Resolution_Chain (N);
+         when Field_Tolerance =>
+            return Get_Tolerance (N);
+         when Field_Plus_Terminal =>
+            return Get_Plus_Terminal (N);
+         when Field_Minus_Terminal =>
+            return Get_Minus_Terminal (N);
+         when Field_Simultaneous_Left =>
+            return Get_Simultaneous_Left (N);
+         when Field_Simultaneous_Right =>
+            return Get_Simultaneous_Right (N);
+         when Field_Element_Subtype_Indication =>
+            return Get_Element_Subtype_Indication (N);
+         when Field_Element_Subtype =>
+            return Get_Element_Subtype (N);
+         when Field_Array_Element_Constraint =>
+            return Get_Array_Element_Constraint (N);
+         when Field_Designated_Type =>
+            return Get_Designated_Type (N);
+         when Field_Designated_Subtype_Indication =>
+            return Get_Designated_Subtype_Indication (N);
+         when Field_Reference =>
+            return Get_Reference (N);
+         when Field_Nature_Declarator =>
+            return Get_Nature_Declarator (N);
+         when Field_Across_Type =>
+            return Get_Across_Type (N);
+         when Field_Through_Type =>
+            return Get_Through_Type (N);
+         when Field_Target =>
+            return Get_Target (N);
+         when Field_Waveform_Chain =>
+            return Get_Waveform_Chain (N);
+         when Field_Guard =>
+            return Get_Guard (N);
+         when Field_Reject_Time_Expression =>
+            return Get_Reject_Time_Expression (N);
+         when Field_Process_Origin =>
+            return Get_Process_Origin (N);
+         when Field_Condition_Clause =>
+            return Get_Condition_Clause (N);
+         when Field_Timeout_Clause =>
+            return Get_Timeout_Clause (N);
+         when Field_Assertion_Condition =>
+            return Get_Assertion_Condition (N);
+         when Field_Report_Expression =>
+            return Get_Report_Expression (N);
+         when Field_Severity_Expression =>
+            return Get_Severity_Expression (N);
+         when Field_Instantiated_Unit =>
+            return Get_Instantiated_Unit (N);
+         when Field_Generic_Map_Aspect_Chain =>
+            return Get_Generic_Map_Aspect_Chain (N);
+         when Field_Port_Map_Aspect_Chain =>
+            return Get_Port_Map_Aspect_Chain (N);
+         when Field_Configuration_Name =>
+            return Get_Configuration_Name (N);
+         when Field_Component_Configuration =>
+            return Get_Component_Configuration (N);
+         when Field_Configuration_Specification =>
+            return Get_Configuration_Specification (N);
+         when Field_Default_Binding_Indication =>
+            return Get_Default_Binding_Indication (N);
+         when Field_Default_Configuration_Declaration =>
+            return Get_Default_Configuration_Declaration (N);
+         when Field_Expression =>
+            return Get_Expression (N);
+         when Field_Allocator_Designated_Type =>
+            return Get_Allocator_Designated_Type (N);
+         when Field_Selected_Waveform_Chain =>
+            return Get_Selected_Waveform_Chain (N);
+         when Field_Conditional_Waveform_Chain =>
+            return Get_Conditional_Waveform_Chain (N);
+         when Field_Guard_Expression =>
+            return Get_Guard_Expression (N);
+         when Field_Guard_Decl =>
+            return Get_Guard_Decl (N);
+         when Field_Block_Block_Configuration =>
+            return Get_Block_Block_Configuration (N);
+         when Field_Package_Header =>
+            return Get_Package_Header (N);
+         when Field_Block_Header =>
+            return Get_Block_Header (N);
+         when Field_Uninstantiated_Package_Name =>
+            return Get_Uninstantiated_Package_Name (N);
+         when Field_Generate_Block_Configuration =>
+            return Get_Generate_Block_Configuration (N);
+         when Field_Generation_Scheme =>
+            return Get_Generation_Scheme (N);
+         when Field_Condition =>
+            return Get_Condition (N);
+         when Field_Else_Clause =>
+            return Get_Else_Clause (N);
+         when Field_Parameter_Specification =>
+            return Get_Parameter_Specification (N);
+         when Field_Parent =>
+            return Get_Parent (N);
+         when Field_Loop_Label =>
+            return Get_Loop_Label (N);
+         when Field_Component_Name =>
+            return Get_Component_Name (N);
+         when Field_Entity_Aspect =>
+            return Get_Entity_Aspect (N);
+         when Field_Default_Entity_Aspect =>
+            return Get_Default_Entity_Aspect (N);
+         when Field_Default_Generic_Map_Aspect_Chain =>
+            return Get_Default_Generic_Map_Aspect_Chain (N);
+         when Field_Default_Port_Map_Aspect_Chain =>
+            return Get_Default_Port_Map_Aspect_Chain (N);
+         when Field_Binding_Indication =>
+            return Get_Binding_Indication (N);
+         when Field_Named_Entity =>
+            return Get_Named_Entity (N);
+         when Field_Alias_Declaration =>
+            return Get_Alias_Declaration (N);
+         when Field_Error_Origin =>
+            return Get_Error_Origin (N);
+         when Field_Operand =>
+            return Get_Operand (N);
+         when Field_Left =>
+            return Get_Left (N);
+         when Field_Right =>
+            return Get_Right (N);
+         when Field_Unit_Name =>
+            return Get_Unit_Name (N);
+         when Field_Name =>
+            return Get_Name (N);
+         when Field_Group_Template_Name =>
+            return Get_Group_Template_Name (N);
+         when Field_Prefix =>
+            return Get_Prefix (N);
+         when Field_Signature_Prefix =>
+            return Get_Signature_Prefix (N);
+         when Field_Slice_Subtype =>
+            return Get_Slice_Subtype (N);
+         when Field_Suffix =>
+            return Get_Suffix (N);
+         when Field_Index_Subtype =>
+            return Get_Index_Subtype (N);
+         when Field_Parameter =>
+            return Get_Parameter (N);
+         when Field_Actual_Type =>
+            return Get_Actual_Type (N);
+         when Field_Associated_Interface =>
+            return Get_Associated_Interface (N);
+         when Field_Association_Chain =>
+            return Get_Association_Chain (N);
+         when Field_Individual_Association_Chain =>
+            return Get_Individual_Association_Chain (N);
+         when Field_Aggregate_Info =>
+            return Get_Aggregate_Info (N);
+         when Field_Sub_Aggregate_Info =>
+            return Get_Sub_Aggregate_Info (N);
+         when Field_Aggr_Low_Limit =>
+            return Get_Aggr_Low_Limit (N);
+         when Field_Aggr_High_Limit =>
+            return Get_Aggr_High_Limit (N);
+         when Field_Association_Choices_Chain =>
+            return Get_Association_Choices_Chain (N);
+         when Field_Case_Statement_Alternative_Chain =>
+            return Get_Case_Statement_Alternative_Chain (N);
+         when Field_Procedure_Call =>
+            return Get_Procedure_Call (N);
+         when Field_Implementation =>
+            return Get_Implementation (N);
+         when Field_Parameter_Association_Chain =>
+            return Get_Parameter_Association_Chain (N);
+         when Field_Method_Object =>
+            return Get_Method_Object (N);
+         when Field_Subtype_Type_Mark =>
+            return Get_Subtype_Type_Mark (N);
+         when Field_Type_Conversion_Subtype =>
+            return Get_Type_Conversion_Subtype (N);
+         when Field_Type_Mark =>
+            return Get_Type_Mark (N);
+         when Field_File_Type_Mark =>
+            return Get_File_Type_Mark (N);
+         when Field_Return_Type_Mark =>
+            return Get_Return_Type_Mark (N);
+         when Field_Alias_Signature =>
+            return Get_Alias_Signature (N);
+         when Field_Attribute_Signature =>
+            return Get_Attribute_Signature (N);
+         when Field_Simple_Name_Subtype =>
+            return Get_Simple_Name_Subtype (N);
+         when Field_Protected_Type_Body =>
+            return Get_Protected_Type_Body (N);
+         when Field_Protected_Type_Declaration =>
+            return Get_Protected_Type_Declaration (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir;
+
+   procedure Set_Iir
+      (N : Iir; F : Fields_Enum; V: Iir) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir);
+      case F is
+         when Field_First_Design_Unit =>
+            Set_First_Design_Unit (N, V);
+         when Field_Last_Design_Unit =>
+            Set_Last_Design_Unit (N, V);
+         when Field_Library_Declaration =>
+            Set_Library_Declaration (N, V);
+         when Field_Library =>
+            Set_Library (N, V);
+         when Field_Design_File =>
+            Set_Design_File (N, V);
+         when Field_Design_File_Chain =>
+            Set_Design_File_Chain (N, V);
+         when Field_Context_Items =>
+            Set_Context_Items (N, V);
+         when Field_Library_Unit =>
+            Set_Library_Unit (N, V);
+         when Field_Hash_Chain =>
+            Set_Hash_Chain (N, V);
+         when Field_Physical_Literal =>
+            Set_Physical_Literal (N, V);
+         when Field_Physical_Unit_Value =>
+            Set_Physical_Unit_Value (N, V);
+         when Field_Enumeration_Decl =>
+            Set_Enumeration_Decl (N, V);
+         when Field_Bit_String_0 =>
+            Set_Bit_String_0 (N, V);
+         when Field_Bit_String_1 =>
+            Set_Bit_String_1 (N, V);
+         when Field_Literal_Origin =>
+            Set_Literal_Origin (N, V);
+         when Field_Range_Origin =>
+            Set_Range_Origin (N, V);
+         when Field_Literal_Subtype =>
+            Set_Literal_Subtype (N, V);
+         when Field_Attribute_Designator =>
+            Set_Attribute_Designator (N, V);
+         when Field_Attribute_Specification_Chain =>
+            Set_Attribute_Specification_Chain (N, V);
+         when Field_Attribute_Specification =>
+            Set_Attribute_Specification (N, V);
+         when Field_Designated_Entity =>
+            Set_Designated_Entity (N, V);
+         when Field_Formal =>
+            Set_Formal (N, V);
+         when Field_Actual =>
+            Set_Actual (N, V);
+         when Field_In_Conversion =>
+            Set_In_Conversion (N, V);
+         when Field_Out_Conversion =>
+            Set_Out_Conversion (N, V);
+         when Field_We_Value =>
+            Set_We_Value (N, V);
+         when Field_Time =>
+            Set_Time (N, V);
+         when Field_Associated_Expr =>
+            Set_Associated_Expr (N, V);
+         when Field_Associated_Chain =>
+            Set_Associated_Chain (N, V);
+         when Field_Choice_Name =>
+            Set_Choice_Name (N, V);
+         when Field_Choice_Expression =>
+            Set_Choice_Expression (N, V);
+         when Field_Choice_Range =>
+            Set_Choice_Range (N, V);
+         when Field_Architecture =>
+            Set_Architecture (N, V);
+         when Field_Block_Specification =>
+            Set_Block_Specification (N, V);
+         when Field_Prev_Block_Configuration =>
+            Set_Prev_Block_Configuration (N, V);
+         when Field_Configuration_Item_Chain =>
+            Set_Configuration_Item_Chain (N, V);
+         when Field_Attribute_Value_Chain =>
+            Set_Attribute_Value_Chain (N, V);
+         when Field_Spec_Chain =>
+            Set_Spec_Chain (N, V);
+         when Field_Attribute_Value_Spec_Chain =>
+            Set_Attribute_Value_Spec_Chain (N, V);
+         when Field_Entity_Name =>
+            Set_Entity_Name (N, V);
+         when Field_Package =>
+            Set_Package (N, V);
+         when Field_Package_Body =>
+            Set_Package_Body (N, V);
+         when Field_Block_Configuration =>
+            Set_Block_Configuration (N, V);
+         when Field_Concurrent_Statement_Chain =>
+            Set_Concurrent_Statement_Chain (N, V);
+         when Field_Chain =>
+            Set_Chain (N, V);
+         when Field_Port_Chain =>
+            Set_Port_Chain (N, V);
+         when Field_Generic_Chain =>
+            Set_Generic_Chain (N, V);
+         when Field_Type =>
+            Set_Type (N, V);
+         when Field_Subtype_Indication =>
+            Set_Subtype_Indication (N, V);
+         when Field_Discrete_Range =>
+            Set_Discrete_Range (N, V);
+         when Field_Type_Definition =>
+            Set_Type_Definition (N, V);
+         when Field_Subtype_Definition =>
+            Set_Subtype_Definition (N, V);
+         when Field_Nature =>
+            Set_Nature (N, V);
+         when Field_Base_Name =>
+            Set_Base_Name (N, V);
+         when Field_Interface_Declaration_Chain =>
+            Set_Interface_Declaration_Chain (N, V);
+         when Field_Subprogram_Specification =>
+            Set_Subprogram_Specification (N, V);
+         when Field_Sequential_Statement_Chain =>
+            Set_Sequential_Statement_Chain (N, V);
+         when Field_Subprogram_Body =>
+            Set_Subprogram_Body (N, V);
+         when Field_Return_Type =>
+            Set_Return_Type (N, V);
+         when Field_Type_Reference =>
+            Set_Type_Reference (N, V);
+         when Field_Default_Value =>
+            Set_Default_Value (N, V);
+         when Field_Deferred_Declaration =>
+            Set_Deferred_Declaration (N, V);
+         when Field_Design_Unit =>
+            Set_Design_Unit (N, V);
+         when Field_Block_Statement =>
+            Set_Block_Statement (N, V);
+         when Field_Signal_Driver =>
+            Set_Signal_Driver (N, V);
+         when Field_Declaration_Chain =>
+            Set_Declaration_Chain (N, V);
+         when Field_File_Logical_Name =>
+            Set_File_Logical_Name (N, V);
+         when Field_File_Open_Kind =>
+            Set_File_Open_Kind (N, V);
+         when Field_Element_Declaration =>
+            Set_Element_Declaration (N, V);
+         when Field_Selected_Element =>
+            Set_Selected_Element (N, V);
+         when Field_Use_Clause_Chain =>
+            Set_Use_Clause_Chain (N, V);
+         when Field_Selected_Name =>
+            Set_Selected_Name (N, V);
+         when Field_Type_Declarator =>
+            Set_Type_Declarator (N, V);
+         when Field_Entity_Class_Entry_Chain =>
+            Set_Entity_Class_Entry_Chain (N, V);
+         when Field_Unit_Chain =>
+            Set_Unit_Chain (N, V);
+         when Field_Primary_Unit =>
+            Set_Primary_Unit (N, V);
+         when Field_Range_Constraint =>
+            Set_Range_Constraint (N, V);
+         when Field_Left_Limit =>
+            Set_Left_Limit (N, V);
+         when Field_Right_Limit =>
+            Set_Right_Limit (N, V);
+         when Field_Base_Type =>
+            Set_Base_Type (N, V);
+         when Field_Resolution_Indication =>
+            Set_Resolution_Indication (N, V);
+         when Field_Record_Element_Resolution_Chain =>
+            Set_Record_Element_Resolution_Chain (N, V);
+         when Field_Tolerance =>
+            Set_Tolerance (N, V);
+         when Field_Plus_Terminal =>
+            Set_Plus_Terminal (N, V);
+         when Field_Minus_Terminal =>
+            Set_Minus_Terminal (N, V);
+         when Field_Simultaneous_Left =>
+            Set_Simultaneous_Left (N, V);
+         when Field_Simultaneous_Right =>
+            Set_Simultaneous_Right (N, V);
+         when Field_Element_Subtype_Indication =>
+            Set_Element_Subtype_Indication (N, V);
+         when Field_Element_Subtype =>
+            Set_Element_Subtype (N, V);
+         when Field_Array_Element_Constraint =>
+            Set_Array_Element_Constraint (N, V);
+         when Field_Designated_Type =>
+            Set_Designated_Type (N, V);
+         when Field_Designated_Subtype_Indication =>
+            Set_Designated_Subtype_Indication (N, V);
+         when Field_Reference =>
+            Set_Reference (N, V);
+         when Field_Nature_Declarator =>
+            Set_Nature_Declarator (N, V);
+         when Field_Across_Type =>
+            Set_Across_Type (N, V);
+         when Field_Through_Type =>
+            Set_Through_Type (N, V);
+         when Field_Target =>
+            Set_Target (N, V);
+         when Field_Waveform_Chain =>
+            Set_Waveform_Chain (N, V);
+         when Field_Guard =>
+            Set_Guard (N, V);
+         when Field_Reject_Time_Expression =>
+            Set_Reject_Time_Expression (N, V);
+         when Field_Process_Origin =>
+            Set_Process_Origin (N, V);
+         when Field_Condition_Clause =>
+            Set_Condition_Clause (N, V);
+         when Field_Timeout_Clause =>
+            Set_Timeout_Clause (N, V);
+         when Field_Assertion_Condition =>
+            Set_Assertion_Condition (N, V);
+         when Field_Report_Expression =>
+            Set_Report_Expression (N, V);
+         when Field_Severity_Expression =>
+            Set_Severity_Expression (N, V);
+         when Field_Instantiated_Unit =>
+            Set_Instantiated_Unit (N, V);
+         when Field_Generic_Map_Aspect_Chain =>
+            Set_Generic_Map_Aspect_Chain (N, V);
+         when Field_Port_Map_Aspect_Chain =>
+            Set_Port_Map_Aspect_Chain (N, V);
+         when Field_Configuration_Name =>
+            Set_Configuration_Name (N, V);
+         when Field_Component_Configuration =>
+            Set_Component_Configuration (N, V);
+         when Field_Configuration_Specification =>
+            Set_Configuration_Specification (N, V);
+         when Field_Default_Binding_Indication =>
+            Set_Default_Binding_Indication (N, V);
+         when Field_Default_Configuration_Declaration =>
+            Set_Default_Configuration_Declaration (N, V);
+         when Field_Expression =>
+            Set_Expression (N, V);
+         when Field_Allocator_Designated_Type =>
+            Set_Allocator_Designated_Type (N, V);
+         when Field_Selected_Waveform_Chain =>
+            Set_Selected_Waveform_Chain (N, V);
+         when Field_Conditional_Waveform_Chain =>
+            Set_Conditional_Waveform_Chain (N, V);
+         when Field_Guard_Expression =>
+            Set_Guard_Expression (N, V);
+         when Field_Guard_Decl =>
+            Set_Guard_Decl (N, V);
+         when Field_Block_Block_Configuration =>
+            Set_Block_Block_Configuration (N, V);
+         when Field_Package_Header =>
+            Set_Package_Header (N, V);
+         when Field_Block_Header =>
+            Set_Block_Header (N, V);
+         when Field_Uninstantiated_Package_Name =>
+            Set_Uninstantiated_Package_Name (N, V);
+         when Field_Generate_Block_Configuration =>
+            Set_Generate_Block_Configuration (N, V);
+         when Field_Generation_Scheme =>
+            Set_Generation_Scheme (N, V);
+         when Field_Condition =>
+            Set_Condition (N, V);
+         when Field_Else_Clause =>
+            Set_Else_Clause (N, V);
+         when Field_Parameter_Specification =>
+            Set_Parameter_Specification (N, V);
+         when Field_Parent =>
+            Set_Parent (N, V);
+         when Field_Loop_Label =>
+            Set_Loop_Label (N, V);
+         when Field_Component_Name =>
+            Set_Component_Name (N, V);
+         when Field_Entity_Aspect =>
+            Set_Entity_Aspect (N, V);
+         when Field_Default_Entity_Aspect =>
+            Set_Default_Entity_Aspect (N, V);
+         when Field_Default_Generic_Map_Aspect_Chain =>
+            Set_Default_Generic_Map_Aspect_Chain (N, V);
+         when Field_Default_Port_Map_Aspect_Chain =>
+            Set_Default_Port_Map_Aspect_Chain (N, V);
+         when Field_Binding_Indication =>
+            Set_Binding_Indication (N, V);
+         when Field_Named_Entity =>
+            Set_Named_Entity (N, V);
+         when Field_Alias_Declaration =>
+            Set_Alias_Declaration (N, V);
+         when Field_Error_Origin =>
+            Set_Error_Origin (N, V);
+         when Field_Operand =>
+            Set_Operand (N, V);
+         when Field_Left =>
+            Set_Left (N, V);
+         when Field_Right =>
+            Set_Right (N, V);
+         when Field_Unit_Name =>
+            Set_Unit_Name (N, V);
+         when Field_Name =>
+            Set_Name (N, V);
+         when Field_Group_Template_Name =>
+            Set_Group_Template_Name (N, V);
+         when Field_Prefix =>
+            Set_Prefix (N, V);
+         when Field_Signature_Prefix =>
+            Set_Signature_Prefix (N, V);
+         when Field_Slice_Subtype =>
+            Set_Slice_Subtype (N, V);
+         when Field_Suffix =>
+            Set_Suffix (N, V);
+         when Field_Index_Subtype =>
+            Set_Index_Subtype (N, V);
+         when Field_Parameter =>
+            Set_Parameter (N, V);
+         when Field_Actual_Type =>
+            Set_Actual_Type (N, V);
+         when Field_Associated_Interface =>
+            Set_Associated_Interface (N, V);
+         when Field_Association_Chain =>
+            Set_Association_Chain (N, V);
+         when Field_Individual_Association_Chain =>
+            Set_Individual_Association_Chain (N, V);
+         when Field_Aggregate_Info =>
+            Set_Aggregate_Info (N, V);
+         when Field_Sub_Aggregate_Info =>
+            Set_Sub_Aggregate_Info (N, V);
+         when Field_Aggr_Low_Limit =>
+            Set_Aggr_Low_Limit (N, V);
+         when Field_Aggr_High_Limit =>
+            Set_Aggr_High_Limit (N, V);
+         when Field_Association_Choices_Chain =>
+            Set_Association_Choices_Chain (N, V);
+         when Field_Case_Statement_Alternative_Chain =>
+            Set_Case_Statement_Alternative_Chain (N, V);
+         when Field_Procedure_Call =>
+            Set_Procedure_Call (N, V);
+         when Field_Implementation =>
+            Set_Implementation (N, V);
+         when Field_Parameter_Association_Chain =>
+            Set_Parameter_Association_Chain (N, V);
+         when Field_Method_Object =>
+            Set_Method_Object (N, V);
+         when Field_Subtype_Type_Mark =>
+            Set_Subtype_Type_Mark (N, V);
+         when Field_Type_Conversion_Subtype =>
+            Set_Type_Conversion_Subtype (N, V);
+         when Field_Type_Mark =>
+            Set_Type_Mark (N, V);
+         when Field_File_Type_Mark =>
+            Set_File_Type_Mark (N, V);
+         when Field_Return_Type_Mark =>
+            Set_Return_Type_Mark (N, V);
+         when Field_Alias_Signature =>
+            Set_Alias_Signature (N, V);
+         when Field_Attribute_Signature =>
+            Set_Attribute_Signature (N, V);
+         when Field_Simple_Name_Subtype =>
+            Set_Simple_Name_Subtype (N, V);
+         when Field_Protected_Type_Body =>
+            Set_Protected_Type_Body (N, V);
+         when Field_Protected_Type_Declaration =>
+            Set_Protected_Type_Declaration (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir;
+
+   function Get_Iir_All_Sensitized
+      (N : Iir; F : Fields_Enum) return Iir_All_Sensitized is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized);
+      case F is
+         when Field_All_Sensitized_State =>
+            return Get_All_Sensitized_State (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_All_Sensitized;
+
+   procedure Set_Iir_All_Sensitized
+      (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized);
+      case F is
+         when Field_All_Sensitized_State =>
+            Set_All_Sensitized_State (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_All_Sensitized;
+
+   function Get_Iir_Constraint
+      (N : Iir; F : Fields_Enum) return Iir_Constraint is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Constraint);
+      case F is
+         when Field_Constraint_State =>
+            return Get_Constraint_State (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Constraint;
+
+   procedure Set_Iir_Constraint
+      (N : Iir; F : Fields_Enum; V: Iir_Constraint) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Constraint);
+      case F is
+         when Field_Constraint_State =>
+            Set_Constraint_State (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Constraint;
+
+   function Get_Iir_Delay_Mechanism
+      (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism);
+      case F is
+         when Field_Delay_Mechanism =>
+            return Get_Delay_Mechanism (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Delay_Mechanism;
+
+   procedure Set_Iir_Delay_Mechanism
+      (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism);
+      case F is
+         when Field_Delay_Mechanism =>
+            Set_Delay_Mechanism (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Delay_Mechanism;
+
+   function Get_Iir_Direction
+      (N : Iir; F : Fields_Enum) return Iir_Direction is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Direction);
+      case F is
+         when Field_Direction =>
+            return Get_Direction (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Direction;
+
+   procedure Set_Iir_Direction
+      (N : Iir; F : Fields_Enum; V: Iir_Direction) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Direction);
+      case F is
+         when Field_Direction =>
+            Set_Direction (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Direction;
+
+   function Get_Iir_Fp64
+      (N : Iir; F : Fields_Enum) return Iir_Fp64 is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Fp64);
+      case F is
+         when Field_Fp_Value =>
+            return Get_Fp_Value (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Fp64;
+
+   procedure Set_Iir_Fp64
+      (N : Iir; F : Fields_Enum; V: Iir_Fp64) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Fp64);
+      case F is
+         when Field_Fp_Value =>
+            Set_Fp_Value (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Fp64;
+
+   function Get_Iir_Index32
+      (N : Iir; F : Fields_Enum) return Iir_Index32 is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Index32);
+      case F is
+         when Field_Element_Position =>
+            return Get_Element_Position (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Index32;
+
+   procedure Set_Iir_Index32
+      (N : Iir; F : Fields_Enum; V: Iir_Index32) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Index32);
+      case F is
+         when Field_Element_Position =>
+            Set_Element_Position (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Index32;
+
+   function Get_Iir_Int32
+      (N : Iir; F : Fields_Enum) return Iir_Int32 is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Int32);
+      case F is
+         when Field_Enum_Pos =>
+            return Get_Enum_Pos (N);
+         when Field_Overload_Number =>
+            return Get_Overload_Number (N);
+         when Field_Subprogram_Depth =>
+            return Get_Subprogram_Depth (N);
+         when Field_Subprogram_Hash =>
+            return Get_Subprogram_Hash (N);
+         when Field_Impure_Depth =>
+            return Get_Impure_Depth (N);
+         when Field_Aggr_Min_Length =>
+            return Get_Aggr_Min_Length (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Int32;
+
+   procedure Set_Iir_Int32
+      (N : Iir; F : Fields_Enum; V: Iir_Int32) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Int32);
+      case F is
+         when Field_Enum_Pos =>
+            Set_Enum_Pos (N, V);
+         when Field_Overload_Number =>
+            Set_Overload_Number (N, V);
+         when Field_Subprogram_Depth =>
+            Set_Subprogram_Depth (N, V);
+         when Field_Subprogram_Hash =>
+            Set_Subprogram_Hash (N, V);
+         when Field_Impure_Depth =>
+            Set_Impure_Depth (N, V);
+         when Field_Aggr_Min_Length =>
+            Set_Aggr_Min_Length (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Int32;
+
+   function Get_Iir_Int64
+      (N : Iir; F : Fields_Enum) return Iir_Int64 is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Int64);
+      case F is
+         when Field_Value =>
+            return Get_Value (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Int64;
+
+   procedure Set_Iir_Int64
+      (N : Iir; F : Fields_Enum; V: Iir_Int64) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Int64);
+      case F is
+         when Field_Value =>
+            Set_Value (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Int64;
+
+   function Get_Iir_Lexical_Layout_Type
+      (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type);
+      case F is
+         when Field_Lexical_Layout =>
+            return Get_Lexical_Layout (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Lexical_Layout_Type;
+
+   procedure Set_Iir_Lexical_Layout_Type
+      (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type);
+      case F is
+         when Field_Lexical_Layout =>
+            Set_Lexical_Layout (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Lexical_Layout_Type;
+
+   function Get_Iir_List
+      (N : Iir; F : Fields_Enum) return Iir_List is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_List);
+      case F is
+         when Field_File_Dependence_List =>
+            return Get_File_Dependence_List (N);
+         when Field_Dependence_List =>
+            return Get_Dependence_List (N);
+         when Field_Analysis_Checks_List =>
+            return Get_Analysis_Checks_List (N);
+         when Field_Simple_Aggregate_List =>
+            return Get_Simple_Aggregate_List (N);
+         when Field_Entity_Name_List =>
+            return Get_Entity_Name_List (N);
+         when Field_Signal_List =>
+            return Get_Signal_List (N);
+         when Field_Enumeration_Literal_List =>
+            return Get_Enumeration_Literal_List (N);
+         when Field_Group_Constituent_List =>
+            return Get_Group_Constituent_List (N);
+         when Field_Index_Subtype_List =>
+            return Get_Index_Subtype_List (N);
+         when Field_Index_Subtype_Definition_List =>
+            return Get_Index_Subtype_Definition_List (N);
+         when Field_Index_Constraint_List =>
+            return Get_Index_Constraint_List (N);
+         when Field_Elements_Declaration_List =>
+            return Get_Elements_Declaration_List (N);
+         when Field_Index_List =>
+            return Get_Index_List (N);
+         when Field_Sensitivity_List =>
+            return Get_Sensitivity_List (N);
+         when Field_Callees_List =>
+            return Get_Callees_List (N);
+         when Field_Guard_Sensitivity_List =>
+            return Get_Guard_Sensitivity_List (N);
+         when Field_Instantiation_List =>
+            return Get_Instantiation_List (N);
+         when Field_Incomplete_Type_List =>
+            return Get_Incomplete_Type_List (N);
+         when Field_Type_Marks_List =>
+            return Get_Type_Marks_List (N);
+         when Field_Overload_List =>
+            return Get_Overload_List (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_List;
+
+   procedure Set_Iir_List
+      (N : Iir; F : Fields_Enum; V: Iir_List) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_List);
+      case F is
+         when Field_File_Dependence_List =>
+            Set_File_Dependence_List (N, V);
+         when Field_Dependence_List =>
+            Set_Dependence_List (N, V);
+         when Field_Analysis_Checks_List =>
+            Set_Analysis_Checks_List (N, V);
+         when Field_Simple_Aggregate_List =>
+            Set_Simple_Aggregate_List (N, V);
+         when Field_Entity_Name_List =>
+            Set_Entity_Name_List (N, V);
+         when Field_Signal_List =>
+            Set_Signal_List (N, V);
+         when Field_Enumeration_Literal_List =>
+            Set_Enumeration_Literal_List (N, V);
+         when Field_Group_Constituent_List =>
+            Set_Group_Constituent_List (N, V);
+         when Field_Index_Subtype_List =>
+            Set_Index_Subtype_List (N, V);
+         when Field_Index_Subtype_Definition_List =>
+            Set_Index_Subtype_Definition_List (N, V);
+         when Field_Index_Constraint_List =>
+            Set_Index_Constraint_List (N, V);
+         when Field_Elements_Declaration_List =>
+            Set_Elements_Declaration_List (N, V);
+         when Field_Index_List =>
+            Set_Index_List (N, V);
+         when Field_Sensitivity_List =>
+            Set_Sensitivity_List (N, V);
+         when Field_Callees_List =>
+            Set_Callees_List (N, V);
+         when Field_Guard_Sensitivity_List =>
+            Set_Guard_Sensitivity_List (N, V);
+         when Field_Instantiation_List =>
+            Set_Instantiation_List (N, V);
+         when Field_Incomplete_Type_List =>
+            Set_Incomplete_Type_List (N, V);
+         when Field_Type_Marks_List =>
+            Set_Type_Marks_List (N, V);
+         when Field_Overload_List =>
+            Set_Overload_List (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_List;
+
+   function Get_Iir_Mode
+      (N : Iir; F : Fields_Enum) return Iir_Mode is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Mode);
+      case F is
+         when Field_Mode =>
+            return Get_Mode (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Mode;
+
+   procedure Set_Iir_Mode
+      (N : Iir; F : Fields_Enum; V: Iir_Mode) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Mode);
+      case F is
+         when Field_Mode =>
+            Set_Mode (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Mode;
+
+   function Get_Iir_Predefined_Functions
+      (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions);
+      case F is
+         when Field_Implicit_Definition =>
+            return Get_Implicit_Definition (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Predefined_Functions;
+
+   procedure Set_Iir_Predefined_Functions
+      (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions);
+      case F is
+         when Field_Implicit_Definition =>
+            Set_Implicit_Definition (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Predefined_Functions;
+
+   function Get_Iir_Pure_State
+      (N : Iir; F : Fields_Enum) return Iir_Pure_State is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Pure_State);
+      case F is
+         when Field_Purity_State =>
+            return Get_Purity_State (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Pure_State;
+
+   procedure Set_Iir_Pure_State
+      (N : Iir; F : Fields_Enum; V: Iir_Pure_State) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Pure_State);
+      case F is
+         when Field_Purity_State =>
+            Set_Purity_State (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Pure_State;
+
+   function Get_Iir_Signal_Kind
+      (N : Iir; F : Fields_Enum) return Iir_Signal_Kind is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind);
+      case F is
+         when Field_Signal_Kind =>
+            return Get_Signal_Kind (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Signal_Kind;
+
+   procedure Set_Iir_Signal_Kind
+      (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind);
+      case F is
+         when Field_Signal_Kind =>
+            Set_Signal_Kind (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Signal_Kind;
+
+   function Get_Iir_Staticness
+      (N : Iir; F : Fields_Enum) return Iir_Staticness is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Staticness);
+      case F is
+         when Field_Type_Staticness =>
+            return Get_Type_Staticness (N);
+         when Field_Expr_Staticness =>
+            return Get_Expr_Staticness (N);
+         when Field_Name_Staticness =>
+            return Get_Name_Staticness (N);
+         when Field_Value_Staticness =>
+            return Get_Value_Staticness (N);
+         when Field_Choice_Staticness =>
+            return Get_Choice_Staticness (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Iir_Staticness;
+
+   procedure Set_Iir_Staticness
+      (N : Iir; F : Fields_Enum; V: Iir_Staticness) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Iir_Staticness);
+      case F is
+         when Field_Type_Staticness =>
+            Set_Type_Staticness (N, V);
+         when Field_Expr_Staticness =>
+            Set_Expr_Staticness (N, V);
+         when Field_Name_Staticness =>
+            Set_Name_Staticness (N, V);
+         when Field_Value_Staticness =>
+            Set_Value_Staticness (N, V);
+         when Field_Choice_Staticness =>
+            Set_Choice_Staticness (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Iir_Staticness;
+
+   function Get_Int32
+      (N : Iir; F : Fields_Enum) return Int32 is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Int32);
+      case F is
+         when Field_Design_Unit_Source_Line =>
+            return Get_Design_Unit_Source_Line (N);
+         when Field_Design_Unit_Source_Col =>
+            return Get_Design_Unit_Source_Col (N);
+         when Field_String_Length =>
+            return Get_String_Length (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Int32;
+
+   procedure Set_Int32
+      (N : Iir; F : Fields_Enum; V: Int32) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Int32);
+      case F is
+         when Field_Design_Unit_Source_Line =>
+            Set_Design_Unit_Source_Line (N, V);
+         when Field_Design_Unit_Source_Col =>
+            Set_Design_Unit_Source_Col (N, V);
+         when Field_String_Length =>
+            Set_String_Length (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Int32;
+
+   function Get_Location_Type
+      (N : Iir; F : Fields_Enum) return Location_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Location_Type);
+      case F is
+         when Field_End_Location =>
+            return Get_End_Location (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Location_Type;
+
+   procedure Set_Location_Type
+      (N : Iir; F : Fields_Enum; V: Location_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Location_Type);
+      case F is
+         when Field_End_Location =>
+            Set_End_Location (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Location_Type;
+
+   function Get_Name_Id
+      (N : Iir; F : Fields_Enum) return Name_Id is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Name_Id);
+      case F is
+         when Field_Design_File_Filename =>
+            return Get_Design_File_Filename (N);
+         when Field_Design_File_Directory =>
+            return Get_Design_File_Directory (N);
+         when Field_Library_Directory =>
+            return Get_Library_Directory (N);
+         when Field_Identifier =>
+            return Get_Identifier (N);
+         when Field_Label =>
+            return Get_Label (N);
+         when Field_Simple_Name_Identifier =>
+            return Get_Simple_Name_Identifier (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Name_Id;
+
+   procedure Set_Name_Id
+      (N : Iir; F : Fields_Enum; V: Name_Id) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Name_Id);
+      case F is
+         when Field_Design_File_Filename =>
+            Set_Design_File_Filename (N, V);
+         when Field_Design_File_Directory =>
+            Set_Design_File_Directory (N, V);
+         when Field_Library_Directory =>
+            Set_Library_Directory (N, V);
+         when Field_Identifier =>
+            Set_Identifier (N, V);
+         when Field_Label =>
+            Set_Label (N, V);
+         when Field_Simple_Name_Identifier =>
+            Set_Simple_Name_Identifier (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Name_Id;
+
+   function Get_PSL_NFA
+      (N : Iir; F : Fields_Enum) return PSL_NFA is
+   begin
+      pragma Assert (Fields_Type (F) = Type_PSL_NFA);
+      case F is
+         when Field_PSL_NFA =>
+            return Get_PSL_NFA (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_PSL_NFA;
+
+   procedure Set_PSL_NFA
+      (N : Iir; F : Fields_Enum; V: PSL_NFA) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_PSL_NFA);
+      case F is
+         when Field_PSL_NFA =>
+            Set_PSL_NFA (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_PSL_NFA;
+
+   function Get_PSL_Node
+      (N : Iir; F : Fields_Enum) return PSL_Node is
+   begin
+      pragma Assert (Fields_Type (F) = Type_PSL_Node);
+      case F is
+         when Field_Psl_Property =>
+            return Get_Psl_Property (N);
+         when Field_Psl_Declaration =>
+            return Get_Psl_Declaration (N);
+         when Field_Psl_Expression =>
+            return Get_Psl_Expression (N);
+         when Field_Psl_Boolean =>
+            return Get_Psl_Boolean (N);
+         when Field_PSL_Clock =>
+            return Get_PSL_Clock (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_PSL_Node;
+
+   procedure Set_PSL_Node
+      (N : Iir; F : Fields_Enum; V: PSL_Node) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_PSL_Node);
+      case F is
+         when Field_Psl_Property =>
+            Set_Psl_Property (N, V);
+         when Field_Psl_Declaration =>
+            Set_Psl_Declaration (N, V);
+         when Field_Psl_Expression =>
+            Set_Psl_Expression (N, V);
+         when Field_Psl_Boolean =>
+            Set_Psl_Boolean (N, V);
+         when Field_PSL_Clock =>
+            Set_PSL_Clock (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_PSL_Node;
+
+   function Get_Source_Ptr
+      (N : Iir; F : Fields_Enum) return Source_Ptr is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Source_Ptr);
+      case F is
+         when Field_Design_Unit_Source_Pos =>
+            return Get_Design_Unit_Source_Pos (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Source_Ptr;
+
+   procedure Set_Source_Ptr
+      (N : Iir; F : Fields_Enum; V: Source_Ptr) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Source_Ptr);
+      case F is
+         when Field_Design_Unit_Source_Pos =>
+            Set_Design_Unit_Source_Pos (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Source_Ptr;
+
+   function Get_String_Id
+      (N : Iir; F : Fields_Enum) return String_Id is
+   begin
+      pragma Assert (Fields_Type (F) = Type_String_Id);
+      case F is
+         when Field_String_Id =>
+            return Get_String_Id (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_String_Id;
+
+   procedure Set_String_Id
+      (N : Iir; F : Fields_Enum; V: String_Id) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_String_Id);
+      case F is
+         when Field_String_Id =>
+            Set_String_Id (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_String_Id;
+
+   function Get_Time_Stamp_Id
+      (N : Iir; F : Fields_Enum) return Time_Stamp_Id is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id);
+      case F is
+         when Field_File_Time_Stamp =>
+            return Get_File_Time_Stamp (N);
+         when Field_Analysis_Time_Stamp =>
+            return Get_Analysis_Time_Stamp (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Time_Stamp_Id;
+
+   procedure Set_Time_Stamp_Id
+      (N : Iir; F : Fields_Enum; V: Time_Stamp_Id) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id);
+      case F is
+         when Field_File_Time_Stamp =>
+            Set_File_Time_Stamp (N, V);
+         when Field_Analysis_Time_Stamp =>
+            Set_Analysis_Time_Stamp (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Time_Stamp_Id;
+
+   function Get_Token_Type
+      (N : Iir; F : Fields_Enum) return Token_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Token_Type);
+      case F is
+         when Field_Entity_Class =>
+            return Get_Entity_Class (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Token_Type;
+
+   procedure Set_Token_Type
+      (N : Iir; F : Fields_Enum; V: Token_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Token_Type);
+      case F is
+         when Field_Entity_Class =>
+            Set_Entity_Class (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Token_Type;
+
+   function Get_Tri_State_Type
+      (N : Iir; F : Fields_Enum) return Tri_State_Type is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Tri_State_Type);
+      case F is
+         when Field_Guarded_Target_State =>
+            return Get_Guarded_Target_State (N);
+         when Field_Wait_State =>
+            return Get_Wait_State (N);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Tri_State_Type;
+
+   procedure Set_Tri_State_Type
+      (N : Iir; F : Fields_Enum; V: Tri_State_Type) is
+   begin
+      pragma Assert (Fields_Type (F) = Type_Tri_State_Type);
+      case F is
+         when Field_Guarded_Target_State =>
+            Set_Guarded_Target_State (N, V);
+         when Field_Wait_State =>
+            Set_Wait_State (N, V);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Tri_State_Type;
+
+   function Has_First_Design_Unit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_First_Design_Unit;
+
+   function Has_Last_Design_Unit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_Last_Design_Unit;
+
+   function Has_Library_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Library_Clause;
+   end Has_Library_Declaration;
+
+   function Has_File_Time_Stamp (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_File_Time_Stamp;
+
+   function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_Analysis_Time_Stamp;
+
+   function Has_Library (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_Library;
+
+   function Has_File_Dependence_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_File_Dependence_List;
+
+   function Has_Design_File_Filename (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_Design_File_Filename;
+
+   function Has_Design_File_Directory (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_File;
+   end Has_Design_File_Directory;
+
+   function Has_Design_File (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Design_File;
+
+   function Has_Design_File_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Library_Declaration;
+   end Has_Design_File_Chain;
+
+   function Has_Library_Directory (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Library_Declaration;
+   end Has_Library_Directory;
+
+   function Has_Date (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Date;
+
+   function Has_Context_Items (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Context_Items;
+
+   function Has_Dependence_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Dependence_List;
+
+   function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Analysis_Checks_List;
+
+   function Has_Date_State (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Date_State;
+
+   function Has_Guarded_Target_State (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Guarded_Target_State;
+
+   function Has_Library_Unit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Library_Unit;
+
+   function Has_Hash_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Hash_Chain;
+
+   function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Design_Unit_Source_Pos;
+
+   function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Design_Unit_Source_Line;
+
+   function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_Design_Unit_Source_Col;
+
+   function Has_Value (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Integer_Literal
+           | Iir_Kind_Physical_Int_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Value;
+
+   function Has_Enum_Pos (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Enumeration_Literal;
+   end Has_Enum_Pos;
+
+   function Has_Physical_Literal (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Unit_Declaration;
+   end Has_Physical_Literal;
+
+   function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Unit_Declaration;
+   end Has_Physical_Unit_Value;
+
+   function Has_Fp_Value (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Fp_Value;
+
+   function Has_Enumeration_Decl (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Enumeration_Literal;
+   end Has_Enumeration_Decl;
+
+   function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Simple_Aggregate;
+   end Has_Simple_Aggregate_List;
+
+   function Has_Bit_String_Base (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Bit_String_Literal;
+   end Has_Bit_String_Base;
+
+   function Has_Bit_String_0 (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Bit_String_Literal;
+   end Has_Bit_String_0;
+
+   function Has_Bit_String_1 (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Bit_String_Literal;
+   end Has_Bit_String_1;
+
+   function Has_Literal_Origin (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Integer_Literal
+           | Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Enumeration_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Literal_Origin;
+
+   function Has_Range_Origin (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Range_Expression;
+   end Has_Range_Origin;
+
+   function Has_Literal_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Aggregate =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Literal_Subtype;
+
+   function Has_Entity_Class (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Entity_Class
+           | Iir_Kind_Attribute_Specification =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Entity_Class;
+
+   function Has_Entity_Name_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Specification;
+   end Has_Entity_Name_List;
+
+   function Has_Attribute_Designator (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Specification;
+   end Has_Attribute_Designator;
+
+   function Has_Attribute_Specification_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Specification;
+   end Has_Attribute_Specification_Chain;
+
+   function Has_Attribute_Specification (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Value;
+   end Has_Attribute_Specification;
+
+   function Has_Signal_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Disconnection_Specification;
+   end Has_Signal_List;
+
+   function Has_Designated_Entity (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Value;
+   end Has_Designated_Entity;
+
+   function Has_Formal (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Formal;
+
+   function Has_Actual (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_Package =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Actual;
+
+   function Has_In_Conversion (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_By_Expression;
+   end Has_In_Conversion;
+
+   function Has_Out_Conversion (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_By_Expression;
+   end Has_Out_Conversion;
+
+   function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Whole_Association_Flag;
+
+   function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Collapse_Signal_Flag;
+
+   function Has_Artificial_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_Open;
+   end Has_Artificial_Flag;
+
+   function Has_Open_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Interface_Signal_Declaration;
+   end Has_Open_Flag;
+
+   function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_After_Drivers_Flag;
+
+   function Has_We_Value (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Waveform_Element;
+   end Has_We_Value;
+
+   function Has_Time (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Waveform_Element;
+   end Has_Time;
+
+   function Has_Associated_Expr (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Associated_Expr;
+
+   function Has_Associated_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Associated_Chain;
+
+   function Has_Choice_Name (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Choice_By_Name;
+   end Has_Choice_Name;
+
+   function Has_Choice_Expression (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Choice_By_Expression;
+   end Has_Choice_Expression;
+
+   function Has_Choice_Range (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Choice_By_Range;
+   end Has_Choice_Range;
+
+   function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Same_Alternative_Flag;
+
+   function Has_Architecture (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Entity_Aspect_Entity;
+   end Has_Architecture;
+
+   function Has_Block_Specification (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Configuration;
+   end Has_Block_Specification;
+
+   function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Configuration;
+   end Has_Prev_Block_Configuration;
+
+   function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Configuration;
+   end Has_Configuration_Item_Chain;
+
+   function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Attribute_Value_Chain;
+
+   function Has_Spec_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Value;
+   end Has_Spec_Chain;
+
+   function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Specification;
+   end Has_Attribute_Value_Spec_Chain;
+
+   function Has_Entity_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Entity_Aspect_Entity
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Architecture_Body =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Entity_Name;
+
+   function Has_Package (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Package_Body;
+   end Has_Package;
+
+   function Has_Package_Body (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Package_Body;
+
+   function Has_Need_Body (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Package_Declaration;
+   end Has_Need_Body;
+
+   function Has_Block_Configuration (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Block_Configuration;
+
+   function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Concurrent_Statement_Chain;
+
+   function Has_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Design_File
+           | Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Use_Clause
+           | Iir_Kind_Waveform_Element
+           | Iir_Kind_Conditional_Waveform
+           | Iir_Kind_Association_Element_By_Expression
+           | Iir_Kind_Association_Element_By_Individual
+           | Iir_Kind_Association_Element_Open
+           | Iir_Kind_Association_Element_Package
+           | Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name
+           | Iir_Kind_Block_Configuration
+           | Iir_Kind_Component_Configuration
+           | Iir_Kind_Entity_Class
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Record_Element_Resolution
+           | Iir_Kind_Attribute_Specification
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Configuration_Specification
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Chain;
+
+   function Has_Port_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Component_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Port_Chain;
+
+   function Has_Generic_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Header
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Interface_Package_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Generic_Chain;
+
+   function Has_Type (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Integer_Literal
+           | Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_Null_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator
+           | Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Aggregate
+           | Iir_Kind_Parenthesis_Expression
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Psl_Expression
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Base_Attribute
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type;
+
+   function Has_Subtype_Indication (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Allocator_By_Subtype =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subtype_Indication;
+
+   function Has_Discrete_Range (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Iterator_Declaration;
+   end Has_Discrete_Range;
+
+   function Has_Type_Definition (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type_Definition;
+
+   function Has_Subtype_Definition (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Anonymous_Type_Declaration;
+   end Has_Subtype_Definition;
+
+   function Has_Nature (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Terminal_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Nature;
+
+   function Has_Mode (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Mode;
+
+   function Has_Signal_Kind (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Signal_Kind;
+
+   function Has_Base_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Attribute_Value
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Base_Name;
+
+   function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Interface_Declaration_Chain;
+
+   function Has_Subprogram_Specification (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subprogram_Specification;
+
+   function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Sequential_Statement_Chain;
+
+   function Has_Subprogram_Body (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subprogram_Body;
+
+   function Has_Overload_Number (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Overload_Number;
+
+   function Has_Subprogram_Depth (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subprogram_Depth;
+
+   function Has_Subprogram_Hash (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subprogram_Hash;
+
+   function Has_Impure_Depth (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Impure_Depth;
+
+   function Has_Return_Type (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Return_Type;
+
+   function Has_Implicit_Definition (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Implicit_Definition;
+
+   function Has_Type_Reference (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type_Reference;
+
+   function Has_Default_Value (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Default_Value;
+
+   function Has_Deferred_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Constant_Declaration;
+   end Has_Deferred_Declaration;
+
+   function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Constant_Declaration;
+   end Has_Deferred_Declaration_Flag;
+
+   function Has_Shared_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Variable_Declaration;
+   end Has_Shared_Flag;
+
+   function Has_Design_Unit (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Design_Unit;
+
+   function Has_Block_Statement (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Guard_Signal_Declaration;
+   end Has_Block_Statement;
+
+   function Has_Signal_Driver (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Signal_Declaration;
+   end Has_Signal_Driver;
+
+   function Has_Declaration_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Block_Configuration
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Declaration_Chain;
+
+   function Has_File_Logical_Name (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_File_Declaration;
+   end Has_File_Logical_Name;
+
+   function Has_File_Open_Kind (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_File_Declaration;
+   end Has_File_Open_Kind;
+
+   function Has_Element_Position (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Element_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Element_Position;
+
+   function Has_Element_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Record_Element_Constraint;
+   end Has_Element_Declaration;
+
+   function Has_Selected_Element (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Selected_Element;
+   end Has_Selected_Element;
+
+   function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Use_Clause;
+   end Has_Use_Clause_Chain;
+
+   function Has_Selected_Name (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Use_Clause;
+   end Has_Selected_Name;
+
+   function Has_Type_Declarator (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type_Declarator;
+
+   function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Enumeration_Type_Definition;
+   end Has_Enumeration_Literal_List;
+
+   function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Group_Template_Declaration;
+   end Has_Entity_Class_Entry_Chain;
+
+   function Has_Group_Constituent_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Group_Declaration;
+   end Has_Group_Constituent_List;
+
+   function Has_Unit_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Physical_Type_Definition;
+   end Has_Unit_Chain;
+
+   function Has_Primary_Unit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Physical_Type_Definition;
+   end Has_Primary_Unit;
+
+   function Has_Identifier (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Record_Element_Resolution
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Identifier;
+
+   function Has_Label (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Label;
+
+   function Has_Visible_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Visible_Flag;
+
+   function Has_Range_Constraint (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Range_Constraint;
+
+   function Has_Direction (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Range_Expression;
+   end Has_Direction;
+
+   function Has_Left_Limit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Range_Expression;
+   end Has_Left_Limit;
+
+   function Has_Right_Limit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Range_Expression;
+   end Has_Right_Limit;
+
+   function Has_Base_Type (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Base_Type;
+
+   function Has_Resolution_Indication (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Element_Resolution
+           | Iir_Kind_Record_Element_Resolution
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Resolution_Indication;
+
+   function Has_Record_Element_Resolution_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Record_Resolution;
+   end Has_Record_Element_Resolution_Chain;
+
+   function Has_Tolerance (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Subtype_Definition
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Simple_Simultaneous_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Tolerance;
+
+   function Has_Plus_Terminal (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Plus_Terminal;
+
+   function Has_Minus_Terminal (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Minus_Terminal;
+
+   function Has_Simultaneous_Left (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Simple_Simultaneous_Statement;
+   end Has_Simultaneous_Left;
+
+   function Has_Simultaneous_Right (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Simple_Simultaneous_Statement;
+   end Has_Simultaneous_Right;
+
+   function Has_Text_File_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_File_Type_Definition;
+   end Has_Text_File_Flag;
+
+   function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Enumeration_Type_Definition;
+   end Has_Only_Characters_Flag;
+
+   function Has_Type_Staticness (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type_Staticness;
+
+   function Has_Constraint_State (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Constraint_State;
+
+   function Has_Index_Subtype_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Index_Subtype_List;
+
+   function Has_Index_Subtype_Definition_List (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Array_Type_Definition;
+   end Has_Index_Subtype_Definition_List;
+
+   function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Array_Type_Definition;
+   end Has_Element_Subtype_Indication;
+
+   function Has_Element_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Element_Subtype;
+
+   function Has_Index_Constraint_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Array_Subtype_Definition;
+   end Has_Index_Constraint_List;
+
+   function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Array_Subtype_Definition;
+   end Has_Array_Element_Constraint;
+
+   function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Elements_Declaration_List;
+
+   function Has_Designated_Type (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Designated_Type;
+
+   function Has_Designated_Subtype_Indication (K : Iir_Kind)
+      return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Designated_Subtype_Indication;
+
+   function Has_Index_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Indexed_Name;
+   end Has_Index_List;
+
+   function Has_Reference (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Scalar_Nature_Definition;
+   end Has_Reference;
+
+   function Has_Nature_Declarator (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Scalar_Nature_Definition;
+   end Has_Nature_Declarator;
+
+   function Has_Across_Type (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Scalar_Nature_Definition;
+   end Has_Across_Type;
+
+   function Has_Through_Type (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Scalar_Nature_Definition;
+   end Has_Through_Type;
+
+   function Has_Target (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Variable_Assignment_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Target;
+
+   function Has_Waveform_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Conditional_Waveform
+           | Iir_Kind_Signal_Assignment_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Waveform_Chain;
+
+   function Has_Guard (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Guard;
+
+   function Has_Delay_Mechanism (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Delay_Mechanism;
+
+   function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Signal_Assignment_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Reject_Time_Expression;
+
+   function Has_Sensitivity_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Wait_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Sensitivity_List;
+
+   function Has_Process_Origin (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Process_Origin;
+
+   function Has_Condition_Clause (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Wait_Statement;
+   end Has_Condition_Clause;
+
+   function Has_Timeout_Clause (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Wait_Statement;
+   end Has_Timeout_Clause;
+
+   function Has_Postponed_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Postponed_Flag;
+
+   function Has_Callees_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Callees_List;
+
+   function Has_Passive_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Passive_Flag;
+
+   function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Function_Declaration;
+   end Has_Resolution_Function_Flag;
+
+   function Has_Wait_State (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Wait_State;
+
+   function Has_All_Sensitized_State (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_All_Sensitized_State;
+
+   function Has_Seen_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Seen_Flag;
+
+   function Has_Pure_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Pure_Flag;
+
+   function Has_Foreign_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Architecture_Body
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Foreign_Flag;
+
+   function Has_Resolved_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Resolved_Flag;
+
+   function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Signal_Type_Flag;
+
+   function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Incomplete_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Signal_Flag;
+
+   function Has_Purity_State (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Procedure_Declaration;
+   end Has_Purity_State;
+
+   function Has_Elab_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Design_File
+           | Iir_Kind_Design_Unit =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Elab_Flag;
+
+   function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Index_Constraint_Flag;
+
+   function Has_Assertion_Condition (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Assertion_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Assertion_Condition;
+
+   function Has_Report_Expression (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Report_Expression;
+
+   function Has_Severity_Expression (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Severity_Expression;
+
+   function Has_Instantiated_Unit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Component_Instantiation_Statement;
+   end Has_Instantiated_Unit;
+
+   function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Binding_Indication
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Header
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Component_Instantiation_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Generic_Map_Aspect_Chain;
+
+   function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Block_Header
+           | Iir_Kind_Binding_Indication
+           | Iir_Kind_Component_Instantiation_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Port_Map_Aspect_Chain;
+
+   function Has_Configuration_Name (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Entity_Aspect_Configuration;
+   end Has_Configuration_Name;
+
+   function Has_Component_Configuration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Component_Instantiation_Statement;
+   end Has_Component_Configuration;
+
+   function Has_Configuration_Specification (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Component_Instantiation_Statement;
+   end Has_Configuration_Specification;
+
+   function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Component_Instantiation_Statement;
+   end Has_Default_Binding_Indication;
+
+   function Has_Default_Configuration_Declaration (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Architecture_Body;
+   end Has_Default_Configuration_Declaration;
+
+   function Has_Expression (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Attribute_Specification
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Parenthesis_Expression
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Case_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Expression;
+
+   function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Allocator_Designated_Type;
+
+   function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Concurrent_Selected_Signal_Assignment;
+   end Has_Selected_Waveform_Chain;
+
+   function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Concurrent_Conditional_Signal_Assignment;
+   end Has_Conditional_Waveform_Chain;
+
+   function Has_Guard_Expression (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Guard_Signal_Declaration;
+   end Has_Guard_Expression;
+
+   function Has_Guard_Decl (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Statement;
+   end Has_Guard_Decl;
+
+   function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Guard_Signal_Declaration;
+   end Has_Guard_Sensitivity_List;
+
+   function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Statement;
+   end Has_Block_Block_Configuration;
+
+   function Has_Package_Header (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Package_Declaration;
+   end Has_Package_Header;
+
+   function Has_Block_Header (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Block_Statement;
+   end Has_Block_Header;
+
+   function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Interface_Package_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Uninstantiated_Package_Name;
+
+   function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Generate_Statement;
+   end Has_Generate_Block_Configuration;
+
+   function Has_Generation_Scheme (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Generate_Statement;
+   end Has_Generation_Scheme;
+
+   function Has_Condition (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Conditional_Waveform
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Condition;
+
+   function Has_Else_Clause (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Else_Clause;
+
+   function Has_Parameter_Specification (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_For_Loop_Statement;
+   end Has_Parameter_Specification;
+
+   function Has_Parent (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Design_File
+           | Iir_Kind_Design_Unit
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Use_Clause
+           | Iir_Kind_Choice_By_Others
+           | Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range
+           | Iir_Kind_Choice_By_None
+           | Iir_Kind_Choice_By_Name
+           | Iir_Kind_Block_Configuration
+           | Iir_Kind_Component_Configuration
+           | Iir_Kind_Record_Element_Constraint
+           | Iir_Kind_Attribute_Specification
+           | Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Configuration_Specification
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Psl_Default_Clock
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Simple_Simultaneous_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Parent;
+
+   function Has_Loop_Label (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Loop_Label;
+
+   function Has_Component_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Component_Name;
+
+   function Has_Instantiation_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Instantiation_List;
+
+   function Has_Entity_Aspect (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Binding_Indication;
+   end Has_Entity_Aspect;
+
+   function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Binding_Indication;
+   end Has_Default_Entity_Aspect;
+
+   function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Binding_Indication;
+   end Has_Default_Generic_Map_Aspect_Chain;
+
+   function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Binding_Indication;
+   end Has_Default_Port_Map_Aspect_Chain;
+
+   function Has_Binding_Indication (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Component_Configuration
+           | Iir_Kind_Configuration_Specification =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Binding_Indication;
+
+   function Has_Named_Entity (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Named_Entity;
+
+   function Has_Alias_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Alias_Declaration;
+
+   function Has_Expr_Staticness (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Error
+           | Iir_Kind_Integer_Literal
+           | Iir_Kind_Floating_Point_Literal
+           | Iir_Kind_Null_Literal
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Bit_String_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Overflow_Literal
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Range_Expression
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator
+           | Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Aggregate
+           | Iir_Kind_Parenthesis_Expression
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Expr_Staticness;
+
+   function Has_Error_Origin (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Error;
+   end Has_Error_Origin;
+
+   function Has_Operand (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Operand;
+
+   function Has_Left (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Left;
+
+   function Has_Right (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Right;
+
+   function Has_Unit_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Unit_Name;
+
+   function Has_Name (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Name;
+
+   function Has_Group_Template_Name (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Group_Declaration;
+   end Has_Group_Template_Name;
+
+   function Has_Name_Staticness (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Attribute_Value
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Name_Staticness;
+
+   function Has_Prefix (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Base_Attribute
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute
+           | Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Prefix;
+
+   function Has_Signature_Prefix (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Signature;
+   end Has_Signature_Prefix;
+
+   function Has_Slice_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Slice_Name;
+   end Has_Slice_Subtype;
+
+   function Has_Suffix (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Slice_Name;
+   end Has_Suffix;
+
+   function Has_Index_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Index_Subtype;
+
+   function Has_Parameter (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Pos_Attribute
+           | Iir_Kind_Val_Attribute
+           | Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute
+           | Iir_Kind_Length_Array_Attribute
+           | Iir_Kind_Ascending_Array_Attribute
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Parameter;
+
+   function Has_Actual_Type (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_By_Individual;
+   end Has_Actual_Type;
+
+   function Has_Associated_Interface (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_Package;
+   end Has_Associated_Interface;
+
+   function Has_Association_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Parenthesis_Name;
+   end Has_Association_Chain;
+
+   function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Association_Element_By_Individual;
+   end Has_Individual_Association_Chain;
+
+   function Has_Aggregate_Info (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate;
+   end Has_Aggregate_Info;
+
+   function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Sub_Aggregate_Info;
+
+   function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_Dynamic_Flag;
+
+   function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_Min_Length;
+
+   function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_Low_Limit;
+
+   function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_High_Limit;
+
+   function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_Others_Flag;
+
+   function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate_Info;
+   end Has_Aggr_Named_Flag;
+
+   function Has_Value_Staticness (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate;
+   end Has_Value_Staticness;
+
+   function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Aggregate;
+   end Has_Association_Choices_Chain;
+
+   function Has_Case_Statement_Alternative_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Case_Statement;
+   end Has_Case_Statement_Alternative_Chain;
+
+   function Has_Choice_Staticness (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Choice_By_Expression
+           | Iir_Kind_Choice_By_Range =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Choice_Staticness;
+
+   function Has_Procedure_Call (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Procedure_Call_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Procedure_Call;
+
+   function Has_Implementation (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Identity_Operator
+           | Iir_Kind_Negation_Operator
+           | Iir_Kind_Absolute_Operator
+           | Iir_Kind_Not_Operator
+           | Iir_Kind_Condition_Operator
+           | Iir_Kind_Reduction_And_Operator
+           | Iir_Kind_Reduction_Or_Operator
+           | Iir_Kind_Reduction_Nand_Operator
+           | Iir_Kind_Reduction_Nor_Operator
+           | Iir_Kind_Reduction_Xor_Operator
+           | Iir_Kind_Reduction_Xnor_Operator
+           | Iir_Kind_And_Operator
+           | Iir_Kind_Or_Operator
+           | Iir_Kind_Nand_Operator
+           | Iir_Kind_Nor_Operator
+           | Iir_Kind_Xor_Operator
+           | Iir_Kind_Xnor_Operator
+           | Iir_Kind_Equality_Operator
+           | Iir_Kind_Inequality_Operator
+           | Iir_Kind_Less_Than_Operator
+           | Iir_Kind_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Greater_Than_Operator
+           | Iir_Kind_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Equality_Operator
+           | Iir_Kind_Match_Inequality_Operator
+           | Iir_Kind_Match_Less_Than_Operator
+           | Iir_Kind_Match_Less_Than_Or_Equal_Operator
+           | Iir_Kind_Match_Greater_Than_Operator
+           | Iir_Kind_Match_Greater_Than_Or_Equal_Operator
+           | Iir_Kind_Sll_Operator
+           | Iir_Kind_Sla_Operator
+           | Iir_Kind_Srl_Operator
+           | Iir_Kind_Sra_Operator
+           | Iir_Kind_Rol_Operator
+           | Iir_Kind_Ror_Operator
+           | Iir_Kind_Addition_Operator
+           | Iir_Kind_Substraction_Operator
+           | Iir_Kind_Concatenation_Operator
+           | Iir_Kind_Multiplication_Operator
+           | Iir_Kind_Division_Operator
+           | Iir_Kind_Modulus_Operator
+           | Iir_Kind_Remainder_Operator
+           | Iir_Kind_Exponentiation_Operator
+           | Iir_Kind_Function_Call =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Implementation;
+
+   function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Function_Call =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Parameter_Association_Chain;
+
+   function Has_Method_Object (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Procedure_Call
+           | Iir_Kind_Function_Call =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Method_Object;
+
+   function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Subtype_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Subtype_Type_Mark;
+
+   function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Type_Conversion;
+   end Has_Type_Conversion_Subtype;
+
+   function Has_Type_Mark (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Disconnection_Specification
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Qualified_Expression
+           | Iir_Kind_Type_Conversion =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Type_Mark;
+
+   function Has_File_Type_Mark (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_File_Type_Definition;
+   end Has_File_Type_Mark;
+
+   function Has_Return_Type_Mark (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Signature
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Return_Type_Mark;
+
+   function Has_Lexical_Layout (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Lexical_Layout;
+
+   function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Incomplete_Type_Definition;
+   end Has_Incomplete_Type_List;
+
+   function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Disconnect_Flag;
+
+   function Has_Has_Active_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Active_Flag;
+
+   function Has_Is_Within_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_For_Loop_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Is_Within_Flag;
+
+   function Has_Type_Marks_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Signature;
+   end Has_Type_Marks_List;
+
+   function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Non_Object_Alias_Declaration;
+   end Has_Implicit_Alias_Flag;
+
+   function Has_Alias_Signature (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Non_Object_Alias_Declaration;
+   end Has_Alias_Signature;
+
+   function Has_Attribute_Signature (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Attribute_Name;
+   end Has_Attribute_Signature;
+
+   function Has_Overload_List (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Overload_List;
+   end Has_Overload_List;
+
+   function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Simple_Name_Attribute;
+   end Has_Simple_Name_Identifier;
+
+   function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Simple_Name_Attribute;
+   end Has_Simple_Name_Subtype;
+
+   function Has_Protected_Type_Body (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Protected_Type_Declaration;
+   end Has_Protected_Type_Body;
+
+   function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Protected_Type_Body;
+   end Has_Protected_Type_Declaration;
+
+   function Has_End_Location (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Design_Unit;
+   end Has_End_Location;
+
+   function Has_String_Id (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_String_Id;
+
+   function Has_String_Length (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_String_Length;
+
+   function Has_Use_Flag (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Subnature_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Psl_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Use_Flag;
+
+   function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_End_Has_Reserved_Id;
+
+   function Has_End_Has_Identifier (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Protected_Type_Declaration
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Protected_Type_Body
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_Elsif =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_End_Has_Identifier;
+
+   function Has_End_Has_Postponed (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_End_Has_Postponed;
+
+   function Has_Has_Begin (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Generate_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Begin;
+
+   function Has_Has_Is (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Component_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Is;
+
+   function Has_Has_Pure (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Function_Declaration;
+   end Has_Has_Pure;
+
+   function Has_Has_Body (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Body;
+
+   function Has_Has_Identifier_List (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Library_Clause
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Has_Identifier_List;
+
+   function Has_Has_Mode (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_File_Declaration;
+   end Has_Has_Mode;
+
+   function Has_Is_Ref (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Is_Ref;
+
+   function Has_Psl_Property (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_Psl_Property;
+
+   function Has_Psl_Declaration (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Psl_Declaration;
+   end Has_Psl_Declaration;
+
+   function Has_Psl_Expression (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Psl_Expression;
+   end Has_Psl_Expression;
+
+   function Has_Psl_Boolean (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Psl_Default_Clock;
+   end Has_Psl_Boolean;
+
+   function Has_PSL_Clock (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Psl_Declaration
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_PSL_Clock;
+
+   function Has_PSL_NFA (K : Iir_Kind) return Boolean is
+   begin
+      case K is
+         when Iir_Kind_Psl_Declaration
+           | Iir_Kind_Psl_Assert_Statement
+           | Iir_Kind_Psl_Cover_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Has_PSL_NFA;
+
+end Nodes_Meta;
diff --git a/src/nodes_meta.adb.in b/src/nodes_meta.adb.in
new file mode 100644
index 000000000..d94c2d626
--- /dev/null
+++ b/src/nodes_meta.adb.in
@@ -0,0 +1,76 @@
+--  Meta description of nodes.
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Nodes_Meta is
+   Fields_Type : constant array (Fields_Enum) of Types_Enum :=
+     (
+      --  FIELDS_TYPE
+     );
+
+   function Get_Field_Type (F : Fields_Enum) return Types_Enum is
+   begin
+      return Fields_Type (F);
+   end Get_Field_Type;
+
+   function Get_Field_Image (F : Fields_Enum) return String is
+   begin
+      case F is
+         --  FIELD_IMAGE
+      end case;
+   end Get_Field_Image;
+
+   function Get_Iir_Image (K : Iir_Kind) return String is
+   begin
+      case K is
+         --  IIR_IMAGE
+      end case;
+   end Get_Iir_Image;
+
+   function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is
+   begin
+      case F is
+         --  FIELD_ATTRIBUTE
+      end case;
+   end Get_Field_Attribute;
+
+   Fields_Of_Iir : constant Fields_Array :=
+     (
+      --  FIELDS_ARRAY
+     );
+
+   Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer :=
+     (
+      --  FIELDS_ARRAY_POS
+     );
+
+   function Get_Fields (K : Iir_Kind) return Fields_Array
+   is
+      First : Natural;
+      Last : Integer;
+   begin
+      if K = Iir_Kind'First then
+         First := Fields_Of_Iir'First;
+      else
+         First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1;
+      end if;
+      Last := Fields_Of_Iir_Last (K);
+      return Fields_Of_Iir (First .. Last);
+   end Get_Fields;
+
+   --  FUNCS_BODY
+end Nodes_Meta;
diff --git a/src/nodes_meta.ads b/src/nodes_meta.ads
new file mode 100644
index 000000000..2d1f5e1c0
--- /dev/null
+++ b/src/nodes_meta.ads
@@ -0,0 +1,823 @@
+--  Meta description of nodes.
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Iirs; use Iirs;
+with Tokens; use Tokens;
+
+package Nodes_Meta is
+   --  The enumeration of all possible types in the nodes.
+   type Types_Enum is
+     (
+      Type_Base_Type,
+      Type_Boolean,
+      Type_Date_State_Type,
+      Type_Date_Type,
+      Type_Iir,
+      Type_Iir_All_Sensitized,
+      Type_Iir_Constraint,
+      Type_Iir_Delay_Mechanism,
+      Type_Iir_Direction,
+      Type_Iir_Fp64,
+      Type_Iir_Index32,
+      Type_Iir_Int32,
+      Type_Iir_Int64,
+      Type_Iir_Lexical_Layout_Type,
+      Type_Iir_List,
+      Type_Iir_Mode,
+      Type_Iir_Predefined_Functions,
+      Type_Iir_Pure_State,
+      Type_Iir_Signal_Kind,
+      Type_Iir_Staticness,
+      Type_Int32,
+      Type_Location_Type,
+      Type_Name_Id,
+      Type_PSL_NFA,
+      Type_PSL_Node,
+      Type_Source_Ptr,
+      Type_String_Id,
+      Type_Time_Stamp_Id,
+      Type_Token_Type,
+      Type_Tri_State_Type
+     );
+
+   --  The enumeration of all fields defined in iirs.
+   type Fields_Enum is
+     (
+      Field_First_Design_Unit,
+      Field_Last_Design_Unit,
+      Field_Library_Declaration,
+      Field_File_Time_Stamp,
+      Field_Analysis_Time_Stamp,
+      Field_Library,
+      Field_File_Dependence_List,
+      Field_Design_File_Filename,
+      Field_Design_File_Directory,
+      Field_Design_File,
+      Field_Design_File_Chain,
+      Field_Library_Directory,
+      Field_Date,
+      Field_Context_Items,
+      Field_Dependence_List,
+      Field_Analysis_Checks_List,
+      Field_Date_State,
+      Field_Guarded_Target_State,
+      Field_Library_Unit,
+      Field_Hash_Chain,
+      Field_Design_Unit_Source_Pos,
+      Field_Design_Unit_Source_Line,
+      Field_Design_Unit_Source_Col,
+      Field_Value,
+      Field_Enum_Pos,
+      Field_Physical_Literal,
+      Field_Physical_Unit_Value,
+      Field_Fp_Value,
+      Field_Enumeration_Decl,
+      Field_Simple_Aggregate_List,
+      Field_Bit_String_Base,
+      Field_Bit_String_0,
+      Field_Bit_String_1,
+      Field_Literal_Origin,
+      Field_Range_Origin,
+      Field_Literal_Subtype,
+      Field_Entity_Class,
+      Field_Entity_Name_List,
+      Field_Attribute_Designator,
+      Field_Attribute_Specification_Chain,
+      Field_Attribute_Specification,
+      Field_Signal_List,
+      Field_Designated_Entity,
+      Field_Formal,
+      Field_Actual,
+      Field_In_Conversion,
+      Field_Out_Conversion,
+      Field_Whole_Association_Flag,
+      Field_Collapse_Signal_Flag,
+      Field_Artificial_Flag,
+      Field_Open_Flag,
+      Field_After_Drivers_Flag,
+      Field_We_Value,
+      Field_Time,
+      Field_Associated_Expr,
+      Field_Associated_Chain,
+      Field_Choice_Name,
+      Field_Choice_Expression,
+      Field_Choice_Range,
+      Field_Same_Alternative_Flag,
+      Field_Architecture,
+      Field_Block_Specification,
+      Field_Prev_Block_Configuration,
+      Field_Configuration_Item_Chain,
+      Field_Attribute_Value_Chain,
+      Field_Spec_Chain,
+      Field_Attribute_Value_Spec_Chain,
+      Field_Entity_Name,
+      Field_Package,
+      Field_Package_Body,
+      Field_Need_Body,
+      Field_Block_Configuration,
+      Field_Concurrent_Statement_Chain,
+      Field_Chain,
+      Field_Port_Chain,
+      Field_Generic_Chain,
+      Field_Type,
+      Field_Subtype_Indication,
+      Field_Discrete_Range,
+      Field_Type_Definition,
+      Field_Subtype_Definition,
+      Field_Nature,
+      Field_Mode,
+      Field_Signal_Kind,
+      Field_Base_Name,
+      Field_Interface_Declaration_Chain,
+      Field_Subprogram_Specification,
+      Field_Sequential_Statement_Chain,
+      Field_Subprogram_Body,
+      Field_Overload_Number,
+      Field_Subprogram_Depth,
+      Field_Subprogram_Hash,
+      Field_Impure_Depth,
+      Field_Return_Type,
+      Field_Implicit_Definition,
+      Field_Type_Reference,
+      Field_Default_Value,
+      Field_Deferred_Declaration,
+      Field_Deferred_Declaration_Flag,
+      Field_Shared_Flag,
+      Field_Design_Unit,
+      Field_Block_Statement,
+      Field_Signal_Driver,
+      Field_Declaration_Chain,
+      Field_File_Logical_Name,
+      Field_File_Open_Kind,
+      Field_Element_Position,
+      Field_Element_Declaration,
+      Field_Selected_Element,
+      Field_Use_Clause_Chain,
+      Field_Selected_Name,
+      Field_Type_Declarator,
+      Field_Enumeration_Literal_List,
+      Field_Entity_Class_Entry_Chain,
+      Field_Group_Constituent_List,
+      Field_Unit_Chain,
+      Field_Primary_Unit,
+      Field_Identifier,
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Range_Constraint,
+      Field_Direction,
+      Field_Left_Limit,
+      Field_Right_Limit,
+      Field_Base_Type,
+      Field_Resolution_Indication,
+      Field_Record_Element_Resolution_Chain,
+      Field_Tolerance,
+      Field_Plus_Terminal,
+      Field_Minus_Terminal,
+      Field_Simultaneous_Left,
+      Field_Simultaneous_Right,
+      Field_Text_File_Flag,
+      Field_Only_Characters_Flag,
+      Field_Type_Staticness,
+      Field_Constraint_State,
+      Field_Index_Subtype_List,
+      Field_Index_Subtype_Definition_List,
+      Field_Element_Subtype_Indication,
+      Field_Element_Subtype,
+      Field_Index_Constraint_List,
+      Field_Array_Element_Constraint,
+      Field_Elements_Declaration_List,
+      Field_Designated_Type,
+      Field_Designated_Subtype_Indication,
+      Field_Index_List,
+      Field_Reference,
+      Field_Nature_Declarator,
+      Field_Across_Type,
+      Field_Through_Type,
+      Field_Target,
+      Field_Waveform_Chain,
+      Field_Guard,
+      Field_Delay_Mechanism,
+      Field_Reject_Time_Expression,
+      Field_Sensitivity_List,
+      Field_Process_Origin,
+      Field_Condition_Clause,
+      Field_Timeout_Clause,
+      Field_Postponed_Flag,
+      Field_Callees_List,
+      Field_Passive_Flag,
+      Field_Resolution_Function_Flag,
+      Field_Wait_State,
+      Field_All_Sensitized_State,
+      Field_Seen_Flag,
+      Field_Pure_Flag,
+      Field_Foreign_Flag,
+      Field_Resolved_Flag,
+      Field_Signal_Type_Flag,
+      Field_Has_Signal_Flag,
+      Field_Purity_State,
+      Field_Elab_Flag,
+      Field_Index_Constraint_Flag,
+      Field_Assertion_Condition,
+      Field_Report_Expression,
+      Field_Severity_Expression,
+      Field_Instantiated_Unit,
+      Field_Generic_Map_Aspect_Chain,
+      Field_Port_Map_Aspect_Chain,
+      Field_Configuration_Name,
+      Field_Component_Configuration,
+      Field_Configuration_Specification,
+      Field_Default_Binding_Indication,
+      Field_Default_Configuration_Declaration,
+      Field_Expression,
+      Field_Allocator_Designated_Type,
+      Field_Selected_Waveform_Chain,
+      Field_Conditional_Waveform_Chain,
+      Field_Guard_Expression,
+      Field_Guard_Decl,
+      Field_Guard_Sensitivity_List,
+      Field_Block_Block_Configuration,
+      Field_Package_Header,
+      Field_Block_Header,
+      Field_Uninstantiated_Package_Name,
+      Field_Generate_Block_Configuration,
+      Field_Generation_Scheme,
+      Field_Condition,
+      Field_Else_Clause,
+      Field_Parameter_Specification,
+      Field_Parent,
+      Field_Loop_Label,
+      Field_Component_Name,
+      Field_Instantiation_List,
+      Field_Entity_Aspect,
+      Field_Default_Entity_Aspect,
+      Field_Default_Generic_Map_Aspect_Chain,
+      Field_Default_Port_Map_Aspect_Chain,
+      Field_Binding_Indication,
+      Field_Named_Entity,
+      Field_Alias_Declaration,
+      Field_Expr_Staticness,
+      Field_Error_Origin,
+      Field_Operand,
+      Field_Left,
+      Field_Right,
+      Field_Unit_Name,
+      Field_Name,
+      Field_Group_Template_Name,
+      Field_Name_Staticness,
+      Field_Prefix,
+      Field_Signature_Prefix,
+      Field_Slice_Subtype,
+      Field_Suffix,
+      Field_Index_Subtype,
+      Field_Parameter,
+      Field_Actual_Type,
+      Field_Associated_Interface,
+      Field_Association_Chain,
+      Field_Individual_Association_Chain,
+      Field_Aggregate_Info,
+      Field_Sub_Aggregate_Info,
+      Field_Aggr_Dynamic_Flag,
+      Field_Aggr_Min_Length,
+      Field_Aggr_Low_Limit,
+      Field_Aggr_High_Limit,
+      Field_Aggr_Others_Flag,
+      Field_Aggr_Named_Flag,
+      Field_Value_Staticness,
+      Field_Association_Choices_Chain,
+      Field_Case_Statement_Alternative_Chain,
+      Field_Choice_Staticness,
+      Field_Procedure_Call,
+      Field_Implementation,
+      Field_Parameter_Association_Chain,
+      Field_Method_Object,
+      Field_Subtype_Type_Mark,
+      Field_Type_Conversion_Subtype,
+      Field_Type_Mark,
+      Field_File_Type_Mark,
+      Field_Return_Type_Mark,
+      Field_Lexical_Layout,
+      Field_Incomplete_Type_List,
+      Field_Has_Disconnect_Flag,
+      Field_Has_Active_Flag,
+      Field_Is_Within_Flag,
+      Field_Type_Marks_List,
+      Field_Implicit_Alias_Flag,
+      Field_Alias_Signature,
+      Field_Attribute_Signature,
+      Field_Overload_List,
+      Field_Simple_Name_Identifier,
+      Field_Simple_Name_Subtype,
+      Field_Protected_Type_Body,
+      Field_Protected_Type_Declaration,
+      Field_End_Location,
+      Field_String_Id,
+      Field_String_Length,
+      Field_Use_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_End_Has_Postponed,
+      Field_Has_Begin,
+      Field_Has_Is,
+      Field_Has_Pure,
+      Field_Has_Body,
+      Field_Has_Identifier_List,
+      Field_Has_Mode,
+      Field_Is_Ref,
+      Field_Psl_Property,
+      Field_Psl_Declaration,
+      Field_Psl_Expression,
+      Field_Psl_Boolean,
+      Field_PSL_Clock,
+      Field_PSL_NFA
+     );
+   pragma Discard_Names (Fields_Enum);
+
+   --  Return the type of field F.
+   function Get_Field_Type (F : Fields_Enum) return Types_Enum;
+
+   --  Get the name of a field.
+   function Get_Field_Image (F : Fields_Enum) return String;
+
+   --  Get the name of a kind.
+   function Get_Iir_Image (K : Iir_Kind) return String;
+
+   --  Possible attributes of a field.
+   type Field_Attribute is
+     (
+      Attr_None,
+      Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref,
+      Attr_Chain, Attr_Chain_Next
+     );
+
+   --  Get the attribute of a field.
+   function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute;
+
+   type Fields_Array is array (Natural range <>) of Fields_Enum;
+
+   --  Return the list of fields for node K.  The fields are sorted: first
+   --  the non nodes/list of nodes, then the nodes/lists that aren't reference,
+   --  and then the reference.
+   function Get_Fields (K : Iir_Kind) return Fields_Array;
+
+   --  Get/Set a field.
+   function Get_Base_Type
+      (N : Iir; F : Fields_Enum) return Base_Type;
+   procedure Set_Base_Type
+      (N : Iir; F : Fields_Enum; V: Base_Type);
+
+   function Get_Boolean
+      (N : Iir; F : Fields_Enum) return Boolean;
+   procedure Set_Boolean
+      (N : Iir; F : Fields_Enum; V: Boolean);
+
+   function Get_Date_State_Type
+      (N : Iir; F : Fields_Enum) return Date_State_Type;
+   procedure Set_Date_State_Type
+      (N : Iir; F : Fields_Enum; V: Date_State_Type);
+
+   function Get_Date_Type
+      (N : Iir; F : Fields_Enum) return Date_Type;
+   procedure Set_Date_Type
+      (N : Iir; F : Fields_Enum; V: Date_Type);
+
+   function Get_Iir
+      (N : Iir; F : Fields_Enum) return Iir;
+   procedure Set_Iir
+      (N : Iir; F : Fields_Enum; V: Iir);
+
+   function Get_Iir_All_Sensitized
+      (N : Iir; F : Fields_Enum) return Iir_All_Sensitized;
+   procedure Set_Iir_All_Sensitized
+      (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized);
+
+   function Get_Iir_Constraint
+      (N : Iir; F : Fields_Enum) return Iir_Constraint;
+   procedure Set_Iir_Constraint
+      (N : Iir; F : Fields_Enum; V: Iir_Constraint);
+
+   function Get_Iir_Delay_Mechanism
+      (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism;
+   procedure Set_Iir_Delay_Mechanism
+      (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism);
+
+   function Get_Iir_Direction
+      (N : Iir; F : Fields_Enum) return Iir_Direction;
+   procedure Set_Iir_Direction
+      (N : Iir; F : Fields_Enum; V: Iir_Direction);
+
+   function Get_Iir_Fp64
+      (N : Iir; F : Fields_Enum) return Iir_Fp64;
+   procedure Set_Iir_Fp64
+      (N : Iir; F : Fields_Enum; V: Iir_Fp64);
+
+   function Get_Iir_Index32
+      (N : Iir; F : Fields_Enum) return Iir_Index32;
+   procedure Set_Iir_Index32
+      (N : Iir; F : Fields_Enum; V: Iir_Index32);
+
+   function Get_Iir_Int32
+      (N : Iir; F : Fields_Enum) return Iir_Int32;
+   procedure Set_Iir_Int32
+      (N : Iir; F : Fields_Enum; V: Iir_Int32);
+
+   function Get_Iir_Int64
+      (N : Iir; F : Fields_Enum) return Iir_Int64;
+   procedure Set_Iir_Int64
+      (N : Iir; F : Fields_Enum; V: Iir_Int64);
+
+   function Get_Iir_Lexical_Layout_Type
+      (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type;
+   procedure Set_Iir_Lexical_Layout_Type
+      (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type);
+
+   function Get_Iir_List
+      (N : Iir; F : Fields_Enum) return Iir_List;
+   procedure Set_Iir_List
+      (N : Iir; F : Fields_Enum; V: Iir_List);
+
+   function Get_Iir_Mode
+      (N : Iir; F : Fields_Enum) return Iir_Mode;
+   procedure Set_Iir_Mode
+      (N : Iir; F : Fields_Enum; V: Iir_Mode);
+
+   function Get_Iir_Predefined_Functions
+      (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions;
+   procedure Set_Iir_Predefined_Functions
+      (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions);
+
+   function Get_Iir_Pure_State
+      (N : Iir; F : Fields_Enum) return Iir_Pure_State;
+   procedure Set_Iir_Pure_State
+      (N : Iir; F : Fields_Enum; V: Iir_Pure_State);
+
+   function Get_Iir_Signal_Kind
+      (N : Iir; F : Fields_Enum) return Iir_Signal_Kind;
+   procedure Set_Iir_Signal_Kind
+      (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind);
+
+   function Get_Iir_Staticness
+      (N : Iir; F : Fields_Enum) return Iir_Staticness;
+   procedure Set_Iir_Staticness
+      (N : Iir; F : Fields_Enum; V: Iir_Staticness);
+
+   function Get_Int32
+      (N : Iir; F : Fields_Enum) return Int32;
+   procedure Set_Int32
+      (N : Iir; F : Fields_Enum; V: Int32);
+
+   function Get_Location_Type
+      (N : Iir; F : Fields_Enum) return Location_Type;
+   procedure Set_Location_Type
+      (N : Iir; F : Fields_Enum; V: Location_Type);
+
+   function Get_Name_Id
+      (N : Iir; F : Fields_Enum) return Name_Id;
+   procedure Set_Name_Id
+      (N : Iir; F : Fields_Enum; V: Name_Id);
+
+   function Get_PSL_NFA
+      (N : Iir; F : Fields_Enum) return PSL_NFA;
+   procedure Set_PSL_NFA
+      (N : Iir; F : Fields_Enum; V: PSL_NFA);
+
+   function Get_PSL_Node
+      (N : Iir; F : Fields_Enum) return PSL_Node;
+   procedure Set_PSL_Node
+      (N : Iir; F : Fields_Enum; V: PSL_Node);
+
+   function Get_Source_Ptr
+      (N : Iir; F : Fields_Enum) return Source_Ptr;
+   procedure Set_Source_Ptr
+      (N : Iir; F : Fields_Enum; V: Source_Ptr);
+
+   function Get_String_Id
+      (N : Iir; F : Fields_Enum) return String_Id;
+   procedure Set_String_Id
+      (N : Iir; F : Fields_Enum; V: String_Id);
+
+   function Get_Time_Stamp_Id
+      (N : Iir; F : Fields_Enum) return Time_Stamp_Id;
+   procedure Set_Time_Stamp_Id
+      (N : Iir; F : Fields_Enum; V: Time_Stamp_Id);
+
+   function Get_Token_Type
+      (N : Iir; F : Fields_Enum) return Token_Type;
+   procedure Set_Token_Type
+      (N : Iir; F : Fields_Enum; V: Token_Type);
+
+   function Get_Tri_State_Type
+      (N : Iir; F : Fields_Enum) return Tri_State_Type;
+   procedure Set_Tri_State_Type
+      (N : Iir; F : Fields_Enum; V: Tri_State_Type);
+
+   function Has_First_Design_Unit (K : Iir_Kind) return Boolean;
+   function Has_Last_Design_Unit (K : Iir_Kind) return Boolean;
+   function Has_Library_Declaration (K : Iir_Kind) return Boolean;
+   function Has_File_Time_Stamp (K : Iir_Kind) return Boolean;
+   function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean;
+   function Has_Library (K : Iir_Kind) return Boolean;
+   function Has_File_Dependence_List (K : Iir_Kind) return Boolean;
+   function Has_Design_File_Filename (K : Iir_Kind) return Boolean;
+   function Has_Design_File_Directory (K : Iir_Kind) return Boolean;
+   function Has_Design_File (K : Iir_Kind) return Boolean;
+   function Has_Design_File_Chain (K : Iir_Kind) return Boolean;
+   function Has_Library_Directory (K : Iir_Kind) return Boolean;
+   function Has_Date (K : Iir_Kind) return Boolean;
+   function Has_Context_Items (K : Iir_Kind) return Boolean;
+   function Has_Dependence_List (K : Iir_Kind) return Boolean;
+   function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean;
+   function Has_Date_State (K : Iir_Kind) return Boolean;
+   function Has_Guarded_Target_State (K : Iir_Kind) return Boolean;
+   function Has_Library_Unit (K : Iir_Kind) return Boolean;
+   function Has_Hash_Chain (K : Iir_Kind) return Boolean;
+   function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean;
+   function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean;
+   function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean;
+   function Has_Value (K : Iir_Kind) return Boolean;
+   function Has_Enum_Pos (K : Iir_Kind) return Boolean;
+   function Has_Physical_Literal (K : Iir_Kind) return Boolean;
+   function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean;
+   function Has_Fp_Value (K : Iir_Kind) return Boolean;
+   function Has_Enumeration_Decl (K : Iir_Kind) return Boolean;
+   function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean;
+   function Has_Bit_String_Base (K : Iir_Kind) return Boolean;
+   function Has_Bit_String_0 (K : Iir_Kind) return Boolean;
+   function Has_Bit_String_1 (K : Iir_Kind) return Boolean;
+   function Has_Literal_Origin (K : Iir_Kind) return Boolean;
+   function Has_Range_Origin (K : Iir_Kind) return Boolean;
+   function Has_Literal_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Entity_Class (K : Iir_Kind) return Boolean;
+   function Has_Entity_Name_List (K : Iir_Kind) return Boolean;
+   function Has_Attribute_Designator (K : Iir_Kind) return Boolean;
+   function Has_Attribute_Specification_Chain (K : Iir_Kind)
+      return Boolean;
+   function Has_Attribute_Specification (K : Iir_Kind) return Boolean;
+   function Has_Signal_List (K : Iir_Kind) return Boolean;
+   function Has_Designated_Entity (K : Iir_Kind) return Boolean;
+   function Has_Formal (K : Iir_Kind) return Boolean;
+   function Has_Actual (K : Iir_Kind) return Boolean;
+   function Has_In_Conversion (K : Iir_Kind) return Boolean;
+   function Has_Out_Conversion (K : Iir_Kind) return Boolean;
+   function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean;
+   function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean;
+   function Has_Artificial_Flag (K : Iir_Kind) return Boolean;
+   function Has_Open_Flag (K : Iir_Kind) return Boolean;
+   function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean;
+   function Has_We_Value (K : Iir_Kind) return Boolean;
+   function Has_Time (K : Iir_Kind) return Boolean;
+   function Has_Associated_Expr (K : Iir_Kind) return Boolean;
+   function Has_Associated_Chain (K : Iir_Kind) return Boolean;
+   function Has_Choice_Name (K : Iir_Kind) return Boolean;
+   function Has_Choice_Expression (K : Iir_Kind) return Boolean;
+   function Has_Choice_Range (K : Iir_Kind) return Boolean;
+   function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean;
+   function Has_Architecture (K : Iir_Kind) return Boolean;
+   function Has_Block_Specification (K : Iir_Kind) return Boolean;
+   function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean;
+   function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean;
+   function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean;
+   function Has_Spec_Chain (K : Iir_Kind) return Boolean;
+   function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean;
+   function Has_Entity_Name (K : Iir_Kind) return Boolean;
+   function Has_Package (K : Iir_Kind) return Boolean;
+   function Has_Package_Body (K : Iir_Kind) return Boolean;
+   function Has_Need_Body (K : Iir_Kind) return Boolean;
+   function Has_Block_Configuration (K : Iir_Kind) return Boolean;
+   function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean;
+   function Has_Chain (K : Iir_Kind) return Boolean;
+   function Has_Port_Chain (K : Iir_Kind) return Boolean;
+   function Has_Generic_Chain (K : Iir_Kind) return Boolean;
+   function Has_Type (K : Iir_Kind) return Boolean;
+   function Has_Subtype_Indication (K : Iir_Kind) return Boolean;
+   function Has_Discrete_Range (K : Iir_Kind) return Boolean;
+   function Has_Type_Definition (K : Iir_Kind) return Boolean;
+   function Has_Subtype_Definition (K : Iir_Kind) return Boolean;
+   function Has_Nature (K : Iir_Kind) return Boolean;
+   function Has_Mode (K : Iir_Kind) return Boolean;
+   function Has_Signal_Kind (K : Iir_Kind) return Boolean;
+   function Has_Base_Name (K : Iir_Kind) return Boolean;
+   function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean;
+   function Has_Subprogram_Specification (K : Iir_Kind) return Boolean;
+   function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean;
+   function Has_Subprogram_Body (K : Iir_Kind) return Boolean;
+   function Has_Overload_Number (K : Iir_Kind) return Boolean;
+   function Has_Subprogram_Depth (K : Iir_Kind) return Boolean;
+   function Has_Subprogram_Hash (K : Iir_Kind) return Boolean;
+   function Has_Impure_Depth (K : Iir_Kind) return Boolean;
+   function Has_Return_Type (K : Iir_Kind) return Boolean;
+   function Has_Implicit_Definition (K : Iir_Kind) return Boolean;
+   function Has_Type_Reference (K : Iir_Kind) return Boolean;
+   function Has_Default_Value (K : Iir_Kind) return Boolean;
+   function Has_Deferred_Declaration (K : Iir_Kind) return Boolean;
+   function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean;
+   function Has_Shared_Flag (K : Iir_Kind) return Boolean;
+   function Has_Design_Unit (K : Iir_Kind) return Boolean;
+   function Has_Block_Statement (K : Iir_Kind) return Boolean;
+   function Has_Signal_Driver (K : Iir_Kind) return Boolean;
+   function Has_Declaration_Chain (K : Iir_Kind) return Boolean;
+   function Has_File_Logical_Name (K : Iir_Kind) return Boolean;
+   function Has_File_Open_Kind (K : Iir_Kind) return Boolean;
+   function Has_Element_Position (K : Iir_Kind) return Boolean;
+   function Has_Element_Declaration (K : Iir_Kind) return Boolean;
+   function Has_Selected_Element (K : Iir_Kind) return Boolean;
+   function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean;
+   function Has_Selected_Name (K : Iir_Kind) return Boolean;
+   function Has_Type_Declarator (K : Iir_Kind) return Boolean;
+   function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean;
+   function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean;
+   function Has_Group_Constituent_List (K : Iir_Kind) return Boolean;
+   function Has_Unit_Chain (K : Iir_Kind) return Boolean;
+   function Has_Primary_Unit (K : Iir_Kind) return Boolean;
+   function Has_Identifier (K : Iir_Kind) return Boolean;
+   function Has_Label (K : Iir_Kind) return Boolean;
+   function Has_Visible_Flag (K : Iir_Kind) return Boolean;
+   function Has_Range_Constraint (K : Iir_Kind) return Boolean;
+   function Has_Direction (K : Iir_Kind) return Boolean;
+   function Has_Left_Limit (K : Iir_Kind) return Boolean;
+   function Has_Right_Limit (K : Iir_Kind) return Boolean;
+   function Has_Base_Type (K : Iir_Kind) return Boolean;
+   function Has_Resolution_Indication (K : Iir_Kind) return Boolean;
+   function Has_Record_Element_Resolution_Chain (K : Iir_Kind)
+      return Boolean;
+   function Has_Tolerance (K : Iir_Kind) return Boolean;
+   function Has_Plus_Terminal (K : Iir_Kind) return Boolean;
+   function Has_Minus_Terminal (K : Iir_Kind) return Boolean;
+   function Has_Simultaneous_Left (K : Iir_Kind) return Boolean;
+   function Has_Simultaneous_Right (K : Iir_Kind) return Boolean;
+   function Has_Text_File_Flag (K : Iir_Kind) return Boolean;
+   function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean;
+   function Has_Type_Staticness (K : Iir_Kind) return Boolean;
+   function Has_Constraint_State (K : Iir_Kind) return Boolean;
+   function Has_Index_Subtype_List (K : Iir_Kind) return Boolean;
+   function Has_Index_Subtype_Definition_List (K : Iir_Kind)
+      return Boolean;
+   function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean;
+   function Has_Element_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Index_Constraint_List (K : Iir_Kind) return Boolean;
+   function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean;
+   function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean;
+   function Has_Designated_Type (K : Iir_Kind) return Boolean;
+   function Has_Designated_Subtype_Indication (K : Iir_Kind)
+      return Boolean;
+   function Has_Index_List (K : Iir_Kind) return Boolean;
+   function Has_Reference (K : Iir_Kind) return Boolean;
+   function Has_Nature_Declarator (K : Iir_Kind) return Boolean;
+   function Has_Across_Type (K : Iir_Kind) return Boolean;
+   function Has_Through_Type (K : Iir_Kind) return Boolean;
+   function Has_Target (K : Iir_Kind) return Boolean;
+   function Has_Waveform_Chain (K : Iir_Kind) return Boolean;
+   function Has_Guard (K : Iir_Kind) return Boolean;
+   function Has_Delay_Mechanism (K : Iir_Kind) return Boolean;
+   function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean;
+   function Has_Sensitivity_List (K : Iir_Kind) return Boolean;
+   function Has_Process_Origin (K : Iir_Kind) return Boolean;
+   function Has_Condition_Clause (K : Iir_Kind) return Boolean;
+   function Has_Timeout_Clause (K : Iir_Kind) return Boolean;
+   function Has_Postponed_Flag (K : Iir_Kind) return Boolean;
+   function Has_Callees_List (K : Iir_Kind) return Boolean;
+   function Has_Passive_Flag (K : Iir_Kind) return Boolean;
+   function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean;
+   function Has_Wait_State (K : Iir_Kind) return Boolean;
+   function Has_All_Sensitized_State (K : Iir_Kind) return Boolean;
+   function Has_Seen_Flag (K : Iir_Kind) return Boolean;
+   function Has_Pure_Flag (K : Iir_Kind) return Boolean;
+   function Has_Foreign_Flag (K : Iir_Kind) return Boolean;
+   function Has_Resolved_Flag (K : Iir_Kind) return Boolean;
+   function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean;
+   function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean;
+   function Has_Purity_State (K : Iir_Kind) return Boolean;
+   function Has_Elab_Flag (K : Iir_Kind) return Boolean;
+   function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean;
+   function Has_Assertion_Condition (K : Iir_Kind) return Boolean;
+   function Has_Report_Expression (K : Iir_Kind) return Boolean;
+   function Has_Severity_Expression (K : Iir_Kind) return Boolean;
+   function Has_Instantiated_Unit (K : Iir_Kind) return Boolean;
+   function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean;
+   function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean;
+   function Has_Configuration_Name (K : Iir_Kind) return Boolean;
+   function Has_Component_Configuration (K : Iir_Kind) return Boolean;
+   function Has_Configuration_Specification (K : Iir_Kind) return Boolean;
+   function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean;
+   function Has_Default_Configuration_Declaration (K : Iir_Kind)
+      return Boolean;
+   function Has_Expression (K : Iir_Kind) return Boolean;
+   function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean;
+   function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean;
+   function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean;
+   function Has_Guard_Expression (K : Iir_Kind) return Boolean;
+   function Has_Guard_Decl (K : Iir_Kind) return Boolean;
+   function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean;
+   function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean;
+   function Has_Package_Header (K : Iir_Kind) return Boolean;
+   function Has_Block_Header (K : Iir_Kind) return Boolean;
+   function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean;
+   function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean;
+   function Has_Generation_Scheme (K : Iir_Kind) return Boolean;
+   function Has_Condition (K : Iir_Kind) return Boolean;
+   function Has_Else_Clause (K : Iir_Kind) return Boolean;
+   function Has_Parameter_Specification (K : Iir_Kind) return Boolean;
+   function Has_Parent (K : Iir_Kind) return Boolean;
+   function Has_Loop_Label (K : Iir_Kind) return Boolean;
+   function Has_Component_Name (K : Iir_Kind) return Boolean;
+   function Has_Instantiation_List (K : Iir_Kind) return Boolean;
+   function Has_Entity_Aspect (K : Iir_Kind) return Boolean;
+   function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean;
+   function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind)
+      return Boolean;
+   function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind)
+      return Boolean;
+   function Has_Binding_Indication (K : Iir_Kind) return Boolean;
+   function Has_Named_Entity (K : Iir_Kind) return Boolean;
+   function Has_Alias_Declaration (K : Iir_Kind) return Boolean;
+   function Has_Expr_Staticness (K : Iir_Kind) return Boolean;
+   function Has_Error_Origin (K : Iir_Kind) return Boolean;
+   function Has_Operand (K : Iir_Kind) return Boolean;
+   function Has_Left (K : Iir_Kind) return Boolean;
+   function Has_Right (K : Iir_Kind) return Boolean;
+   function Has_Unit_Name (K : Iir_Kind) return Boolean;
+   function Has_Name (K : Iir_Kind) return Boolean;
+   function Has_Group_Template_Name (K : Iir_Kind) return Boolean;
+   function Has_Name_Staticness (K : Iir_Kind) return Boolean;
+   function Has_Prefix (K : Iir_Kind) return Boolean;
+   function Has_Signature_Prefix (K : Iir_Kind) return Boolean;
+   function Has_Slice_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Suffix (K : Iir_Kind) return Boolean;
+   function Has_Index_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Parameter (K : Iir_Kind) return Boolean;
+   function Has_Actual_Type (K : Iir_Kind) return Boolean;
+   function Has_Associated_Interface (K : Iir_Kind) return Boolean;
+   function Has_Association_Chain (K : Iir_Kind) return Boolean;
+   function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean;
+   function Has_Aggregate_Info (K : Iir_Kind) return Boolean;
+   function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean;
+   function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean;
+   function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean;
+   function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean;
+   function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean;
+   function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean;
+   function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean;
+   function Has_Value_Staticness (K : Iir_Kind) return Boolean;
+   function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean;
+   function Has_Case_Statement_Alternative_Chain (K : Iir_Kind)
+      return Boolean;
+   function Has_Choice_Staticness (K : Iir_Kind) return Boolean;
+   function Has_Procedure_Call (K : Iir_Kind) return Boolean;
+   function Has_Implementation (K : Iir_Kind) return Boolean;
+   function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean;
+   function Has_Method_Object (K : Iir_Kind) return Boolean;
+   function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean;
+   function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Type_Mark (K : Iir_Kind) return Boolean;
+   function Has_File_Type_Mark (K : Iir_Kind) return Boolean;
+   function Has_Return_Type_Mark (K : Iir_Kind) return Boolean;
+   function Has_Lexical_Layout (K : Iir_Kind) return Boolean;
+   function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean;
+   function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean;
+   function Has_Has_Active_Flag (K : Iir_Kind) return Boolean;
+   function Has_Is_Within_Flag (K : Iir_Kind) return Boolean;
+   function Has_Type_Marks_List (K : Iir_Kind) return Boolean;
+   function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean;
+   function Has_Alias_Signature (K : Iir_Kind) return Boolean;
+   function Has_Attribute_Signature (K : Iir_Kind) return Boolean;
+   function Has_Overload_List (K : Iir_Kind) return Boolean;
+   function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean;
+   function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean;
+   function Has_Protected_Type_Body (K : Iir_Kind) return Boolean;
+   function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean;
+   function Has_End_Location (K : Iir_Kind) return Boolean;
+   function Has_String_Id (K : Iir_Kind) return Boolean;
+   function Has_String_Length (K : Iir_Kind) return Boolean;
+   function Has_Use_Flag (K : Iir_Kind) return Boolean;
+   function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean;
+   function Has_End_Has_Identifier (K : Iir_Kind) return Boolean;
+   function Has_End_Has_Postponed (K : Iir_Kind) return Boolean;
+   function Has_Has_Begin (K : Iir_Kind) return Boolean;
+   function Has_Has_Is (K : Iir_Kind) return Boolean;
+   function Has_Has_Pure (K : Iir_Kind) return Boolean;
+   function Has_Has_Body (K : Iir_Kind) return Boolean;
+   function Has_Has_Identifier_List (K : Iir_Kind) return Boolean;
+   function Has_Has_Mode (K : Iir_Kind) return Boolean;
+   function Has_Is_Ref (K : Iir_Kind) return Boolean;
+   function Has_Psl_Property (K : Iir_Kind) return Boolean;
+   function Has_Psl_Declaration (K : Iir_Kind) return Boolean;
+   function Has_Psl_Expression (K : Iir_Kind) return Boolean;
+   function Has_Psl_Boolean (K : Iir_Kind) return Boolean;
+   function Has_PSL_Clock (K : Iir_Kind) return Boolean;
+   function Has_PSL_NFA (K : Iir_Kind) return Boolean;
+end Nodes_Meta;
diff --git a/src/nodes_meta.ads.in b/src/nodes_meta.ads.in
new file mode 100644
index 000000000..8e1dceca9
--- /dev/null
+++ b/src/nodes_meta.ads.in
@@ -0,0 +1,66 @@
+--  Meta description of nodes.
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Iirs; use Iirs;
+with Tokens; use Tokens;
+
+package Nodes_Meta is
+   --  The enumeration of all possible types in the nodes.
+   type Types_Enum is
+     (
+      --  TYPES
+     );
+
+   --  The enumeration of all fields defined in iirs.
+   type Fields_Enum is
+     (
+      --  FIELDS
+     );
+   pragma Discard_Names (Fields_Enum);
+
+   --  Return the type of field F.
+   function Get_Field_Type (F : Fields_Enum) return Types_Enum;
+
+   --  Get the name of a field.
+   function Get_Field_Image (F : Fields_Enum) return String;
+
+   --  Get the name of a kind.
+   function Get_Iir_Image (K : Iir_Kind) return String;
+
+   --  Possible attributes of a field.
+   type Field_Attribute is
+     (
+      Attr_None,
+      Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref,
+      Attr_Chain, Attr_Chain_Next
+     );
+
+   --  Get the attribute of a field.
+   function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute;
+
+   type Fields_Array is array (Natural range <>) of Fields_Enum;
+
+   --  Return the list of fields for node K.  The fields are sorted: first
+   --  the non nodes/list of nodes, then the nodes/lists that aren't reference,
+   --  and then the reference.
+   function Get_Fields (K : Iir_Kind) return Fields_Array;
+
+   --  Get/Set a field.
+   --  FUNCS
+end Nodes_Meta;
diff --git a/src/options.adb b/src/options.adb
new file mode 100644
index 000000000..7af0804a4
--- /dev/null
+++ b/src/options.adb
@@ -0,0 +1,242 @@
+--  Command line options.
+--  Copyright (C) 2008 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO; use Ada.Text_IO;
+with Name_Table;
+with Libraries;
+with Std_Names;
+with PSL.Nodes;
+with PSL.Dump_Tree;
+with Disp_Tree;
+with Scanner;
+with Back_End; use Back_End;
+with Flags; use Flags;
+
+package body Options is
+   procedure Initialize is
+   begin
+      Std_Names.Std_Names_Initialize;
+      Libraries.Init_Pathes;
+      PSL.Nodes.Init;
+      PSL.Dump_Tree.Dump_Hdl_Node := Disp_Tree.Disp_Tree_For_Psl'Access;
+   end Initialize;
+
+   function Option_Warning (Opt: String; Val : Boolean) return Boolean is
+   begin
+--      if Opt = "undriven" then
+--         Warn_Undriven := True;
+      if Opt = "library" then
+         Warn_Library := Val;
+      elsif Opt = "default-binding" then
+         Warn_Default_Binding := Val;
+      elsif Opt = "binding" then
+         Warn_Binding := Val;
+      elsif Opt = "reserved" then
+         Warn_Reserved_Word := Val;
+      elsif Opt = "vital-generic" then
+         Warn_Vital_Generic := Val;
+      elsif Opt = "delayed-checks" then
+         Warn_Delayed_Checks := Val;
+      elsif Opt = "body" then
+         Warn_Body := Val;
+      elsif Opt = "specs" then
+         Warn_Specs := Val;
+      elsif Opt = "unused" then
+         Warn_Unused := Val;
+      elsif Opt = "error" then
+         Warn_Error := Val;
+      else
+         return False;
+      end if;
+      return True;
+   end Option_Warning;
+
+   function Parse_Option (Opt: String) return Boolean
+   is
+      Beg: constant Integer := Opt'First;
+   begin
+      if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then
+         if Opt'Length = 8 then
+            if Opt (Beg + 6 .. Beg + 7) = "87" then
+               Vhdl_Std := Vhdl_87;
+            elsif Opt (Beg + 6 .. Beg + 7) = "93" then
+               Vhdl_Std := Vhdl_93;
+            elsif Opt (Beg + 6 .. Beg + 7) = "00" then
+               Vhdl_Std := Vhdl_00;
+            elsif Opt (Beg + 6 .. Beg + 7) = "02" then
+               Vhdl_Std := Vhdl_02;
+            elsif Opt (Beg + 6 .. Beg + 7) = "08" then
+               Vhdl_Std := Vhdl_08;
+            else
+               return False;
+            end if;
+         elsif Opt'Length = 9 and then Opt (Beg + 6 .. Beg + 8) = "93c" then
+            Vhdl_Std := Vhdl_93c;
+         else
+            return False;
+         end if;
+      elsif Opt'Length = 5 and then Opt (Beg .. Beg + 4) = "--ams" then
+         AMS_Vhdl := True;
+      elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then
+         Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last));
+      elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then
+         Libraries.Set_Work_Library_Path (Opt (Beg + 10 .. Opt'Last));
+      elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--warn-no-" then
+         return Option_Warning (Opt (Beg + 10 .. Opt'Last), False);
+      elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then
+         return Option_Warning (Opt (Beg + 7 .. Opt'Last), True);
+      elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--work=" then
+         declare
+            use Name_Table;
+         begin
+            Name_Length := Opt'Last - (Beg + 7) + 1;
+            Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last);
+            Scanner.Convert_Identifier;
+            Libraries.Work_Library_Name := Get_Identifier;
+         end;
+      elsif Opt = "-C" or else Opt = "--mb-comments" then
+         Mb_Comment := True;
+      elsif Opt = "--bootstrap" then
+         Bootstrap := True;
+      elsif Opt = "-fexplicit" then
+         Flag_Explicit := True;
+      elsif Opt = "-frelaxed-rules" then
+         Flag_Relaxed_Rules := True;
+      elsif Opt = "--syn-binding" then
+         Flag_Syn_Binding := True;
+      elsif Opt = "--no-vital-checks" then
+         Flag_Vital_Checks := False;
+      elsif Opt = "--vital-checks" then
+         Flag_Vital_Checks := True;
+      elsif Opt = "-fpsl" then
+         Scanner.Flag_Psl_Comment := True;
+         Scanner.Flag_Comment_Keyword := True;
+      elsif Opt = "-dp" then
+         Dump_Parse := True;
+      elsif Opt = "-ds" then
+         Dump_Sem := True;
+      elsif Opt = "-dc" then
+         Dump_Canon := True;
+      elsif Opt = "-da" then
+         Dump_Annotate := True;
+      elsif Opt = "--dall" then
+         Dump_All := True;
+      elsif Opt = "-dstats" then
+         Dump_Stats := True;
+      elsif Opt = "--lall" then
+         List_All := True;
+      elsif Opt = "-lv" then
+         List_Verbose := True;
+      elsif Opt = "-ls" then
+         List_Sem := True;
+      elsif Opt = "-lc" then
+         List_Canon := True;
+      elsif Opt = "-la" then
+         List_Annotate := True;
+      elsif Opt = "-v" then
+         Verbose := True;
+      elsif Opt = "--finteger64" then
+         Flag_Integer_64 := True;
+      elsif Opt = "--ftime32" then
+         Flag_Time_64 := False;
+--       elsif Opt'Length > 17
+--         and then Opt (Beg .. Beg + 17) = "--time-resolution="
+--       then
+--          Beg := Beg + 18;
+--          if Opt (Beg .. Beg + 1) = "fs" then
+--             Time_Resolution := 'f';
+--          elsif Opt (Beg .. Beg + 1) = "ps" then
+--             Time_Resolution := 'p';
+--          elsif Opt (Beg .. Beg + 1) = "ns" then
+--             Time_Resolution := 'n';
+--          elsif Opt (Beg .. Beg + 1) = "us" then
+--             Time_Resolution := 'u';
+--          elsif Opt (Beg .. Beg + 1) = "ms" then
+--             Time_Resolution := 'm';
+--          elsif Opt (Beg .. Beg + 2) = "sec" then
+--             Time_Resolution := 's';
+--          elsif Opt (Beg .. Beg + 2) = "min" then
+--             Time_Resolution := 'M';
+--          elsif Opt (Beg .. Beg + 1) = "hr" then
+--             Time_Resolution := 'h';
+--          else
+--             return False;
+--          end if;
+      elsif Back_End.Parse_Option /= null
+        and then Back_End.Parse_Option.all (Opt)
+      then
+         null;
+      else
+         return False;
+      end if;
+      return True;
+   end Parse_Option;
+
+   -- Disp help about these options.
+   procedure Disp_Options_Help
+   is
+      procedure P (S : String) renames Put_Line;
+   begin
+      P ("Main options:");
+      P ("  --work=LIB         use LIB as work library");
+      P ("  --workdir=DIR      use DIR for the file library");
+      P ("  -PPATH             add PATH in the library path list");
+      P ("  --std=87/93/00/02/08  select vhdl 87/93/00/02/08 standard");
+      P ("  --std=93c          select vhdl 93 standard and allow 87 syntax");
+      P ("  --[no-]vital-checks  do [not] check VITAL restrictions");
+      P ("Warnings:");
+--    P ("  --warn-undriven    disp undriven signals");
+      P ("  --warn-binding     warns for component not bound");
+      P ("  --warn-reserved    warns use of 93 reserved words in vhdl87");
+      P ("  --warn-library     warns for redefinition of a design unit");
+      P ("  --warn-vital-generic  warns of non-vital generic names");
+      P ("  --warn-delayed-checks warns for checks performed at elaboration");
+      P ("  --warn-body        warns for not necessary package body");
+      P ("  --warn-specs       warns if a all/others spec does not apply");
+      P ("  --warn-unused      warns if a subprogram is never used");
+      P ("  --warn-error       turns warnings into errors");
+--    P ("Simulation option:");
+--    P ("  --time-resolution=UNIT   set the resolution of type time");
+--    P ("            UNIT can be fs, ps, ns, us, ms, sec, min or hr");
+--    P ("  --assert-level=LEVEL     set the level which stop the");
+--    P ("           simulation.  LEVEL is note, warning, error,");
+--    P ("           failure or none");
+      P ("Extensions:");
+      P ("  -fexplicit         give priority to explicitly declared operator");
+      P ("  -frelaxed-rules    relax some LRM rules");
+      P ("  -C  --mb-comments  allow multi-bytes chars in a comment");
+      P ("  --bootstrap        allow --work=std");
+      P ("  --syn-binding      use synthesis default binding rule");
+      P ("  -fpsl              parse psl in comments");
+      P ("Compilation list:");
+      P ("  -ls                after semantics");
+      P ("  -lc                after canon");
+      P ("  -la                after annotation");
+      P ("  --lall             -lX options apply to all files");
+      P ("  -lv                verbose list");
+      P ("  -v                 disp compilation stages");
+      P ("Compilation dump:");
+      P ("  -dp                dump tree after parsing");
+      P ("  -ds                dump tree after semantics");
+      P ("  -da                dump tree after annotate");
+      P ("  --dall             -dX options apply to all files");
+      if Back_End.Disp_Option /= null then
+         Back_End.Disp_Option.all;
+      end if;
+   end Disp_Options_Help;
+
+end Options;
diff --git a/src/options.ads b/src/options.ads
new file mode 100644
index 000000000..24a844b59
--- /dev/null
+++ b/src/options.ads
@@ -0,0 +1,30 @@
+--  Command line options.
+--  Copyright (C) 2008 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Options is
+   -- Return true if opt is recognize by flags.
+   --  Note: std_names.std_names_initialize and files_map.init_pathes must have
+   --  been called before this subprogram.
+   function Parse_Option (Opt: String) return Boolean;
+
+   -- Disp help about these options.
+   procedure Disp_Options_Help;
+
+   --  Front-end intialization.
+   procedure Initialize;
+end Options;
diff --git a/src/ortho/Makefile.inc b/src/ortho/Makefile.inc
new file mode 100644
index 000000000..597aaeff1
--- /dev/null
+++ b/src/ortho/Makefile.inc
@@ -0,0 +1,38 @@
+#  Common -*- Makefile -*- for ortho implementations.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+# Variable to be defined:
+#   SED: sed the stream editor
+#   ORTHO_BASENAME
+
+$(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).ads: \
+  $(ortho_srcdir)/ortho_nodes.common.ads \
+  $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads
+	$(RM) -f $@
+	echo "--  DO NOT MODIFY - this file was generated from:" > $@
+	echo "--  ortho_nodes.common.ads and $(ORTHO_BASENAME).private.ads" \
+	  >> $@
+	echo "--" >> $@
+	$(SED) -e '/^private/,$$d' \
+	  < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@
+	echo "--  Start of common part" >> $@
+	$(SED) -e '1,/^package/d' -e '/^private/,$$d' < $< >> $@
+	echo "--  End of common part" >> $@
+	$(SED) -n -e '/^private/,$$p' \
+	  < $(ortho_srcdir)/$(BE)/$(ORTHO_BASENAME).private.ads >> $@
+	chmod a-w $@
diff --git a/src/ortho/debug/Makefile b/src/ortho/debug/Makefile
new file mode 100644
index 000000000..0c15111ef
--- /dev/null
+++ b/src/ortho/debug/Makefile
@@ -0,0 +1,47 @@
+#  -*- Makefile -*- for the ortho-code back-end
+#  Copyright (C) 2005 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.
+BE=debug
+ortho_srcdir=..
+
+orthobe_srcdir=$(ortho_srcdir)/$(BE)
+
+GNATMAKE=gnatmake
+CC=gcc
+CFLAGS=-g
+ALL_GNAT_FLAGS=-pipe -g -gnato -gnatwl -gnatf -gnaty3befhkmr -gnatwu
+GNATMAKE_FLAGS=-m $(ALL_GNAT_FLAGS) $(GNAT_FLAGS) -aI$(ortho_srcdir) -aI$(orthobe_srcdir) -aI.
+#LARGS=-largs -static
+SED=sed
+
+all: $(ortho_exec)
+
+
+$(ortho_exec): force $(ortho_srcdir)/$(BE)/ortho_debug.ads
+	gnatmake -o $@ $(GNATMAKE_FLAGS) ortho_debug-main -bargs -E $(LARGS)
+
+clean:
+	$(RM) -f *.o *.ali *~ b~*.ad? ortho_nodes-main
+	$(RM) ortho_debug.ads
+
+force:
+
+ORTHO_BASENAME=ortho_debug
+
+# Automatically build ortho_debug.ads from ortho_node.common.ads and
+# ortho_debug.private.ads
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb
new file mode 100644
index 000000000..2725668bb
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-disp.adb
@@ -0,0 +1,1064 @@
+--  Display the code from the ortho debug tree.
+--  Copyright (C) 2005 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.
+
+package body Ortho_Debug.Disp is
+   Disp_All_Types : constant Boolean := False;
+
+   package Formated_Output is
+      use Interfaces.C_Streams;
+
+      type Disp_Context is limited private;
+
+      procedure Init_Context (File : FILEs);
+
+      --  Save the current context, and create a new one.
+      procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context);
+
+      --  Restore a previous context, saved by Push_Context.
+      procedure Pop_Context (Prev_Ctx : Disp_Context);
+
+      procedure Put (Str : String);
+
+      procedure Put_Line (Str : String);
+
+      --  Add a tabulation.
+      --  Every new line will start at this tabulation.
+      procedure Add_Tab;
+
+      --  Removed a tabulation.
+      --  The next new line will start at the previous tabulation.
+      procedure Rem_Tab;
+
+      --  Flush the current output.
+      procedure Flush;
+
+      --  Return TRUE if the ident level is nul.
+      function Is_Top return Boolean;
+
+      procedure Put_Tab;
+
+      procedure New_Line;
+
+      procedure Put (C : Character);
+
+      procedure Put_Trim (Str : String);
+
+      procedure Set_Mark;
+
+      --  Flush to disk.  Only for debugging in case of crash.
+      procedure Flush_File;
+      pragma Unreferenced (Flush_File);
+   private
+      type Disp_Context is record
+         --  File where the info are written to.
+         File : FILEs;
+         --  Line number of the line to be written.
+         Lineno : Natural;
+         --  Buffer for the current line.
+         Line : String (1 .. 256);
+         --  Number of characters currently in the line.
+         Line_Len : Natural;
+
+         --  Current tabulation.
+         Tab : Natural;
+         --  Tabulation to be used for the next line.
+         Next_Tab : Natural;
+
+         Mark : Natural;
+      end record;
+   end Formated_Output;
+
+   package body Formated_Output is
+      --  The current context.
+      Ctx : Disp_Context;
+
+      procedure Init_Context (File : FILEs) is
+      begin
+         Ctx.File := File;
+         Ctx.Lineno := 1;
+         Ctx.Line_Len := 0;
+         Ctx.Tab := 0;
+         Ctx.Next_Tab := 0;
+         Ctx.Mark := 0;
+      end Init_Context;
+
+      procedure Push_Context (File : FILEs; Prev_Ctx : out Disp_Context)
+      is
+      begin
+         Prev_Ctx := Ctx;
+         Init_Context (File);
+      end Push_Context;
+
+      --  Restore a previous context, saved by Push_Context.
+      procedure Pop_Context (Prev_Ctx : Disp_Context) is
+      begin
+         Flush;
+         Ctx := Prev_Ctx;
+      end Pop_Context;
+
+      procedure Flush
+      is
+         Status : size_t;
+         Res : int;
+         pragma Unreferenced (Status, Res);
+      begin
+         if Ctx.Line_Len > 0 then
+            Status := fwrite (Ctx.Line'Address, size_t (Ctx.Line_Len), 1,
+                              Ctx.File);
+            Res := fputc (Character'Pos (ASCII.Lf), Ctx.File);
+            Ctx.Line_Len := 0;
+         end if;
+         Ctx.Mark := 0;
+      end Flush;
+
+      function Is_Top return Boolean is
+      begin
+         return Ctx.Tab = 0;
+      end Is_Top;
+
+      procedure Put_Tab
+      is
+         Tab : Natural := Ctx.Next_Tab;
+         Max_Tab : constant Natural := 40;
+      begin
+         if Tab > Max_Tab then
+            --  Limit indentation length, to limit line length.
+            Tab := Max_Tab;
+         end if;
+
+         Ctx.Line (1 .. Tab) := (others => ' ');
+         Ctx.Line_Len := Tab;
+         Ctx.Next_Tab := Ctx.Tab + 2;
+      end Put_Tab;
+
+      procedure Put (Str : String) is
+         Saved : String (1 .. 80);
+         Len : Natural;
+      begin
+         if Ctx.Line_Len + Str'Length >= 80 then
+            if Ctx.Mark > 0 then
+               Len := Ctx.Line_Len - Ctx.Mark + 1;
+               Saved (1 .. Len) := Ctx.Line (Ctx.Mark .. Ctx.Line_Len);
+               Ctx.Line_Len := Ctx.Mark - 1;
+               Flush;
+               Put_Tab;
+               Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Len) :=
+                 Saved (1 .. Len);
+               Ctx.Line_Len := Ctx.Line_Len + Len;
+            else
+               Flush;
+            end if;
+         end if;
+         if Ctx.Line_Len = 0 then
+            Put_Tab;
+         end if;
+         Ctx.Line (Ctx.Line_Len + 1 .. Ctx.Line_Len + Str'Length) := Str;
+         Ctx.Line_Len := Ctx.Line_Len + Str'Length;
+      end Put;
+
+      procedure Put_Trim (Str : String) is
+      begin
+         for I in Str'Range loop
+            if Str (I) /= ' ' then
+               Put (Str (I .. Str'Last));
+               return;
+            end if;
+         end loop;
+      end Put_Trim;
+
+      procedure Put_Line (Str : String) is
+      begin
+         Put (Str);
+         Flush;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Put_Line;
+
+      procedure New_Line
+      is
+         Status : int;
+         pragma Unreferenced (Status);
+      begin
+         if Ctx.Line_Len > 0 then
+            Flush;
+         else
+            Status := fputc (Character'Pos (ASCII.LF), Ctx.File);
+         end if;
+         Ctx.Next_Tab := Ctx.Tab;
+      end New_Line;
+
+      procedure Put (C : Character)
+      is
+         S : constant String (1 .. 1) := (1 => C);
+      begin
+         Put (S);
+      end Put;
+
+      --  Add a tabulation.
+      --  Every new line will start at this tabulation.
+      procedure Add_Tab is
+      begin
+         Ctx.Tab := Ctx.Tab + 2;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Add_Tab;
+
+      --  Removed a tabulation.
+      --  The next new line will start at the previous tabulation.
+      procedure Rem_Tab is
+      begin
+         Ctx.Tab := Ctx.Tab - 2;
+         Ctx.Next_Tab := Ctx.Tab;
+      end Rem_Tab;
+
+      procedure Set_Mark is
+      begin
+         Ctx.Mark := Ctx.Line_Len;
+      end Set_Mark;
+
+      procedure Flush_File is
+         Status : int;
+         pragma Unreferenced (Status);
+      begin
+         Flush;
+         Status := fflush (Ctx.File);
+      end Flush_File;
+   end Formated_Output;
+
+   use Formated_Output;
+
+   procedure Init_Context (File : Interfaces.C_Streams.FILEs) is
+   begin
+      Formated_Output.Init_Context (File);
+   end Init_Context;
+
+   procedure Disp_Enode (E : O_Enode; Etype : O_Tnode);
+   procedure Disp_Lnode (Node : O_Lnode);
+   procedure Disp_Snode (First, Last : O_Snode);
+   procedure Disp_Dnode (Decl : O_Dnode);
+   procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean);
+
+   procedure Disp_Ident (Id : O_Ident) is
+   begin
+      Put (Get_String (Id));
+   end Disp_Ident;
+
+   procedure Disp_Tnode_Name (Atype : O_Tnode) is
+   begin
+      Disp_Tnode (Atype, False);
+   end Disp_Tnode_Name;
+
+   procedure Disp_Dnode_Name (Decl : O_Dnode) is
+   begin
+      Disp_Ident (Decl.Name);
+   end Disp_Dnode_Name;
+
+   procedure Disp_Loop_Name (Stmt : O_Snode) is
+   begin
+      Put ("loop" & Natural'Image (Stmt.Loop_Level));
+   end Disp_Loop_Name;
+
+   function Get_Enode_Name (Kind : OE_Kind) return String
+   is
+   begin
+      case Kind is
+--          when OE_Boolean_Lit =>
+--             return "boolean_lit";
+--          when OE_Unsigned_Lit =>
+--             return "unsigned_lit";
+--          when OE_Signed_Lit =>
+--             return "signed lit";
+--          when OE_Float_Lit =>
+--             return "float lit";
+--          when OE_Null_Lit =>
+--             return "null lit";
+--          when OE_Enum_Lit =>
+--             return "enum lit";
+
+--          when OE_Sizeof_Lit =>
+--             return "sizeof lit";
+--          when OE_Offsetof_Lit =>
+--             return "offsetof lit";
+--          when OE_Aggregate =>
+--             return "aggregate";
+--          when OE_Aggr_Element =>
+--             return "aggr_element";
+--          when OE_Union_Aggr =>
+--             return "union aggr";
+
+         when OE_Lit =>
+            return "lit";
+         when OE_Add_Ov =>
+            return "+#";
+         when OE_Sub_Ov =>
+            return "-#";
+         when OE_Mul_Ov =>
+            return "*#";
+         when OE_Div_Ov =>
+            return "/#";
+         when OE_Rem_Ov =>
+            return "rem#";
+         when OE_Mod_Ov =>
+            return "mod#";
+         when OE_Exp_Ov =>
+            return "**#";
+
+         when OE_And =>
+            return "and";
+         when OE_Or =>
+            return "or";
+         when OE_Xor =>
+            return "xor";
+         when OE_And_Then =>
+            return "and_then";
+         when OE_Or_Else =>
+            return "or_else";
+
+         when OE_Not =>
+            return "not";
+         when OE_Neg_Ov =>
+            return "-";
+         when OE_Abs_Ov =>
+            return "abs";
+
+         when OE_Eq =>
+            return "=";
+         when OE_Neq =>
+            return "/=";
+         when OE_Le =>
+            return "<=";
+         when OE_Lt =>
+            return "<";
+         when OE_Ge =>
+            return ">=";
+         when OE_Gt =>
+            return ">";
+
+         when OE_Function_Call =>
+            return "function call";
+         when OE_Convert_Ov =>
+            return "convert_ov";
+         when OE_Address =>
+            return "address";
+         when OE_Unchecked_Address =>
+            return "unchecked_address";
+--          when OE_Subprogram_Address =>
+--             return "subprg_address";
+         when OE_Alloca =>
+            return "alloca";
+         when OE_Value =>
+            return "value";
+         when OE_Nil =>
+            return "??";
+      end case;
+   end Get_Enode_Name;
+
+   function Get_Lnode_Name (Kind : OL_Kind) return String
+   is
+   begin
+      case Kind is
+         when OL_Obj =>
+            return "obj";
+         when OL_Indexed_Element =>
+            return "indexed_element";
+         when OL_Slice =>
+            return "slice";
+         when OL_Selected_Element =>
+            return "selected_element";
+         when OL_Access_Element =>
+            return "access_element";
+--          when OL_Param_Ref =>
+--             return "param_ref";
+--          when OL_Var_Ref =>
+--             return "var_ref";
+--          when OL_Const_Ref =>
+--             return "const_ref";
+      end case;
+   end Get_Lnode_Name;
+
+   pragma Unreferenced (Get_Lnode_Name);
+
+   procedure Disp_Enode_Name (Kind : OE_Kind) is
+   begin
+      Put (Get_Enode_Name (Kind));
+   end Disp_Enode_Name;
+
+   procedure Disp_Assoc_List (Head : O_Anode)
+   is
+      El : O_Anode;
+   begin
+      El := Head;
+      Put ("(");
+      if El /= null then
+         loop
+            Disp_Enode (El.Actual, El.Formal.Dtype);
+            El := El.Next;
+            exit when El = null;
+            Put (", ");
+         end loop;
+      end if;
+      Put (")");
+   end Disp_Assoc_List;
+
+   function Image (Lit : Integer) return String
+   is
+      S : constant String := Integer'Image (Lit);
+   begin
+      if S (1) = ' ' then
+         return S (2 .. S'Length);
+      else
+         return S;
+      end if;
+   end Image;
+
+   --  Disp STR as a literal for scalar type LIT_TYPE.
+   procedure Disp_Lit (Lit_Type : O_Tnode; Known : Boolean; Str : String) is
+   begin
+      if Known and not Disp_All_Types then
+         Put_Trim (Str);
+      else
+         Disp_Tnode_Name (Lit_Type);
+         Put ("'[");
+         Put_Trim (Str);
+         Put (']');
+      end if;
+   end Disp_Lit;
+
+   --  Display C. If CTYPE is set, this is the known type of C.
+   procedure Disp_Cnode (C : O_Cnode; Ctype : O_Tnode)
+   is
+      Known : constant Boolean := Ctype /= O_Tnode_Null;
+   begin
+      --  Sanity check.
+      if Known then
+         if Ctype /= C.Ctype then
+            raise Program_Error;
+         end if;
+      end if;
+
+      case C.Kind is
+         when OC_Unsigned_Lit =>
+            if False and then (C.U_Val >= Character'Pos(' ')
+                               and C.U_Val <= Character'Pos ('~'))
+            then
+               Put (''');
+               Put (Character'Val (C.U_Val));
+               Put (''');
+            else
+               Disp_Lit (C.Ctype, Known, Unsigned_64'Image (C.U_Val));
+            end if;
+         when OC_Signed_Lit =>
+            Disp_Lit (C.Ctype, Known, Integer_64'Image (C.S_Val));
+         when OC_Float_Lit =>
+            Disp_Lit (C.Ctype, Known, IEEE_Float_64'Image (C.F_Val));
+         when OC_Boolean_Lit =>
+            --  Always disp the type of boolean literals.
+            Disp_Lit (C.Ctype, False, Get_String (C.B_Id));
+         when OC_Null_Lit =>
+            --  Always disp the type of null literals.
+            Disp_Lit (C.Ctype, False, "null");
+         when OC_Enum_Lit =>
+            --  Always disp the type of enum literals.
+            Disp_Lit (C.Ctype, False, Get_String (C.E_Name));
+         when OC_Sizeof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'sizeof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
+         when OC_Alignof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'alignof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
+         when OC_Offsetof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'offsetof (");
+            Disp_Tnode_Name (C.Off_Field.Parent);
+            Put (".");
+            Disp_Ident (C.Off_Field.Ident);
+            Put (")");
+         when OC_Aggregate =>
+            declare
+               El : O_Cnode;
+               El_Type : O_Tnode;
+               Field : O_Fnode;
+            begin
+               Put ('{');
+               El := C.Aggr_Els;
+               case C.Ctype.Kind is
+                  when ON_Record_Type =>
+                     Field := C.Ctype.Elements;
+                     El_Type := Field.Ftype;
+                  when ON_Array_Sub_Type =>
+                     Field := null;
+                     El_Type := C.Ctype.Base_Type.El_Type;
+                  when others =>
+                     raise Program_Error;
+               end case;
+               if El /= null then
+                  loop
+                     Set_Mark;
+                     if Field /= null then
+                        if Disp_All_Types then
+                           Put ('.');
+                           Disp_Ident (Field.Ident);
+                           Put (" = ");
+                        end if;
+                        El_Type := Field.Ftype;
+                        Field := Field.Next;
+                     end if;
+                     Disp_Cnode (El.Aggr_Value, El_Type);
+                     El := El.Aggr_Next;
+                     exit when El = null;
+                     Put (", ");
+                  end loop;
+               end if;
+               Put ('}');
+            end;
+         when OC_Aggr_Element =>
+            Disp_Cnode (C.Aggr_Value, Ctype);
+         when OC_Union_Aggr =>
+            Put ('{');
+            Put ('.');
+            Disp_Ident (C.Uaggr_Field.Ident);
+            Put (" = ");
+            Disp_Cnode (C.Uaggr_Value, C.Uaggr_Field.Ftype);
+            Put ('}');
+         when OC_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'address (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+         when OC_Unchecked_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'unchecked_address (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+         when OC_Subprogram_Address =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'subprg_addr (");
+            Disp_Dnode_Name (C.Decl);
+            Put (")");
+      end case;
+   end Disp_Cnode;
+
+   --  Disp E whose expected type is ETYPE (may not be set).
+   procedure Disp_Enode (E : O_Enode; Etype : O_Tnode)
+   is
+   begin
+      case E.Kind is
+         when OE_Lit =>
+            Disp_Cnode (E.Lit, Etype);
+         when OE_Dyadic_Expr_Kind =>
+            Put ("(");
+            Disp_Enode (E.Left, O_Tnode_Null);
+            Put (' ');
+            Disp_Enode_Name (E.Kind);
+            Put (' ');
+            Disp_Enode (E.Right, E.Left.Rtype);
+            Put (')');
+         when OE_Compare_Expr_Kind =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'(");
+            Disp_Enode (E.Left, O_Tnode_Null);
+            Put (' ');
+            Disp_Enode_Name (E.Kind);
+            Put (' ');
+            Disp_Enode (E.Right, E.Left.Rtype);
+            Put (')');
+         when OE_Monadic_Expr_Kind =>
+            Disp_Enode_Name (E.Kind);
+            if E.Kind /= OE_Neg_Ov then
+               Put (' ');
+            end if;
+            Disp_Enode (E.Operand, Etype);
+         when OE_Address =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'address (");
+            Disp_Lnode (E.Lvalue);
+            Put (")");
+         when OE_Unchecked_Address =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'unchecked_address (");
+            Disp_Lnode (E.Lvalue);
+            Put (")");
+         when OE_Convert_Ov =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'conv (");
+            Disp_Enode (E.Conv, O_Tnode_Null);
+            Put (')');
+         when OE_Function_Call =>
+            Disp_Dnode_Name (E.Func);
+            Put (' ');
+            Disp_Assoc_List (E.Assoc);
+         when OE_Alloca =>
+            Disp_Tnode_Name (E.Rtype);
+            Put ("'alloca (");
+            Disp_Enode (E.A_Size, O_Tnode_Null);
+            Put (')');
+         when OE_Value =>
+            Disp_Lnode (E.Value);
+         when OE_Nil =>
+            null;
+      end case;
+   end Disp_Enode;
+
+   procedure Disp_Lnode (Node : O_Lnode) is
+   begin
+      case Node.Kind is
+         when OL_Obj =>
+            Disp_Dnode_Name (Node.Obj);
+         when OL_Access_Element =>
+            Disp_Enode (Node.Acc_Base, O_Tnode_Null);
+            Put (".all");
+         when OL_Indexed_Element =>
+            Disp_Lnode (Node.Array_Base);
+            Put ('[');
+            Disp_Enode (Node.Index, O_Tnode_Null);
+            Put (']');
+         when OL_Slice =>
+            Disp_Lnode (Node.Slice_Base);
+            Put ('[');
+            Disp_Enode (Node.Slice_Index, O_Tnode_Null);
+            Put ("...]");
+         when OL_Selected_Element =>
+            Disp_Lnode (Node.Rec_Base);
+            Put ('.');
+            Disp_Ident (Node.Rec_El.Ident);
+--          when OL_Var_Ref
+--            | OL_Const_Ref
+--            | OL_Param_Ref =>
+--             Disp_Dnode_Name (Node.Decl);
+      end case;
+   end Disp_Lnode;
+
+   procedure Disp_Fnodes (First : O_Fnode)
+   is
+      El : O_Fnode;
+   begin
+      Add_Tab;
+      El := First;
+      while El /= null loop
+         Disp_Ident (El.Ident);
+         Put (": ");
+         Disp_Tnode (El.Ftype, False);
+         Put_Line ("; ");
+         El := El.Next;
+      end loop;
+      Rem_Tab;
+   end Disp_Fnodes;
+
+   procedure Disp_Tnode (Atype : O_Tnode; Full : Boolean) is
+   begin
+      if not Full and Atype.Decl /= null then
+         Disp_Ident (Atype.Decl.Name);
+         return;
+      end if;
+      case Atype.Kind is
+         when ON_Boolean_Type =>
+            Put ("boolean {");
+            Disp_Ident (Atype.False_N.B_Id);
+            Put (", ");
+            Disp_Ident (Atype.True_N.B_Id);
+            Put ("}");
+         when ON_Unsigned_Type =>
+            Put ("unsigned (");
+            Put_Trim (Natural'Image (Atype.Int_Size));
+            Put (")");
+         when ON_Signed_Type =>
+            Put ("signed (");
+            Put_Trim (Natural'Image (Atype.Int_Size));
+            Put (")");
+         when ON_Float_Type =>
+            Put ("float");
+         when ON_Enum_Type =>
+            declare
+               El : O_Cnode;
+            begin
+               Put ("enum {");
+               El := Atype.Literals;
+               while El /= O_Cnode_Null loop
+                  Set_Mark;
+                  Disp_Ident (El.E_Name);
+                  Put (" = ");
+                  Put (Image (El.E_Val));
+                  El := El.E_Next;
+                  exit when El = O_Cnode_Null;
+                  Put (", ");
+               end loop;
+               Put ("}");
+            end;
+         when ON_Array_Type =>
+            Put ("array [");
+            Disp_Tnode (Atype.Index_Type, False);
+            Put ("] of ");
+            Disp_Tnode (Atype.El_Type, False);
+         when ON_Access_Type =>
+            Put ("access ");
+            if Atype.D_Type /= O_Tnode_Null then
+               Disp_Tnode (Atype.D_Type, False);
+            end if;
+         when ON_Record_Type =>
+            Put_Line ("record ");
+            Disp_Fnodes (Atype.Elements);
+            Put ("end record");
+         when ON_Union_Type =>
+            Put_Line ("union ");
+            Disp_Fnodes (Atype.Elements);
+            Put ("end union");
+         when ON_Array_Sub_Type =>
+            Put ("subarray ");
+            Disp_Tnode_Name (Atype.Base_Type);
+            Put ("[");
+            Disp_Cnode (Atype.Length, Atype.Base_Type.Index_Type);
+            Put ("]");
+      end case;
+   end Disp_Tnode;
+
+   procedure Disp_Storage_Name (Storage : O_Storage) is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+         when O_Storage_Local =>
+            Put ("local");
+      end case;
+   end Disp_Storage_Name;
+
+   procedure Disp_Decls (Decls : O_Dnode)
+   is
+      El : O_Dnode;
+   begin
+      El := Decls;
+      while El /= null loop
+         Disp_Dnode (El);
+         El := El.Next;
+         if Is_Top then
+            -- NOTE: some declaration does not disp anything, so there may be
+            -- double new line.
+            New_Line;
+         end if;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Function_Decl (Decl : O_Dnode) is
+   begin
+      Disp_Storage_Name (Decl.Storage);
+      Put (" ");
+      if Decl.Dtype = null then
+         Put ("procedure ");
+      else
+         Put ("function ");
+      end if;
+      Disp_Ident (Decl.Name);
+      Put_Line (" (");
+      Add_Tab;
+      declare
+         El : O_Dnode;
+      begin
+         El := Decl.Interfaces;
+         if El /= null then
+            loop
+               Disp_Dnode (El);
+               El := El.Next;
+               exit when El = null;
+               Put_Line (";");
+            end loop;
+         end if;
+         Put (")");
+      end;
+      if Decl.Dtype /= null then
+         New_Line;
+         Put ("return ");
+         Disp_Tnode (Decl.Dtype, False);
+      end if;
+      Rem_Tab;
+   end Disp_Function_Decl;
+
+   procedure Disp_Dnode (Decl : O_Dnode) is
+   begin
+      case Decl.Kind is
+         when ON_Type_Decl =>
+            Put ("type ");
+            Disp_Ident (Decl.Name);
+            Put (" is ");
+            if not Decl.Dtype.Uncomplete then
+               Disp_Tnode (Decl.Dtype, True);
+            else
+               case Decl.Dtype.Kind is
+                  when ON_Record_Type =>
+                     Put ("record");
+                  when ON_Access_Type =>
+                     Put ("access");
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end if;
+            Put_Line (";");
+         when ON_Completed_Type_Decl =>
+            Put ("type ");
+            Disp_Ident (Decl.Name);
+            Put (" is ");
+            Disp_Tnode (Decl.Dtype, True);
+            Put_Line (";");
+         when ON_Const_Decl =>
+            Disp_Storage_Name (Decl.Storage);
+            Put (" ");
+            Put ("constant ");
+            Disp_Ident (Decl.Name);
+            Put (" : ");
+            Disp_Tnode_Name (Decl.Dtype);
+            Put_Line (";");
+         when ON_Const_Value =>
+            Put ("constant ");
+            Disp_Ident (Decl.Name);
+            Put (" := ");
+            Disp_Cnode (Decl.Value, Decl.Dtype);
+            Put_Line (";");
+         when ON_Var_Decl =>
+            Disp_Storage_Name (Decl.Storage);
+            Put (" ");
+            Put ("var ");
+            Disp_Ident (Decl.Name);
+            Put (" : ");
+            Disp_Tnode_Name (Decl.Dtype);
+            Put_Line (";");
+         when ON_Function_Decl =>
+            if Decl.Next = null or Decl.Next /= Decl.Func_Body then
+               --  This is a forward/external declaration.
+               Disp_Function_Decl (Decl);
+               Put_Line (";");
+            end if;
+         when ON_Function_Body =>
+            Disp_Function_Decl (Decl.Func_Decl);
+            New_Line;
+            Disp_Snode (Decl.Func_Stmt, Decl.Func_Stmt);
+         when ON_Interface_Decl =>
+            Disp_Ident (Decl.Name);
+            Put (": ");
+            Disp_Tnode (Decl.Dtype, False);
+         when ON_Debug_Line_Decl =>
+            Put_Line ("--#" & Natural'Image (Decl.Line));
+         when ON_Debug_Comment_Decl =>
+            Put_Line ("-- " & Decl.Comment.all);
+         when ON_Debug_Filename_Decl =>
+            Put_Line ("--F " & Decl.Filename.all);
+      end case;
+   end Disp_Dnode;
+
+   procedure Disp_Snode (First : O_Snode; Last : O_Snode) is
+      Stmt : O_Snode;
+   begin
+      Stmt := First;
+      loop
+         --if Stmt.Kind = ON_Elsif_Stmt or Stmt.Kind = ON_When_Stmt then
+         --   Put_Indent (Tab - 1);
+         --else
+         --   Put_Indent (Tab);
+         --end if;
+         case Stmt.Kind is
+            when ON_Declare_Stmt =>
+               Put_Line ("declare");
+               Add_Tab;
+               Disp_Decls (Stmt.Decls);
+               Rem_Tab;
+               Put_Line ("begin");
+               Add_Tab;
+               if Stmt.Stmts /= null then
+                  Disp_Snode (Stmt.Stmts, null);
+               end if;
+               Rem_Tab;
+               Put_Line ("end;");
+            when ON_Assign_Stmt =>
+               Disp_Lnode (Stmt.Target);
+               Put (" := ");
+               Disp_Enode (Stmt.Value, Stmt.Target.Rtype);
+               Put_Line (";");
+            when ON_Return_Stmt =>
+               Put ("return ");
+               if Stmt.Ret_Val /= null then
+                  Disp_Enode (Stmt.Ret_Val, O_Tnode_Null);
+               end if;
+               Put_Line (";");
+            when ON_If_Stmt =>
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.If_Last);
+               Stmt := Stmt.If_Last;
+               Rem_Tab;
+               Put_Line ("end if;");
+            when ON_Elsif_Stmt =>
+               Rem_Tab;
+               if Stmt.Cond = null then
+                  Put_Line ("else");
+               else
+                  if First = Stmt then
+                     Put ("if ");
+                  else
+                     Put ("elsif ");
+                  end if;
+                  Disp_Enode (Stmt.Cond, O_Tnode_Null);
+                  Put_Line (" then");
+               end if;
+               Add_Tab;
+            when ON_Loop_Stmt =>
+               Disp_Loop_Name (Stmt);
+               Put_Line (":");
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.Loop_Last);
+               Stmt := Stmt.Loop_Last;
+               Rem_Tab;
+               Put_Line ("end loop;");
+            when ON_Exit_Stmt =>
+               Put ("exit ");
+               Disp_Loop_Name (Stmt.Loop_Id);
+               Put_Line (";");
+            when ON_Next_Stmt =>
+               Put ("next ");
+               Disp_Loop_Name (Stmt.Loop_Id);
+               Put_Line (";");
+            when ON_Case_Stmt =>
+               Put ("case ");
+               Disp_Enode (Stmt.Selector, O_Tnode_Null);
+               Put_Line (" is");
+               Add_Tab;
+               Disp_Snode (Stmt.Next, Stmt.Case_Last);
+               Stmt := Stmt.Case_Last;
+               Rem_Tab;
+               Put_Line ("end case;");
+            when ON_When_Stmt =>
+               declare
+                  Choice: O_Choice;
+                  Choice_Type : constant O_Tnode :=
+                    Stmt.Branch_Parent.Selector.Rtype;
+               begin
+                  Rem_Tab;
+                  Choice := Stmt.Choice_List;
+                  Put ("when ");
+                  loop
+                     case Choice.Kind is
+                        when ON_Choice_Expr =>
+                           Disp_Cnode (Choice.Expr, Choice_Type);
+                        when ON_Choice_Range =>
+                           Disp_Cnode (Choice.Low, Choice_Type);
+                           Put (" ... ");
+                           Disp_Cnode (Choice.High, Choice_Type);
+                        when ON_Choice_Default =>
+                           Put ("default");
+                     end case;
+                     Choice := Choice.Next;
+                     exit when Choice = null;
+                     Put_Line (",");
+                     Put ("     ");
+                  end loop;
+                  Put_Line (" =>");
+                  Add_Tab;
+               end;
+            when ON_Call_Stmt =>
+               Disp_Dnode_Name (Stmt.Proc);
+               Put (' ');
+               Disp_Assoc_List (Stmt.Assoc);
+               Put_Line (";");
+            when ON_Debug_Line_Stmt =>
+               Put_Line ("--#" & Natural'Image (Stmt.Line));
+            when ON_Debug_Comment_Stmt =>
+               Put_Line ("-- " & Stmt.Comment.all);
+         end case;
+         exit when Stmt = Last;
+         Stmt := Stmt.Next;
+         exit when Stmt = null and Last = null;
+      end loop;
+   end Disp_Snode;
+
+   procedure Disp_Ortho (Decls : O_Snode) is
+   begin
+      Disp_Decls (Decls.Decls);
+      Flush;
+   end Disp_Ortho;
+
+   procedure Disp_Tnode_Decl (N : O_Tnode) is
+   begin
+      Disp_Ident (N.Decl.Name);
+      Put (" : ");
+      Disp_Tnode (N, True);
+   end Disp_Tnode_Decl;
+
+   procedure Debug_Tnode (N : O_Tnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Tnode_Decl (N);
+      Pop_Context (Ctx);
+   end Debug_Tnode;
+
+   procedure Debug_Enode (N : O_Enode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Enode (N, O_Tnode_Null);
+      Put (" : ");
+      Disp_Tnode_Decl (N.Rtype);
+      Pop_Context (Ctx);
+   end Debug_Enode;
+
+   procedure Debug_Fnode (N : O_Fnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Ident (N.Ident);
+      Put (": ");
+      Disp_Tnode (N.Ftype, False);
+      Pop_Context (Ctx);
+   end Debug_Fnode;
+
+   procedure Debug_Dnode (N : O_Dnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Dnode (N);
+      Pop_Context (Ctx);
+   end Debug_Dnode;
+
+   procedure Debug_Lnode (N : O_Lnode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Lnode (N);
+      Put (" : ");
+      Disp_Tnode_Decl (N.Rtype);
+      Pop_Context (Ctx);
+   end Debug_Lnode;
+
+   procedure Debug_Snode (N : O_Snode)
+   is
+      Ctx : Disp_Context;
+   begin
+      Push_Context (Interfaces.C_Streams.stdout, Ctx);
+      Disp_Snode (N, null);
+      Pop_Context (Ctx);
+   end Debug_Snode;
+
+   pragma Unreferenced (Debug_Tnode, Debug_Enode, Debug_Fnode,
+                        Debug_Dnode, Debug_Lnode, Debug_Snode);
+end Ortho_Debug.Disp;
diff --git a/src/ortho/debug/ortho_debug-disp.ads b/src/ortho/debug/ortho_debug-disp.ads
new file mode 100644
index 000000000..c365a3530
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-disp.ads
@@ -0,0 +1,29 @@
+--  Display the ortho codes from a tree.
+--  Copyright (C) 2005 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 Interfaces.C_Streams;
+
+package Ortho_Debug.Disp is
+   --  Initialize the current context.
+   --  Must be called before any use of the DISP_* subprograms.
+   procedure Init_Context (File : Interfaces.C_Streams.FILEs);
+
+   --  Disp nodes in a pseudo-language.
+   procedure Disp_Ortho (Decls : O_Snode);
+
+private
+end Ortho_Debug.Disp;
diff --git a/src/ortho/debug/ortho_debug-main.adb b/src/ortho/debug/ortho_debug-main.adb
new file mode 100644
index 000000000..b470deaab
--- /dev/null
+++ b/src/ortho/debug/ortho_debug-main.adb
@@ -0,0 +1,151 @@
+--  Main procedure of ortho debug back-end.
+--  Copyright (C) 2005 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 Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ortho_Debug; use Ortho_Debug;
+with Ortho_Debug_Front; use Ortho_Debug_Front;
+with Ortho_Debug.Disp;
+with System; use System;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+
+procedure Ortho_Debug.Main is
+   --  Do not output the ortho code.
+   Flag_Silent : Boolean := False;
+
+   --  Force output, even in case of crash.
+   Flag_Force : Boolean := False;
+
+   I : Natural;
+   Argc : Natural;
+   Arg : String_Acc;
+   Opt : String_Acc;
+   Res : Natural;
+   File : String_Acc;
+   Output : FILEs;
+   R : Boolean;
+
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Acc, Object => String);
+begin
+   Ortho_Debug_Front.Init;
+   Output := NULL_Stream;
+
+   Set_Exit_Status (Failure);
+
+   --  Decode options.
+   Argc := Argument_Count;
+   I := 1;
+   loop
+      exit when I > Argc;
+      exit when Argument (I) (1) /= '-';
+      if Argument (I) = "--silent" or else Argument (I) = "-quiet" then
+         Flag_Silent := True;
+         I := I + 1;
+      elsif Argument (I) = "--force" then
+         Flag_Force := True;
+         I := I + 1;
+      elsif Argument (I)'Length >= 2 and then Argument (I)(2) = 'g' then
+         --  Skip -g[XXX] flags.
+         I := I + 1;
+      elsif Argument (I) = "-o" and then I + 1 <= Argc then
+         --  TODO: write the output to the file ?
+         if Output /= NULL_Stream then
+            Put_Line (Command_Name & ": only one output allowed");
+            return;
+         end if;
+         declare
+            Name : String := Argument (I + 1) & ASCII.Nul;
+            Mode : String := 'w' & ASCII.Nul;
+         begin
+            Output := fopen (Name'Address, Mode'Address);
+            if Output = NULL_Stream then
+               Put_Line (Command_Name & ": cannot open " & Argument (I + 1));
+               return;
+            end if;
+         end;
+         I := I + 2;
+      else
+         Opt := new String'(Argument (I));
+         if I < Argc then
+            Arg := new String'(Argument (I + 1));
+         else
+            Arg := null;
+         end if;
+         Res := Ortho_Debug_Front.Decode_Option (Opt, Arg);
+         Unchecked_Deallocation (Opt);
+         Unchecked_Deallocation (Arg);
+         if Res = 0 then
+            Put_Line (Argument (I) & ": unknown option");
+            return;
+         else
+            I := I + Res;
+         end if;
+      end if;
+   end loop;
+
+   --  Initialize tree.
+   begin
+      Ortho_Debug.Init;
+
+      if I <= Argc then
+         R := True;
+         for J in I .. Argc loop
+            File := new String'(Argument (J));
+            R := R and Ortho_Debug_Front.Parse (File);
+            Unchecked_Deallocation (File);
+         end loop;
+      else
+         R := Ortho_Debug_Front.Parse (null);
+      end if;
+      Ortho_Debug.Finish;
+   exception
+      when others =>
+         if not Flag_Force then
+            raise;
+         else
+            R := False;
+         end if;
+   end;
+
+   --  Write down the result.
+   if (R and (Output /= NULL_Stream or not Flag_Silent))
+     or Flag_Force
+   then
+      if Output = NULL_Stream then
+         Ortho_Debug.Disp.Init_Context (stdout);
+      else
+         Ortho_Debug.Disp.Init_Context (Output);
+      end if;
+      Ortho_Debug.Disp.Disp_Ortho (Ortho_Debug.Top);
+      if Output /= NULL_Stream then
+         declare
+            Status : int;
+            pragma Unreferenced (Status);
+         begin
+            Status := fclose (Output);
+         end;
+      end if;
+   end if;
+
+   if R then
+      Set_Exit_Status (Success);
+   else
+      Set_Exit_Status (Failure);
+   end if;
+end Ortho_Debug.Main;
diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb
new file mode 100644
index 000000000..8285a6473
--- /dev/null
+++ b/src/ortho/debug/ortho_debug.adb
@@ -0,0 +1,1931 @@
+--  Ortho debug back-end.
+--  Copyright (C) 2005 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 Ada.Unchecked_Deallocation;
+
+package body Ortho_Debug is
+   --  If True, disable some checks so that the output can be generated.
+   Disable_Checks : constant Boolean := False;
+
+   type ON_Op_To_OE_Type is array (ON_Op_Kind) of OE_Kind;
+   ON_Op_To_OE : constant ON_Op_To_OE_Type :=
+     (
+      ON_Nil => OE_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov => OE_Add_Ov,
+      ON_Sub_Ov => OE_Sub_Ov,
+      ON_Mul_Ov => OE_Mul_Ov,
+      ON_Div_Ov => OE_Div_Ov,
+      ON_Rem_Ov => OE_Rem_Ov,
+      ON_Mod_Ov => OE_Mod_Ov,
+
+      --  Binary operations.
+      ON_And => OE_And,
+      ON_Or => OE_Or,
+      ON_Xor => OE_Xor,
+
+      --  Monadic operations.
+      ON_Not => OE_Not,
+      ON_Neg_Ov => OE_Neg_Ov,
+      ON_Abs_Ov => OE_Abs_Ov,
+
+      --  Comparaisons
+      ON_Eq => OE_Eq,
+      ON_Neq => OE_Neq,
+      ON_Le => OE_Le,
+      ON_Lt => OE_Lt,
+      ON_Ge => OE_Ge,
+      ON_Gt => OE_Gt
+      );
+
+   type Decl_Scope_Type is record
+      --  Declarations are chained.
+      Parent : O_Snode;
+      Last_Decl : O_Dnode;
+      Last_Stmt : O_Snode;
+
+      --  If this scope corresponds to a function, PREV_FUNCTION contains
+      --  the previous function.
+      Prev_Function : O_Dnode;
+
+      --  Declaration scopes are chained.
+      Prev : Decl_Scope_Acc;
+   end record;
+
+   type Stmt_Kind is
+     (Stmt_Function, Stmt_Declare, Stmt_If, Stmt_Loop, Stmt_Case);
+   type Stmt_Scope_Type (Kind : Stmt_Kind);
+   type Stmt_Scope_Acc is access Stmt_Scope_Type;
+   type Stmt_Scope_Type (Kind : Stmt_Kind) is record
+      --  Statement which created this scope.
+      Parent : O_Snode;
+      --  Previous (parent) scope.
+      Prev : Stmt_Scope_Acc;
+      case Kind is
+         when Stmt_Function =>
+            Prev_Function : Stmt_Scope_Acc;
+            --  Declaration for the function.
+            Decl : O_Dnode;
+         when Stmt_Declare =>
+            null;
+         when Stmt_If =>
+            Last_Elsif : O_Snode;
+         when Stmt_Loop =>
+            null;
+         when Stmt_Case =>
+            Last_Branch : O_Snode;
+            Last_Choice : O_Choice;
+            Case_Type : O_Tnode;
+      end case;
+   end record;
+   subtype Stmt_Function_Scope_Type is Stmt_Scope_Type (Stmt_Function);
+   subtype Stmt_Declare_Scope_Type is Stmt_Scope_Type (Stmt_Declare);
+   subtype Stmt_If_Scope_Type is Stmt_Scope_Type (Stmt_If);
+   subtype Stmt_Loop_Scope_Type is Stmt_Scope_Type (Stmt_Loop);
+   subtype Stmt_Case_Scope_Type is Stmt_Scope_Type (Stmt_Case);
+
+   Current_Stmt_Scope : Stmt_Scope_Acc := null;
+   Current_Function : Stmt_Scope_Acc := null;
+   Current_Decl_Scope : Decl_Scope_Acc := null;
+   Current_Loop_Level : Natural := 0;
+
+   procedure Push_Decl_Scope (Parent : O_Snode)
+   is
+      Res : Decl_Scope_Acc;
+   begin
+      Res := new Decl_Scope_Type'(Parent => Parent,
+                                  Last_Decl => null,
+                                  Last_Stmt => null,
+                                  Prev_Function => null,
+                                  Prev => Current_Decl_Scope);
+      Parent.Alive := True;
+      Current_Decl_Scope := Res;
+   end Push_Decl_Scope;
+
+   procedure Pop_Decl_Scope
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object => Decl_Scope_Type, Name => Decl_Scope_Acc);
+      Old : Decl_Scope_Acc;
+   begin
+      Old := Current_Decl_Scope;
+      Old.Parent.Alive := False;
+      Current_Decl_Scope := Old.Prev;
+      Unchecked_Deallocation (Old);
+   end Pop_Decl_Scope;
+
+   procedure Add_Decl (El : O_Dnode; Check_Dup : Boolean := True) is
+   begin
+      if Current_Decl_Scope = null then
+         --  Not yet initialized, or after compilation.
+         raise Program_Error;
+      end if;
+
+      --  Note: this requires an hashed ident table.
+      --  Use ortho_ident_hash.
+      if False and then Check_Dup
+        and then not Is_Nul (El.Name)
+      then
+         --  Check the name is not already defined.
+         declare
+            E : O_Dnode;
+         begin
+            E := Current_Decl_Scope.Parent.Decls;
+            while E /= O_Dnode_Null loop
+               if Is_Equal (E.Name, El.Name) then
+                  raise Syntax_Error;
+               end if;
+               E := E.Next;
+            end loop;
+         end;
+      end if;
+
+      if Current_Decl_Scope.Last_Decl = null then
+         if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then
+            Current_Decl_Scope.Parent.Decls := El;
+         else
+            raise Type_Error;
+         end if;
+      else
+         Current_Decl_Scope.Last_Decl.Next := El;
+      end if;
+      El.Next := null;
+      Current_Decl_Scope.Last_Decl := El;
+   end Add_Decl;
+
+   procedure Add_Stmt (Stmt : O_Snode)
+   is
+   begin
+      if Current_Decl_Scope = null or Current_Function = null then
+         --  You are adding a statement at the global level, ie not inside
+         --  a function.
+         raise Syntax_Error;
+      end if;
+
+      Stmt.Next := null;
+      if Current_Decl_Scope.Last_Stmt = null then
+         if Current_Decl_Scope.Parent.Kind = ON_Declare_Stmt then
+            Current_Decl_Scope.Parent.Stmts := Stmt;
+         else
+            raise Syntax_Error;
+         end if;
+      else
+         Current_Decl_Scope.Last_Stmt.Next := Stmt;
+      end if;
+      Current_Decl_Scope.Last_Stmt := Stmt;
+   end Add_Stmt;
+
+   procedure Push_Stmt_Scope (Scope : Stmt_Scope_Acc)
+   is
+   begin
+      if Scope.Prev /= Current_Stmt_Scope then
+         --  SCOPE was badly initialized.
+         raise Program_Error;
+      end if;
+      Current_Stmt_Scope := Scope;
+   end Push_Stmt_Scope;
+
+   procedure Pop_Stmt_Scope (Kind : Stmt_Kind)
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object => Stmt_Scope_Type, Name => Stmt_Scope_Acc);
+      Old : Stmt_Scope_Acc;
+   begin
+      Old := Current_Stmt_Scope;
+      if Old.Kind /= Kind then
+         raise Syntax_Error;
+      end if;
+      --Old.Parent.Last_Stmt := Current_Decl_Scope.Last_Stmt;
+      Current_Stmt_Scope := Old.Prev;
+      Unchecked_Deallocation (Old);
+   end Pop_Stmt_Scope;
+
+   --  Check declaration DECL is reachable, ie its scope is in the current
+   --  stack of scopes.
+   procedure Check_Scope (Decl : O_Dnode)
+   is
+      Res : Boolean;
+   begin
+      case Decl.Kind is
+         when ON_Interface_Decl =>
+            Res := Decl.Func_Scope.Alive;
+         when others =>
+            Res := Decl.Scope.Alive;
+      end case;
+      if not Res then
+         raise Syntax_Error;
+      end if;
+   end Check_Scope;
+
+   --  Raise SYNTAX_ERROR if OBJ is not at a constant address.
+--    procedure Check_Const_Address (Obj : O_Lnode) is
+--    begin
+--       case Obj.Kind is
+--          when OL_Const_Ref
+--            | OL_Var_Ref =>
+--             case Obj.Decl.Storage is
+--                when O_Storage_External
+--                  | O_Storage_Public
+--                  | O_Storage_Private =>
+--                   null;
+--                when O_Storage_Local =>
+--                   raise Syntax_Error;
+--             end case;
+--          when others =>
+--             --  FIXME: constant indexed element, selected element maybe
+--             --   of const address.
+--             raise Syntax_Error;
+--       end case;
+--    end Check_Const_Address;
+
+   procedure Check_Type (T1, T2 : O_Tnode) is
+   begin
+      if T1 = T2 then
+         return;
+      end if;
+      if T1.Kind = ON_Array_Sub_Type and then T2.Kind = ON_Array_Sub_Type
+        and then T1.Base_Type = T2.Base_Type
+        and then T1.Length.all = T2.Length.all
+      then
+         return;
+      end if;
+      raise Type_Error;
+   end Check_Type;
+
+   procedure Check_Ref (N : O_Enode) is
+   begin
+      if N.Ref then
+         --  Already referenced.
+         raise Syntax_Error;
+      end if;
+      N.Ref := True;
+   end Check_Ref;
+
+   procedure Check_Ref (N : O_Lnode) is
+   begin
+      if N.Ref then
+         raise Syntax_Error;
+      end if;
+      N.Ref := True;
+   end Check_Ref;
+
+   procedure Check_Complete_Type (T : O_Tnode) is
+   begin
+      if not T.Complete then
+         --  Uncomplete type cannot be used here (since its size is required,
+         --   for example).
+         raise Syntax_Error;
+      end if;
+   end Check_Complete_Type;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode
+   is
+      K : constant OE_Kind := ON_Op_To_OE (Kind);
+      Res : O_Enode;
+   begin
+      Check_Type (Left.Rtype, Right.Rtype);
+      Check_Ref (Left);
+      Check_Ref (Right);
+      Res := new O_Enode_Type (K);
+      Res.Rtype := Left.Rtype;
+      Res.Ref := False;
+      Res.Left := Left;
+      Res.Right := Right;
+      return Res;
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      Check_Ref (Operand);
+      Res := new O_Enode_Type (ON_Op_To_OE (Kind));
+      Res.Ref := False;
+      Res.Operand := Operand;
+      Res.Rtype := Operand.Rtype;
+      return Res;
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      if Ntype.Kind /= ON_Boolean_Type then
+         raise Type_Error;
+      end if;
+      if Left.Rtype /= Right.Rtype then
+         raise Type_Error;
+      end if;
+      Check_Ref (Left);
+      Check_Ref (Right);
+      Res := new O_Enode_Type (ON_Op_To_OE (Kind));
+      Res.Ref := False;
+      Res.Left := Left;
+      Res.Right := Right;
+      Res.Rtype := Ntype;
+      return Res;
+   end New_Compare_Op;
+
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Signed_Lit is O_Cnode_Type (OC_Signed_Lit);
+   begin
+      if Ltype.Kind = ON_Signed_Type then
+         return new O_Cnode_Signed_Lit'(Kind => OC_Signed_Lit,
+                                        Ctype => Ltype,
+                                        Ref => False,
+                                        S_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Unsigned_Lit is O_Cnode_Type (OC_Unsigned_Lit);
+   begin
+      if Ltype.Kind = ON_Unsigned_Type then
+         return new O_Cnode_Unsigned_Lit'(Kind => OC_Unsigned_Lit,
+                                          Ctype => Ltype,
+                                          Ref => False,
+                                          U_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Unsigned_Literal;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode
+   is
+      subtype O_Cnode_Float_Lit is O_Cnode_Type (OC_Float_Lit);
+   begin
+      if Ltype.Kind = ON_Float_Type then
+         return new O_Cnode_Float_Lit'(Kind => OC_Float_Lit,
+                                       Ctype => Ltype,
+                                       Ref => False,
+                                       F_Val => Value);
+      else
+         raise Type_Error;
+      end if;
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Null_Lit_Type is O_Cnode_Type (OC_Null_Lit);
+   begin
+      if Ltype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      return  new O_Cnode_Null_Lit_Type'(Kind => OC_Null_Lit,
+                                         Ctype => Ltype,
+                                         Ref => False);
+   end New_Null_Access;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type
+        and then Rtype.Kind /= ON_Access_Type
+      then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      if Atype.Kind = ON_Array_Type then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Sizeof_Type'(Kind => OC_Sizeof_Lit,
+                                      Ctype => Rtype,
+                                      Ref => False,
+                                      S_Type => Atype);
+   end New_Sizeof;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Alignof_Type is O_Cnode_Type (OC_Alignof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      return new O_Cnode_Alignof_Type'(Kind => OC_Alignof_Lit,
+                                       Ctype => Rtype,
+                                       Ref => False,
+                                       S_Type => Atype);
+   end New_Alignof;
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode
+   is
+      subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type
+        and then Rtype.Kind /= ON_Access_Type
+      then
+         raise Type_Error;
+      end if;
+      if Field.Parent /= Atype then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Offsetof_Type'(Kind => OC_Offsetof_Lit,
+                                        Ctype => Rtype,
+                                        Ref => False,
+                                        Off_Field => Field);
+   end New_Offsetof;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      subtype O_Enode_Alloca_Type is O_Enode_Type (OE_Alloca);
+      Res : O_Enode;
+   begin
+      if Rtype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      if Size.Rtype.Kind /= ON_Unsigned_Type then
+         raise Type_Error;
+      end if;
+      Res := new O_Enode_Alloca_Type'(Kind => OE_Alloca,
+                                      Rtype => Rtype,
+                                      Ref => False,
+                                      A_Size => Size);
+      return Res;
+   end New_Alloca;
+
+   procedure Check_Constrained_Type (Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Array_Type =>
+            raise Type_Error;
+         when ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Boolean_Type
+           | ON_Record_Type
+           | ON_Union_Type
+           | ON_Access_Type
+           | ON_Float_Type
+           | ON_Array_Sub_Type
+           | ON_Enum_Type =>
+            null;
+      end case;
+   end Check_Constrained_Type;
+
+   procedure New_Completed_Type_Decl (Atype : O_Tnode)
+   is
+      N : O_Dnode;
+   begin
+      if Atype.Decl = null then
+         --  The uncompleted type must have been declared.
+         raise Type_Error;
+      end if;
+      N := new O_Dnode_Type (ON_Completed_Type_Decl);
+      N.Name := Atype.Decl.Name;
+      N.Dtype := Atype;
+      Add_Decl (N, False);
+   end New_Completed_Type_Decl;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode)
+   is
+      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+   begin
+      Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
+                                      Decl => O_Dnode_Null,
+                                      Uncomplete => True,
+                                      Complete => False,
+                                      Elements => O_Fnode_Null);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      if not Res.Uncomplete then
+         --  RES record type is not an uncomplete record type.
+         raise Syntax_Error;
+      end if;
+      if Res.Elements /= O_Fnode_Null then
+         --  RES record type already has elements...
+         raise Syntax_Error;
+      end if;
+      Elements.Res := Res;
+      Elements.Last := null;
+   end Start_Uncomplete_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List)
+   is
+      subtype O_Tnode_Record_Type is O_Tnode_Type (ON_Record_Type);
+   begin
+      Elements.Res := new O_Tnode_Record_Type'(Kind => ON_Record_Type,
+                                               Decl => O_Dnode_Null,
+                                               Uncomplete => False,
+                                               Complete => False,
+                                               Elements => O_Fnode_Null);
+      Elements.Last := null;
+   end Start_Record_Type;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+   begin
+      Check_Complete_Type (Etype);
+      Check_Constrained_Type (Etype);
+      El := new O_Fnode_Type'(Parent => Elements.Res,
+                              Next => null,
+                              Ident => Ident,
+                              Ftype => Etype,
+                              Offset => 0);
+      --  Append EL.
+      if Elements.Last = null then
+         Elements.Res.Elements := El;
+      else
+         Elements.Last.Next := El;
+      end if;
+      Elements.Last := El;
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      --  Align the structure.
+      Res := Elements.Res;
+      if Res.Uncomplete then
+         New_Completed_Type_Decl (Res);
+      end if;
+      Res.Complete := True;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List)
+   is
+      subtype O_Tnode_Union_Type is O_Tnode_Type (ON_Union_Type);
+   begin
+      Elements.Res := new O_Tnode_Union_Type'(Kind => ON_Union_Type,
+                                              Decl => O_Dnode_Null,
+                                              Uncomplete => False,
+                                              Complete => False,
+                                              Elements => O_Fnode_Null);
+      Elements.Last := null;
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode)
+   is
+   begin
+      New_Record_Field (Elements, El, Ident, Etype);
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Res := Elements.Res;
+      Res.Complete := True;
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      subtype O_Tnode_Access is O_Tnode_Type (ON_Access_Type);
+      Res : O_Tnode;
+   begin
+      if Dtype /= O_Tnode_Null
+        and then Dtype.Kind = ON_Array_Sub_Type
+      then
+         --  Access to sub array are not allowed, use access to array.
+         raise Type_Error;
+      end if;
+      Res := new O_Tnode_Access'(Kind => ON_Access_Type,
+                                 Decl => O_Dnode_Null,
+                                 Uncomplete => Dtype = O_Tnode_Null,
+                                 Complete => True,
+                                 D_Type => Dtype);
+      return Res;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
+   is
+   begin
+      if Dtype.Kind = ON_Array_Sub_Type then
+         --  Access to sub array are not allowed, use access to array.
+         raise Type_Error;
+      end if;
+      if Atype.D_Type /= O_Tnode_Null
+        or Atype.Uncomplete = False
+      then
+         --  Type already completed.
+         raise Syntax_Error;
+      end if;
+      Atype.D_Type := Dtype;
+      New_Completed_Type_Decl (Atype);
+   end Finish_Access_Type;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode
+   is
+      subtype O_Tnode_Array is O_Tnode_Type (ON_Array_Type);
+   begin
+      Check_Constrained_Type (El_Type);
+      Check_Complete_Type (El_Type);
+      return new O_Tnode_Array'(Kind => ON_Array_Type,
+                                Decl => O_Dnode_Null,
+                                Uncomplete => False,
+                                Complete => True,
+                                El_Type => El_Type,
+                                Index_Type => Index_Type);
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode
+   is
+      subtype O_Tnode_Sub_Array is O_Tnode_Type (ON_Array_Sub_Type);
+   begin
+      if Atype.Kind /= ON_Array_Type then
+         raise Type_Error;
+      end if;
+      return new O_Tnode_Sub_Array'(Kind => ON_Array_Sub_Type,
+                                    Decl => O_Dnode_Null,
+                                    Uncomplete => False,
+                                    Complete => True,
+                                    Base_Type => Atype,
+                                    Length => Length);
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+      subtype O_Tnode_Unsigned is O_Tnode_Type (ON_Unsigned_Type);
+   begin
+      return new O_Tnode_Unsigned'(Kind => ON_Unsigned_Type,
+                                   Decl => O_Dnode_Null,
+                                   Uncomplete => False,
+                                   Complete => True,
+                                   Int_Size => Size);
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+      subtype O_Tnode_Signed is O_Tnode_Type (ON_Signed_Type);
+   begin
+      return new O_Tnode_Signed'(Kind => ON_Signed_Type,
+                                 Decl => O_Dnode_Null,
+                                 Uncomplete => False,
+                                 Complete => True,
+                                 Int_Size => Size);
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode
+   is
+      subtype O_Tnode_Float is O_Tnode_Type (ON_Float_Type);
+   begin
+      return new O_Tnode_Float'(Kind => ON_Float_Type,
+                                Decl => O_Dnode_Null,
+                                Uncomplete => False,
+                                Complete => True);
+   end New_Float_Type;
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode)
+   is
+      subtype O_Tnode_Boolean is O_Tnode_Type (ON_Boolean_Type);
+      subtype O_Cnode_Boolean_Lit is O_Cnode_Type (OC_Boolean_Lit);
+   begin
+      Res := new O_Tnode_Boolean'(Kind => ON_Boolean_Type,
+                                  Decl => O_Dnode_Null,
+                                  Uncomplete => False,
+                                  Complete => True,
+                                  True_N => O_Cnode_Null,
+                                  False_N => O_Cnode_Null);
+      True_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit,
+                                         Ctype => Res,
+                                         Ref => False,
+                                         B_Val => True,
+                                         B_Id => True_Id);
+      False_E := new O_Cnode_Boolean_Lit'(Kind => OC_Boolean_Lit,
+                                          Ctype => Res,
+                                          Ref => False,
+                                          B_Val => False,
+                                          B_Id => False_Id);
+      Res.True_N := True_E;
+      Res.False_N := False_E;
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      pragma Unreferenced (Size);
+      subtype O_Tnode_Enum is O_Tnode_Type (ON_Enum_Type);
+      Res : O_Tnode;
+   begin
+      Res := new O_Tnode_Enum'(Kind => ON_Enum_Type,
+                               Decl => O_Dnode_Null,
+                               Uncomplete => False,
+                               Complete => False,
+                               Nbr => 0,
+                               Literals => O_Cnode_Null);
+      List.Res := Res;
+      List.Last := O_Cnode_Null;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident;
+                               Res : out O_Cnode)
+   is
+      subtype O_Cnode_Enum_Lit is O_Cnode_Type (OC_Enum_Lit);
+   begin
+      Res := new O_Cnode_Enum_Lit'(Kind => OC_Enum_Lit,
+                                   Ctype => List.Res,
+                                   Ref => False,
+                                   E_Val => List.Res.Nbr,
+                                   E_Name => Ident,
+                                   E_Next => O_Cnode_Null);
+      --  Link it.
+      if List.Last = O_Cnode_Null then
+         List.Res.Literals := Res;
+      else
+         List.Last.E_Next := Res;
+      end if;
+      List.Last := Res;
+
+      List.Res.Nbr := List.Res.Nbr + 1;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Res;
+      Res.Complete := True;
+   end Finish_Enum_Type;
+
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      case Atype.Kind is
+         when ON_Array_Sub_Type =>
+            return Atype.Base_Type;
+         when others =>
+            return Atype;
+      end case;
+   end Get_Base_Type;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode)
+   is
+      subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Record_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate,
+                                    Ctype => Atype,
+                                    Ref => False,
+                                    Aggr_Els => null);
+      List.Res := Res;
+      List.Last := null;
+      List.Field := Atype.Elements;
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode)
+   is
+      subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element);
+      El : O_Cnode;
+   begin
+      if List.Field = O_Fnode_Null then
+         --  No more element in the aggregate.
+         raise Syntax_Error;
+      end if;
+      Check_Type (Value.Ctype, List.Field.Ftype);
+      El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element,
+                                     Ctype => Value.Ctype,
+                                     Ref => False,
+                                     Aggr_Value => Value,
+                                     Aggr_Next => null);
+      if List.Last = null then
+         List.Res.Aggr_Els := El;
+      else
+         List.Last.Aggr_Next := El;
+      end if;
+      List.Last := El;
+      List.Field := List.Field.Next;
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List; Res : out O_Cnode)
+   is
+   begin
+      if List.Field /= null then
+         --  Not enough elements in aggregate.
+         raise Type_Error;
+      end if;
+      Res := List.Res;
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+      subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Array_Sub_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate,
+                                    Ctype => Atype,
+                                    Ref => False,
+                                    Aggr_Els => null);
+      List.Res := Res;
+      List.Last := null;
+      List.El_Type := Atype.Base_Type.El_Type;
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+      subtype O_Cnode_Aggrel_Type is O_Cnode_Type (OC_Aggr_Element);
+      El : O_Cnode;
+   begin
+      Check_Type (Value.Ctype, List.El_Type);
+      El := new O_Cnode_Aggrel_Type'(Kind => OC_Aggr_Element,
+                                     Ctype => Value.Ctype,
+                                     Ref => False,
+                                     Aggr_Value => Value,
+                                     Aggr_Next => null);
+      if List.Last = null then
+         List.Res.Aggr_Els := El;
+      else
+         List.Last.Aggr_Next := El;
+      end if;
+      List.Last := El;
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr
+     (List : in out O_Array_Aggr_List; Res : out O_Cnode) is
+   begin
+      Res := List.Res;
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      subtype O_Cnode_Union_Aggr is O_Cnode_Type (OC_Union_Aggr);
+      Res : O_Cnode;
+   begin
+      if Atype.Kind /= ON_Union_Type then
+         raise Type_Error;
+      end if;
+      Check_Type (Value.Ctype, Field.Ftype);
+
+      Res := new O_Cnode_Union_Aggr'(Kind => OC_Union_Aggr,
+                                     Ctype => Atype,
+                                     Ref => False,
+                                     Uaggr_Field => Field,
+                                     Uaggr_Value => Value);
+      return Res;
+   end New_Union_Aggr;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode
+   is
+      subtype O_Lnode_Obj is O_Lnode_Type (OL_Obj);
+   begin
+      case Obj.Kind is
+         when ON_Const_Decl
+           | ON_Var_Decl
+           | ON_Interface_Decl =>
+            null;
+         when others =>
+            raise Program_Error;
+      end case;
+      Check_Scope (Obj);
+      return new O_Lnode_Obj'(Kind => OL_Obj,
+                              Rtype => Obj.Dtype,
+                              Ref => False,
+                              Obj => Obj);
+   end New_Obj;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element);
+      Res : O_Lnode;
+   begin
+      Check_Ref (Arr);
+      Res := new O_Lnode_Indexed'(Kind => OL_Indexed_Element,
+                                  Rtype => Get_Base_Type (Arr.Rtype).El_Type,
+                                  Ref => False,
+                                  Array_Base => Arr,
+                                  Index => Index);
+      return Res;
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Slice is O_Lnode_Type (OL_Slice);
+      Res : O_Lnode;
+   begin
+      if Res_Type.Kind /= ON_Array_Type
+        and then Res_Type.Kind /= ON_Array_Sub_Type
+      then
+         raise Type_Error;
+      end if;
+      Check_Ref (Arr);
+      Check_Ref (Index);
+      -- FIXME: check type.
+      Res := new O_Lnode_Slice'(Kind => OL_Slice,
+                                Rtype => Res_Type,
+                                Ref => False,
+                                Slice_Base => Arr,
+                                Slice_Index => Index);
+      return Res;
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode
+   is
+      subtype O_Lnode_Selected_Element is O_Lnode_Type (OL_Selected_Element);
+   begin
+      if Rec.Rtype.Kind /= ON_Record_Type then
+         raise Type_Error;
+      end if;
+      if Rec.Rtype /= El.Parent then
+         raise Type_Error;
+      end if;
+      Check_Ref (Rec);
+      return new O_Lnode_Selected_Element'(Kind => OL_Selected_Element,
+                                           Rtype => El.Ftype,
+                                           Ref => False,
+                                           Rec_Base => Rec,
+                                           Rec_El => El);
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      subtype O_Lnode_Access_Element is O_Lnode_Type (OL_Access_Element);
+   begin
+      if Acc.Rtype.Kind /= ON_Access_Type then
+         raise Type_Error;
+      end if;
+      Check_Ref (Acc);
+      return new O_Lnode_Access_Element'(Kind => OL_Access_Element,
+                                         Rtype => Acc.Rtype.D_Type,
+                                         Ref => False,
+                                         Acc_Base => Acc);
+   end New_Access_Element;
+
+   function Check_Conv (Source : ON_Type_Kind; Target : ON_Type_Kind)
+     return Boolean
+   is
+      type Conv_Array is array (ON_Type_Kind, ON_Type_Kind) of Boolean;
+      T : constant Boolean := True;
+      F : constant Boolean := False;
+      Conv_Allowed : constant Conv_Array :=
+        (ON_Boolean_Type =>  (T, F, T, T, F, F, F, F, F, F),
+         ON_Enum_Type =>     (F, F, T, T, F, F, F, F, F, F),
+         ON_Unsigned_Type => (T, T, T, T, F, F, F, F, F, F),
+         ON_Signed_Type =>   (T, T, T, T, T, F, F, F, F, F),
+         ON_Float_Type =>    (F, F, F, T, T, F, F, F, F, F),
+         ON_Array_Type =>    (F, F, F, F, F, F, T, F, F, F),
+         ON_Array_Sub_Type =>(F, F, F, F, F, T, T, F, F, F),
+         ON_Record_Type =>   (F, F, F, F, F, F, F, F, F, F),
+         ON_Union_Type =>    (F, F, F, F, F, F, F, F, F, F),
+         ON_Access_Type =>   (F, F, F, F, F, F, F, F, F, T));
+   begin
+      if Source = Target then
+         return True;
+      else
+         return Conv_Allowed (Source, Target);
+      end if;
+   end Check_Conv;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      subtype O_Enode_Convert is O_Enode_Type (OE_Convert_Ov);
+      Res : O_Enode;
+   begin
+      Check_Ref (Val);
+      if not Check_Conv (Val.Rtype.Kind, Rtype.Kind) then
+         raise Type_Error;
+      end if;
+      Res := new O_Enode_Convert'(Kind => OE_Convert_Ov,
+                                  Rtype => Rtype,
+                                  Ref => False,
+                                  Conv => Val);
+      return Res;
+   end New_Convert_Ov;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode
+   is
+      subtype O_Enode_Address is O_Enode_Type (OE_Unchecked_Address);
+   begin
+      Check_Ref (Lvalue);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Enode_Address'(Kind => OE_Unchecked_Address,
+                                  Rtype => Atype,
+                                  Ref => False,
+                                  Lvalue => Lvalue);
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode
+   is
+      subtype O_Enode_Address is O_Enode_Type (OE_Address);
+   begin
+      Check_Ref (Lvalue);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      if Get_Base_Type (Lvalue.Rtype) /= Get_Base_Type (Atype.D_Type) then
+         if not Disable_Checks then
+            raise Type_Error;
+         end if;
+      end if;
+      return new O_Enode_Address'(Kind => OE_Address,
+                                  Rtype => Atype,
+                                  Ref => False,
+                                  Lvalue => Lvalue);
+   end New_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+      subtype O_Cnode_Address is O_Cnode_Type (OC_Unchecked_Address);
+   begin
+      Check_Scope (Decl);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Address'(Kind => OC_Unchecked_Address,
+                                  Ctype => Atype,
+                                  Ref => False,
+                                  Decl => Decl);
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Address is O_Cnode_Type (OC_Address);
+   begin
+      Check_Scope (Decl);
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      if Get_Base_Type (Decl.Dtype) /= Get_Base_Type (Atype.D_Type) then
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Address'(Kind => OC_Address,
+                                  Ctype => Atype,
+                                  Ref => False,
+                                  Decl => Decl);
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode
+   is
+      subtype O_Cnode_Subprg_Address is O_Cnode_Type (OC_Subprogram_Address);
+   begin
+      if Atype.Kind /= ON_Access_Type then
+         --  An address is of type access.
+         raise Type_Error;
+      end if;
+      return new O_Cnode_Subprg_Address'(Kind => OC_Subprogram_Address,
+                                         Ctype => Atype,
+                                         Ref => False,
+                                         Decl => Subprg);
+   end New_Subprogram_Address;
+
+   --  Raise TYPE_ERROR is ATYPE is a composite type.
+   procedure Check_Not_Composite (Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Boolean_Type
+           | ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Float_Type
+           | ON_Enum_Type
+           | ON_Access_Type=>
+            return;
+         when ON_Array_Type
+           | ON_Record_Type
+           | ON_Union_Type
+           | ON_Array_Sub_Type =>
+            raise Type_Error;
+      end case;
+   end Check_Not_Composite;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+      subtype O_Enode_Value is O_Enode_Type (OE_Value);
+   begin
+      Check_Not_Composite (Lvalue.Rtype);
+      Check_Ref (Lvalue);
+      return new O_Enode_Value'(Kind => OE_Value,
+                                Rtype => Lvalue.Rtype,
+                                Ref => False,
+                                Value => Lvalue);
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+      subtype O_Enode_Lit is O_Enode_Type (OE_Lit);
+   begin
+      Check_Not_Composite (Lit.Ctype);
+      return new O_Enode_Lit'(Kind => OE_Lit,
+                              Rtype => Lit.Ctype,
+                              Ref => False,
+                              Lit => Lit);
+   end New_Lit;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      subtype O_Dnode_Filename_Decl is O_Dnode_Type (ON_Debug_Filename_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Filename_Decl;
+      N.Filename := new String'(Filename);
+      Add_Decl (N, False);
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+      subtype O_Dnode_Line_Decl is O_Dnode_Type (ON_Debug_Line_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Line_Decl;
+      N.Line := Line;
+      Add_Decl (N, False);
+   end New_Debug_Line_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      subtype O_Dnode_Comment_Decl is O_Dnode_Type (ON_Debug_Comment_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Comment_Decl;
+      N.Comment := new String'(Comment);
+      Add_Decl (N, False);
+   end New_Debug_Comment_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode)
+   is
+      N : O_Dnode;
+   begin
+      if Atype.Decl /= null then
+         --  Type was already declared.
+         raise Type_Error;
+      end if;
+      N := new O_Dnode_Type (ON_Type_Decl);
+      N.Name := Ident;
+      N.Dtype := Atype;
+      Atype.Decl := N;
+      Add_Decl (N);
+   end New_Type_Decl;
+
+   procedure Check_Object_Storage (Storage : O_Storage) is
+   begin
+      if Current_Function /= null then
+         --  Inside a subprogram.
+         case Storage is
+            when O_Storage_Public =>
+               --  Cannot create public variables inside a subprogram.
+               raise Syntax_Error;
+            when O_Storage_Private
+              | O_Storage_Local
+              | O_Storage_External =>
+               null;
+         end case;
+      else
+         --  Global scope.
+         case Storage is
+            when O_Storage_Public
+              | O_Storage_Private
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               --  Cannot create a local variables outside a subprogram.
+               raise Syntax_Error;
+         end case;
+      end if;
+   end Check_Object_Storage;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Const is O_Dnode_Type (ON_Const_Decl);
+   begin
+      Check_Complete_Type (Atype);
+      if Storage = O_Storage_Local then
+         --  A constant cannot be local.
+         raise Syntax_Error;
+      end if;
+      Check_Object_Storage (Storage);
+      Res := new O_Dnode_Const'(Kind => ON_Const_Decl,
+                                Name => Ident,
+                                Next => null,
+                                Dtype => Atype,
+                                Storage => Storage,
+                                Scope => Current_Decl_Scope.Parent,
+                                Lineno => 0,
+                                Const_Value => O_Dnode_Null);
+      Add_Decl (Res);
+   end New_Const_Decl;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value);
+      N : O_Dnode;
+   begin
+      if Const.Const_Value /= O_Dnode_Null then
+         --  Constant already has a value.
+         raise Syntax_Error;
+      end if;
+
+      if Const.Storage = O_Storage_External then
+         --  An external constant must not have a value.
+         raise Syntax_Error;
+      end if;
+
+      --  FIXME: check scope is the same.
+
+      N := new O_Dnode_Const_Value'(Kind => ON_Const_Value,
+                                    Name => Const.Name,
+                                    Next => null,
+                                    Dtype => Const.Dtype,
+                                    Storage => Const.Storage,
+                                    Scope => Current_Decl_Scope.Parent,
+                                    Lineno => 0,
+                                    Const_Decl => Const,
+                                    Value => O_Cnode_Null);
+      Const.Const_Value := N;
+      Add_Decl (N, False);
+   end Start_Const_Value;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+   begin
+      if Const.Const_Value = O_Dnode_Null then
+         --  Start_Const_Value not called.
+         raise Syntax_Error;
+      end if;
+      if Const.Const_Value.Value /= O_Cnode_Null then
+         --  Finish_Const_Value already called.
+         raise Syntax_Error;
+      end if;
+      if Val = O_Cnode_Null then
+         --  No value or bad type.
+         raise Type_Error;
+      end if;
+      Check_Type (Val.Ctype, Const.Dtype);
+      Const.Const_Value.Value := Val;
+   end Finish_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Var is O_Dnode_Type (ON_Var_Decl);
+   begin
+      Check_Complete_Type (Atype);
+      Check_Object_Storage (Storage);
+      Res := new O_Dnode_Var'(Kind => ON_Var_Decl,
+                              Name => Ident,
+                              Next => null,
+                              Dtype => Atype,
+                              Storage => Storage,
+                              Lineno => 0,
+                              Scope => Current_Decl_Scope.Parent);
+      Add_Decl (Res);
+   end New_Var_Decl;
+
+   procedure Start_Subprogram_Decl_1
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+      subtype O_Dnode_Function is O_Dnode_Type (ON_Function_Decl);
+      N : O_Dnode;
+   begin
+      N := new O_Dnode_Function'(Kind => ON_Function_Decl,
+                                 Next => null,
+                                 Name => Ident,
+                                 Dtype => Rtype,
+                                 Storage => Storage,
+                                 Scope => Current_Decl_Scope.Parent,
+                                 Lineno => 0,
+                                 Interfaces => null,
+                                 Func_Body => null,
+                                 Alive => False);
+      Add_Decl (N);
+      Interfaces.Func := N;
+      Interfaces.Last := null;
+   end Start_Subprogram_Decl_1;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Check_Not_Composite (Rtype);
+      Check_Complete_Type (Rtype);
+      Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, Rtype);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage) is
+   begin
+      Start_Subprogram_Decl_1 (Interfaces, Ident, Storage, null);
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      subtype O_Dnode_Interface is O_Dnode_Type (ON_Interface_Decl);
+   begin
+      Check_Not_Composite (Atype);
+      Check_Complete_Type (Atype);
+      Res := new O_Dnode_Interface'(Kind => ON_Interface_Decl,
+                                    Next => null,
+                                    Name => Ident,
+                                    Dtype => Atype,
+                                    Storage => O_Storage_Private,
+                                    Scope => Current_Decl_Scope.Parent,
+                                    Lineno => 0,
+                                    Func_Scope => Interfaces.Func);
+      if Interfaces.Last = null then
+         Interfaces.Func.Interfaces := Res;
+      else
+         Interfaces.Last.Next := Res;
+      end if;
+      Interfaces.Last := Res;
+   end New_Interface_Decl;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode)
+   is
+   begin
+      Res := Interfaces.Func;
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      B : O_Dnode;
+      S : O_Snode;
+   begin
+      if Func.Func_Body /= null then
+         --  Function was already declared.
+         raise Syntax_Error;
+      end if;
+      S := new O_Snode_Type (ON_Declare_Stmt);
+      S.all := O_Snode_Type'(Kind => ON_Declare_Stmt,
+                             Next => null,
+                             Decls => null,
+                             Stmts => null,
+                             Lineno => 0,
+                             Alive => True);
+      B := new O_Dnode_Type (ON_Function_Body);
+      B.all := O_Dnode_Type'(ON_Function_Body,
+                             Name => Func.Name,
+                             Dtype => Func.Dtype,
+                             Storage => Func.Storage,
+                             Scope => Current_Decl_Scope.Parent,
+                             Lineno => 0,
+                             Func_Decl => Func,
+                             Func_Stmt => S,
+                             Next => null);
+      Add_Decl (B, False);
+      Func.Func_Body := B;
+      Push_Decl_Scope (S);
+      Push_Stmt_Scope
+        (new Stmt_Function_Scope_Type'(Kind => Stmt_Function,
+                                       Parent => S,
+                                       Prev => Current_Stmt_Scope,
+                                       Prev_Function => Current_Function,
+                                       Decl => Func));
+      Current_Function := Current_Stmt_Scope;
+      Func.Alive := True;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body is
+   begin
+      Pop_Decl_Scope;
+      if Current_Function.Kind /= Stmt_Function then
+         --  Internal error.
+         raise Syntax_Error;
+      end if;
+      Current_Function.Decl.Alive := False;
+      Current_Function := Current_Function.Prev_Function;
+      Pop_Stmt_Scope (Stmt_Function);
+   end Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural)
+   is
+      subtype O_Snode_Line_Stmt is O_Snode_Type (ON_Debug_Line_Stmt);
+   begin
+      Add_Stmt (new O_Snode_Line_Stmt'(Kind => ON_Debug_Line_Stmt,
+                                       Next => null,
+                                       Lineno => 0,
+                                       Line => Line));
+   end New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      subtype O_Snode_Comment_Stmt is O_Snode_Type (ON_Debug_Comment_Stmt);
+   begin
+      Add_Stmt (new O_Snode_Comment_Stmt'(Kind => ON_Debug_Comment_Stmt,
+                                          Next => null,
+                                          Lineno => 0,
+                                          Comment => new String'(Comment)));
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Declare_Stmt
+   is
+      N : O_Snode;
+   begin
+      N := new O_Snode_Type (ON_Declare_Stmt);
+      Add_Stmt (N);
+      Push_Decl_Scope (N);
+      Push_Stmt_Scope
+        (new Stmt_Declare_Scope_Type'(Kind => Stmt_Declare,
+                                      Parent => N,
+                                      Prev => Current_Stmt_Scope));
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt is
+   begin
+      Pop_Decl_Scope;
+      Pop_Stmt_Scope (Stmt_Declare);
+   end Finish_Declare_Stmt;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      N : O_Snode;
+   begin
+      Check_Type (Target.Rtype, Value.Rtype);
+      Check_Not_Composite (Target.Rtype);
+      Check_Ref (Target);
+      Check_Ref (Value);
+      N := new O_Snode_Type (ON_Assign_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_Assign_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Target => Target,
+                             Value => Value);
+      Add_Stmt (N);
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt_1 (Value : O_Enode)
+   is
+      subtype O_Snode_Return_Stmt is O_Snode_Type (ON_Return_Stmt);
+      N : O_Snode;
+   begin
+      N := new O_Snode_Return_Stmt'(Kind => ON_Return_Stmt,
+                                    Next => null,
+                                    Lineno => 0,
+                                    Ret_Val => Value);
+      Add_Stmt (N);
+   end New_Return_Stmt_1;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+   begin
+      if Current_Function = null
+        or else Current_Function.Decl.Dtype = O_Tnode_Null
+      then
+         -- Either not in a function or in a procedure.
+         raise Syntax_Error;
+      end if;
+      Check_Type (Value.Rtype, Current_Function.Decl.Dtype);
+      Check_Ref (Value);
+      New_Return_Stmt_1 (Value);
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt is
+   begin
+      if Current_Function = null
+        or else Current_Function.Decl.Dtype /= O_Tnode_Null
+      then
+         -- Not in a procedure.
+         raise Syntax_Error;
+      end if;
+      New_Return_Stmt_1 (null);
+   end New_Return_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Check_Scope (Subprg);
+      Assocs.Subprg := Subprg;
+      Assocs.Interfaces := Subprg.Interfaces;
+      Assocs.First := null;
+      Assocs.Last := null;
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+      N : O_Anode;
+   begin
+      Check_Type (Assocs.Interfaces.Dtype, Val.Rtype);
+      Check_Ref (Val);
+      N := new O_Anode_Type'(Next => null,
+                             Formal => Assocs.Interfaces, Actual => Val);
+      Assocs.Interfaces := Assocs.Interfaces.Next;
+      if Assocs.Last = null then
+         Assocs.First := N;
+      else
+         Assocs.Last.Next := N;
+      end if;
+      Assocs.Last := N;
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      subtype O_Enode_Call is O_Enode_Type (OE_Function_Call);
+      Res : O_Enode;
+   begin
+      if Assocs.Interfaces /= null then
+         --  Not enough arguments.
+         raise Syntax_Error;
+      end if;
+      if Assocs.Subprg.Dtype = null then
+         --  This is a procedure.
+         raise Syntax_Error;
+      end if;
+
+      Res := new O_Enode_Call'(Kind => OE_Function_Call,
+                               Rtype => Assocs.Subprg.Dtype,
+                               Ref => False,
+                               Func => Assocs.Subprg,
+                               Assoc => Assocs.First);
+      return Res;
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      N : O_Snode;
+   begin
+      if Assocs.Interfaces /= null then
+         --  Not enough arguments.
+         raise Syntax_Error;
+      end if;
+      if Assocs.Subprg.Dtype /= null then
+         --  This is a function.
+         raise Syntax_Error;
+      end if;
+      N := new O_Snode_Type (ON_Call_Stmt);
+      N.Proc := Assocs.Subprg;
+      N.Assoc := Assocs.First;
+      Add_Stmt (N);
+   end New_Procedure_Call;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      subtype O_Snode_If is O_Snode_Type (ON_If_Stmt);
+      N : O_Snode;
+   begin
+      --  Note: no checks are performed here, since they are done in
+      --  new_elsif_stmt.
+      N := new O_Snode_If'(Kind => ON_If_Stmt,
+                           Next => null,
+                           Lineno => 0,
+                           Elsifs => null,
+                           If_Last => null);
+      Add_Stmt (N);
+      Push_Stmt_Scope (new Stmt_If_Scope_Type'(Kind => Stmt_If,
+                                               Parent => N,
+                                               Prev => Current_Stmt_Scope,
+                                               Last_Elsif => null));
+      New_Elsif_Stmt (Block, Cond);
+   end Start_If_Stmt;
+
+   procedure New_Elsif_Stmt (Block : in out O_If_Block; Cond : O_Enode)
+   is
+      pragma Unreferenced (Block);
+      N : O_Snode;
+   begin
+      if Cond /= null then
+         if Cond.Rtype.Kind /= ON_Boolean_Type then
+            raise Type_Error;
+         end if;
+         Check_Ref (Cond);
+      end if;
+      N := new O_Snode_Type (ON_Elsif_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_Elsif_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Cond => Cond,
+                             Next_Elsif => null);
+      if Current_Stmt_Scope.Kind /= Stmt_If then
+         raise Syntax_Error;
+      end if;
+      Add_Stmt (N);
+      if Current_Stmt_Scope.Last_Elsif = null then
+         Current_Stmt_Scope.Parent.Elsifs := N;
+      else
+         --  Check for double 'else'
+         if Current_Stmt_Scope.Last_Elsif.Cond = null then
+            raise Syntax_Error;
+         end if;
+         Current_Stmt_Scope.Last_Elsif.Next_Elsif := N;
+      end if;
+      Current_Stmt_Scope.Last_Elsif := N;
+   end New_Elsif_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      New_Elsif_Stmt (Block, null);
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block)
+   is
+      pragma Unreferenced (Block);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_If);
+      Parent.If_Last := Current_Decl_Scope.Last_Stmt;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+      subtype O_Snode_Loop_Type is O_Snode_Type (ON_Loop_Stmt);
+   begin
+      Current_Loop_Level := Current_Loop_Level + 1;
+      Label := new O_Snode_Loop_Type'(Kind => ON_Loop_Stmt,
+                                      Next => null,
+                                      Lineno => 0,
+                                      Loop_Last => null,
+                                      Loop_Level => Current_Loop_Level);
+      Add_Stmt (Label);
+      Push_Stmt_Scope (new Stmt_Loop_Scope_Type'(Kind => Stmt_Loop,
+                                                 Parent => Label,
+                                                 Prev => Current_Stmt_Scope));
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+      pragma Unreferenced (Label);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_Loop);
+      Parent.Loop_Last := Current_Decl_Scope.Last_Stmt;
+      Current_Loop_Level := Current_Loop_Level - 1;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Next_Stmt (Kind : ON_Stmt_Kind; L : O_Snode)
+   is
+      N : O_Snode;
+   begin
+      N := new O_Snode_Type (Kind);
+      N.Next := null;
+      N.Loop_Id := L;
+      Add_Stmt (N);
+   end New_Exit_Next_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      New_Exit_Next_Stmt (ON_Exit_Stmt, L);
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      New_Exit_Next_Stmt (ON_Next_Stmt, L);
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode)
+   is
+      subtype O_Snode_Case_Type is O_Snode_Type (ON_Case_Stmt);
+      N : O_Snode;
+   begin
+      case Value.Rtype.Kind is
+         when ON_Boolean_Type
+           | ON_Unsigned_Type
+           | ON_Signed_Type
+           | ON_Enum_Type =>
+            null;
+         when others =>
+            raise Type_Error;
+      end case;
+      Check_Ref (Value);
+      N := new O_Snode_Case_Type'(Kind => ON_Case_Stmt,
+                                  Next => null,
+                                  Lineno => 0,
+                                  Case_Last => null,
+                                  Selector => Value,
+                                  Branches => null);
+      Block.Case_Stmt := N;
+      Add_Stmt (N);
+      Push_Stmt_Scope (new Stmt_Case_Scope_Type'(Kind => Stmt_Case,
+                                                 Parent => N,
+                                                 Prev => Current_Stmt_Scope,
+                                                 Last_Branch => null,
+                                                 Last_Choice => null,
+                                                 Case_Type => Value.Rtype));
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+      N : O_Snode;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a branch outside a case statment.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice /= null then
+         --  You are creating branch while the previous one was not finished.
+         raise Syntax_Error;
+      end if;
+
+      N := new O_Snode_Type (ON_When_Stmt);
+      N.all := O_Snode_Type'(Kind => ON_When_Stmt,
+                             Next => null,
+                             Lineno => 0,
+                             Branch_Parent => Block.Case_Stmt,
+                             Choice_List => null,
+                             Next_Branch => null);
+      if Current_Stmt_Scope.Last_Branch = null then
+         Current_Stmt_Scope.Parent.Branches := N;
+      else
+         Current_Stmt_Scope.Last_Branch.Next_Branch := N;
+      end if;
+      Current_Stmt_Scope.Last_Branch := N;
+      Current_Stmt_Scope.Last_Choice := null;
+      Add_Stmt (N);
+   end Start_Choice;
+
+   procedure Add_Choice (Block : in out O_Case_Block; Choice : O_Choice)
+   is
+      pragma Unreferenced (Block);
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Branch = null then
+         --  You are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice = null then
+         if Current_Stmt_Scope.Last_Branch.Choice_List /= null then
+            --  The branch was already closed.
+            raise Syntax_Error;
+         end if;
+         Current_Stmt_Scope.Last_Branch.Choice_List := Choice;
+      else
+         Current_Stmt_Scope.Last_Choice.Next := Choice;
+      end if;
+      Current_Stmt_Scope.Last_Choice := Choice;
+   end Add_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Case_Type /= Expr.Ctype then
+         --  Expr type is not the same as choice type.
+         raise Type_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Expr);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Expr,
+                              Next => null,
+                              Expr => Expr);
+      Add_Choice (Block, N);
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Case_Type /= Low.Ctype
+        or Current_Stmt_Scope.Case_Type /= High.Ctype
+      then
+         --  Low/High type is not the same as choice type.
+         raise Type_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Range);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Range,
+                              Next => null,
+                              Low => Low,
+                              High => High);
+      Add_Choice (Block, N);
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block)
+   is
+      N : O_Choice;
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are creating a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+
+      N := new O_Choice_Type (ON_Choice_Default);
+      N.all := O_Choice_Type'(Kind => ON_Choice_Default,
+                             Next => null);
+      Add_Choice (Block, N);
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block)
+   is
+      pragma Unreferenced (Block);
+   begin
+      if Current_Stmt_Scope.Kind /= Stmt_Case then
+         --  You are adding a choice not inside a case statement.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Branch = null then
+         --  You are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      if Current_Stmt_Scope.Last_Choice = null then
+         --  The branch is empty or you are not inside a branch.
+         raise Syntax_Error;
+      end if;
+      Current_Stmt_Scope.Last_Choice := null;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block)
+   is
+      pragma Unreferenced (Block);
+      Parent : O_Snode;
+   begin
+      Parent := Current_Stmt_Scope.Parent;
+      Pop_Stmt_Scope (Stmt_Case);
+      Parent.Case_Last := Current_Decl_Scope.Last_Stmt;
+   end Finish_Case_Stmt;
+
+   procedure Init is
+   begin
+      Top := new O_Snode_Type (ON_Declare_Stmt);
+      Push_Decl_Scope (Top);
+   end Init;
+
+   procedure Finish is
+   begin
+      Pop_Decl_Scope;
+   end Finish;
+end Ortho_Debug;
diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads
new file mode 100644
index 000000000..69ee16cf7
--- /dev/null
+++ b/src/ortho/debug/ortho_debug.private.ads
@@ -0,0 +1,467 @@
+--  Ortho debug back-end declarations.
+--  Copyright (C) 2005-2014 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 Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Debug is
+   procedure Init;
+   procedure Finish;
+
+private
+   --  This back-end supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   --  A node for a type.
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+
+   --  A node for a statement.
+   type O_Snode_Type (<>);
+   type O_Snode is access O_Snode_Type;
+
+   Top : O_Snode;
+
+   type Str_Acc is access String;
+
+   type Decl_Scope_Type;
+   type Decl_Scope_Acc is access Decl_Scope_Type;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl, ON_Var_Decl, ON_Interface_Decl,
+      ON_Function_Decl, ON_Function_Body,
+      ON_Const_Value,
+      ON_Debug_Line_Decl, ON_Debug_Comment_Decl, ON_Debug_Filename_Decl);
+
+   type O_Dnode_Type (<>);
+   type O_Dnode is access O_Dnode_Type;
+
+   O_Dnode_Null : constant O_Dnode := null;
+
+   type O_Dnode_Type (Kind : On_Decl_Kind) is record
+      Next : O_Dnode;
+      Name : O_Ident;
+      Dtype : O_Tnode;
+      Storage : O_Storage;
+      --  Declare statement in which the declaration appears.
+      Scope : O_Snode;
+      --  Line number, for regen.
+      Lineno : Natural;
+      case Kind is
+         when ON_Type_Decl =>
+            null;
+         when ON_Completed_Type_Decl =>
+            null;
+         when ON_Const_Decl =>
+            Const_Value : O_Dnode;
+         when ON_Const_Value =>
+            Const_Decl : O_Dnode;
+            Value : O_Cnode;
+         when ON_Var_Decl =>
+            null;
+         when ON_Function_Decl =>
+            Interfaces : O_Dnode;
+            Func_Body : O_Dnode;
+            Alive : Boolean;
+         when ON_Function_Body =>
+            Func_Decl : O_Dnode;
+            Func_Stmt : O_Snode;
+         when ON_Interface_Decl =>
+            Func_Scope : O_Dnode;
+         when ON_Debug_Line_Decl =>
+            Line : Natural;
+         when ON_Debug_Comment_Decl =>
+            Comment : Str_Acc;
+         when ON_Debug_Filename_Decl =>
+            Filename : Str_Acc;
+      end case;
+   end record;
+
+   --  A node for a record element.
+   type O_Fnode_Type;
+   type O_Fnode is access O_Fnode_Type;
+
+   O_Fnode_Null : constant O_Fnode := null;
+
+   type O_Fnode_Type is record
+      --  Record type.
+      Parent : O_Tnode;
+      --  Next field in the record.
+      Next : O_Fnode;
+      --  Name of the record field.
+      Ident : O_Ident;
+      --  Type of the record field.
+      Ftype : O_Tnode;
+      --  Offset in the field.
+      Offset : Unsigned_32;
+   end record;
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type OC_Kind is
+     (
+      OC_Boolean_Lit,
+      OC_Unsigned_Lit,
+      OC_Signed_Lit,
+      OC_Float_Lit,
+      OC_Enum_Lit,
+      OC_Null_Lit,
+      OC_Sizeof_Lit,
+      OC_Alignof_Lit,
+      OC_Offsetof_Lit,
+      OC_Aggregate,
+      OC_Aggr_Element,
+      OC_Union_Aggr,
+      OC_Address,
+      OC_Unchecked_Address,
+      OC_Subprogram_Address
+     );
+   type O_Cnode_Type (Kind : OC_Kind) is record
+      --  Type of the constant.
+      Ctype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OC_Unsigned_Lit =>
+            U_Val : Unsigned_64;
+         when OC_Signed_Lit =>
+            S_Val : Integer_64;
+         when OC_Float_Lit =>
+            F_Val : IEEE_Float_64;
+         when OC_Boolean_Lit =>
+            B_Val : Boolean;
+            B_Id : O_Ident;
+         when OC_Enum_Lit =>
+            E_Val : Integer;
+            E_Next : O_Cnode;
+            E_Name : O_Ident;
+         when OC_Null_Lit =>
+            null;
+         when OC_Sizeof_Lit
+           | OC_Alignof_Lit =>
+            S_Type : O_Tnode;
+         when OC_Offsetof_Lit =>
+            Off_Field : O_Fnode;
+         when OC_Aggregate =>
+            Aggr_Els : O_Cnode;
+         when OC_Union_Aggr =>
+            Uaggr_Field : O_Fnode;
+            Uaggr_Value : O_Cnode;
+         when OC_Aggr_Element =>
+            Aggr_Value : O_Cnode;
+            Aggr_Next : O_Cnode;
+         when OC_Address
+           | OC_Unchecked_Address
+           | OC_Subprogram_Address =>
+            Decl : O_Dnode;
+      end case;
+   end record;
+
+   type O_Cnode is access O_Cnode_Type;
+   O_Cnode_Null : constant O_Cnode := null;
+
+   type OE_Kind is
+     (
+      --  Literals.
+      OE_Lit,
+
+      --  Dyadic operations.
+      OE_Add_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Sub_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Mul_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Div_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Rem_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Mod_Ov,                --  OE_Dyadic_Op_Kind
+      OE_Exp_Ov,                --  OE_Dyadic_Op_Kind
+
+      --  Binary operations.
+      OE_And,                   --  OE_Dyadic_Op_Kind
+      OE_Or,                    --  OE_Dyadic_Op_Kind
+      OE_Xor,                   --  OE_Dyadic_Op_Kind
+      OE_And_Then,              --  OE_Dyadic_Op_Kind
+      OE_Or_Else,               --  OE_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      OE_Not,                   --  OE_Monadic_Op_Kind
+      OE_Neg_Ov,                --  OE_Monadic_Op_Kind
+      OE_Abs_Ov,                --  OE_Monadic_Op_Kind
+
+      --  Comparaisons
+      OE_Eq,                    --  OE_Compare_Op_Kind
+      OE_Neq,                   --  OE_Compare_Op_Kind
+      OE_Le,                    --  OE_Compare_Op_Kind
+      OE_Lt,                    --  OE_Compare_Op_Kind
+      OE_Ge,                    --  OE_Compare_Op_Kind
+      OE_Gt,                    --  OE_Compare_Op_Kind
+
+      --  Misc.
+      OE_Convert_Ov,
+      OE_Address,
+      OE_Unchecked_Address,
+      OE_Alloca,
+      OE_Function_Call,
+
+      OE_Value,
+      OE_Nil
+      );
+
+   subtype OE_Dyadic_Expr_Kind is OE_Kind range OE_Add_Ov .. OE_Or_Else;
+   subtype OE_Monadic_Expr_Kind is OE_Kind range OE_Not .. OE_Abs_Ov;
+   subtype OE_Compare_Expr_Kind is OE_Kind range OE_Eq .. OE_Gt;
+
+   type O_Enode_Type (Kind : OE_Kind);
+   type O_Enode is access O_Enode_Type;
+   O_Enode_Null : constant O_Enode := null;
+
+   type O_Enode_Type (Kind : OE_Kind) is record
+      --  Type of the result.
+      Rtype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OE_Dyadic_Expr_Kind
+           | OE_Compare_Expr_Kind =>
+            Left : O_Enode;
+            Right : O_Enode;
+         when OE_Monadic_Expr_Kind =>
+            Operand : O_Enode;
+         when OE_Lit =>
+            Lit : O_Cnode;
+         when OE_Address
+           | OE_Unchecked_Address =>
+            Lvalue : O_Lnode;
+         when OE_Convert_Ov =>
+            Conv : O_Enode;
+         when OE_Function_Call =>
+            Func : O_Dnode;
+            Assoc : O_Anode;
+         when OE_Value =>
+            Value : O_Lnode;
+         when OE_Alloca =>
+            A_Size : O_Enode;
+         when OE_Nil =>
+            null;
+      end case;
+   end record;
+   type O_Enode_Array is array (Natural range <>) of O_Enode;
+   type O_Enode_Array_Acc is access O_Enode_Array;
+
+   type OL_Kind is
+     (
+      --  Name.
+      OL_Obj,
+      OL_Indexed_Element,
+      OL_Slice,
+      OL_Selected_Element,
+      OL_Access_Element
+
+      --  Variable, constant, parameter reference.
+      --  This allows to read/write a declaration.
+      --OL_Var_Ref,
+      --OL_Const_Ref,
+      --OL_Param_Ref
+      );
+
+   type O_Lnode_Type (Kind : OL_Kind);
+   type O_Lnode is access O_Lnode_Type;
+   O_Lnode_Null : constant O_Lnode := null;
+
+   type O_Lnode_Type (Kind : OL_Kind) is record
+      --  Type of the result.
+      Rtype : O_Tnode;
+      --  True if referenced.
+      Ref : Boolean;
+      case Kind is
+         when OL_Obj =>
+            Obj : O_Dnode;
+         when OL_Indexed_Element =>
+            Array_Base : O_Lnode;
+            Index : O_Enode;
+         when OL_Slice =>
+            Slice_Base : O_Lnode;
+            Slice_Index : O_Enode;
+         when OL_Selected_Element =>
+            Rec_Base : O_Lnode;
+            Rec_El : O_Fnode;
+         when OL_Access_Element =>
+            Acc_Base : O_Enode;
+--          when OL_Var_Ref
+--            | OL_Const_Ref
+--            | OL_Param_Ref =>
+--             Decl : O_Dnode;
+      end case;
+   end record;
+
+   O_Tnode_Null : constant O_Tnode := null;
+   type ON_Type_Kind is
+     (ON_Boolean_Type, ON_Enum_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Float_Type, ON_Array_Type,
+      ON_Array_Sub_Type, ON_Record_Type, ON_Union_Type, ON_Access_Type);
+   type O_Tnode_Type (Kind : ON_Type_Kind) is record
+      Decl : O_Dnode;
+      --  True if the type was first created as an uncomplete type.
+      Uncomplete : Boolean;
+      --  True if the type is complete.
+      Complete : Boolean;
+      case Kind is
+         when ON_Boolean_Type =>
+            True_N : O_Cnode;
+            False_N : O_Cnode;
+         when ON_Unsigned_Type
+           | ON_Signed_Type =>
+            Int_Size : Natural;
+         when ON_Float_Type =>
+            null;
+         when ON_Enum_Type =>
+            Nbr : Natural;
+            Literals: O_Cnode;
+         when ON_Array_Type =>
+            El_Type : O_Tnode;
+            Index_Type : O_Tnode;
+         when ON_Access_Type =>
+            D_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Union_Type =>
+            Elements : O_Fnode;
+         when ON_Array_Sub_Type =>
+            Length : O_Cnode;
+            Base_Type : O_Tnode;
+      end case;
+   end record;
+
+   type ON_Choice_Kind is (ON_Choice_Expr, ON_Choice_Range, ON_Choice_Default);
+   type O_Choice_Type (Kind : ON_Choice_Kind);
+   type O_Choice is access O_Choice_Type;
+   type O_Choice_Type (Kind : ON_Choice_Kind) is record
+      Next : O_Choice;
+      case Kind is
+         when ON_Choice_Expr =>
+            Expr : O_Cnode;
+         when ON_Choice_Range =>
+            Low, High : O_Cnode;
+         when ON_Choice_Default =>
+            null;
+      end case;
+   end record;
+
+   O_Snode_Null : constant O_Snode := null;
+   type ON_Stmt_Kind is
+     (ON_Declare_Stmt, ON_Assign_Stmt, ON_Return_Stmt, ON_If_Stmt,
+      ON_Elsif_Stmt, ON_Loop_Stmt, ON_Exit_Stmt, ON_Next_Stmt,
+      ON_Case_Stmt, ON_When_Stmt, ON_Call_Stmt,
+      ON_Debug_Line_Stmt, ON_Debug_Comment_Stmt);
+   type O_Snode_Type (Kind : ON_Stmt_Kind) is record
+      Next : O_Snode;
+      Lineno : Natural;
+      case Kind is
+         when ON_Declare_Stmt =>
+            Decls : O_Dnode;
+            Stmts : O_Snode;
+            --  True if the statement is currently open.
+            Alive : Boolean;
+         when ON_Assign_Stmt =>
+            Target : O_Lnode;
+            Value : O_Enode;
+         when ON_Return_Stmt =>
+            Ret_Val : O_Enode;
+         when ON_If_Stmt =>
+            Elsifs : O_Snode;
+            If_Last : O_Snode;
+         when ON_Elsif_Stmt =>
+            Cond : O_Enode;
+            Next_Elsif : O_Snode;
+         when ON_Loop_Stmt =>
+            Loop_Last : O_Snode;
+            Loop_Level : Natural;
+         when ON_Exit_Stmt
+           | ON_Next_Stmt =>
+            Loop_Id : O_Snode;
+         when ON_Case_Stmt =>
+            Selector : O_Enode;
+            --  Simply linked list of branches
+            Branches : O_Snode;
+            Case_Last : O_Snode;
+         when ON_When_Stmt =>
+            --  The corresponding 'case'
+            Branch_Parent : O_Snode;
+            Choice_List : O_Choice;
+            Next_Branch : O_Snode;
+         when ON_Call_Stmt =>
+            Proc : O_Dnode;
+            Assoc : O_Anode;
+         when ON_Debug_Line_Stmt =>
+            Line : Natural;
+         when ON_Debug_Comment_Stmt =>
+            Comment : Str_Acc;
+      end case;
+   end record;
+
+   type O_Inter_List is record
+      Func : O_Dnode;
+      Last : O_Dnode;
+   end record;
+
+   type O_Element_List is record
+      --  The type definition.
+      Res : O_Tnode;
+      --  The last element added.
+      Last : O_Fnode;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Res : O_Cnode;
+      Last : O_Cnode;
+      Field : O_Fnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      Res : O_Cnode;
+      Last : O_Cnode;
+      El_Type : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Interfaces : O_Dnode;
+      First, Last : O_Anode;
+   end record;
+
+   type O_Enum_List is record
+      --  The type built.
+      Res : O_Tnode;
+
+      --  the chain of declarations.
+      Last : O_Cnode;
+   end record;
+   type O_Case_Block is record
+      Case_Stmt : O_Snode;
+   end record;
+
+   type O_If_Block is record
+      null;
+   end record;
+end Ortho_Debug;
diff --git a/src/ortho/debug/ortho_debug_front.ads b/src/ortho/debug/ortho_debug_front.ads
new file mode 100644
index 000000000..17e32c9ed
--- /dev/null
+++ b/src/ortho/debug/ortho_debug_front.ads
@@ -0,0 +1,20 @@
+--  Ortho debug interface with front-end.
+--  Copyright (C) 2005 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 Ortho_Front;
+package Ortho_Debug_Front renames Ortho_Front;
diff --git a/src/ortho/debug/ortho_ident.ads b/src/ortho/debug/ortho_ident.ads
new file mode 100644
index 000000000..46aa8854d
--- /dev/null
+++ b/src/ortho/debug/ortho_ident.ads
@@ -0,0 +1,20 @@
+--  Ortho debug back-end interface with identifiers package.
+--  Copyright (C) 2005 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 Ortho_Ident_Simple;
+package Ortho_Ident renames Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_ident_hash.adb b/src/ortho/debug/ortho_ident_hash.adb
new file mode 100644
index 000000000..60ab89586
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_hash.adb
@@ -0,0 +1,72 @@
+--  Ortho debug hashed identifiers implementation.
+--  Copyright (C) 2005 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.
+
+package body Ortho_Ident_Hash is
+   type O_Ident_Array is array (Hash_Type range <>) of O_Ident;
+   Hash_Max : constant Hash_Type := 511;
+   Symtable : O_Ident_Array (0 .. Hash_Max - 1) := (others => null);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Hash : Hash_Type;
+      Ent : Hash_Type;
+      Res : O_Ident;
+   begin
+      --  1.  Compute Hash.
+      Hash := 0;
+      for I in Str'Range loop
+         Hash := Hash * 31 + Character'Pos (Str (I));
+      end loop;
+
+      --  2.  Search.
+      Ent := Hash mod Hash_Max;
+      Res := Symtable (Ent);
+      while Res /= null loop
+         if Res.Hash = Hash and then Res.Ident.all = Str then
+            return Res;
+         end if;
+         Res := Res.Next;
+      end loop;
+
+      --  Not found: add.
+      Res := new Ident_Type'(Hash => Hash,
+                             Ident => new String'(Str),
+                             Next => Symtable (Ent));
+      Symtable (Ent) := Res;
+      return Res;
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String is
+   begin
+      if Id = null then
+         return "?ANON?";
+      else
+         return Id.Ident.all;
+      end if;
+   end Get_String;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = null;
+   end Is_Nul;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Id.Ident.all = Str;
+   end Is_Equal;
+end Ortho_Ident_Hash;
diff --git a/src/ortho/debug/ortho_ident_hash.ads b/src/ortho/debug/ortho_ident_hash.ads
new file mode 100644
index 000000000..a6e4a56cc
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_hash.ads
@@ -0,0 +1,46 @@
+--  Ortho debug hashed identifiers implementation.
+--  Copyright (C) 2005 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.
+
+package Ortho_Ident_Hash is
+   type O_Ident is private;
+   O_Ident_Nul : constant O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames "=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+private
+   type Hash_Type is mod 2**32;
+
+   type String_Acc is access constant String;
+
+   --  Symbol table.
+   type Ident_Type;
+   type O_Ident is access Ident_Type;
+   type Ident_type is record
+      --  The hash for the symbol.
+      Hash : Hash_Type;
+      --  Identification of the symbol.
+      Ident : String_Acc;
+      --  Next symbol with the same collision.
+      Next : O_Ident;
+   end record;
+
+   O_Ident_Nul : constant O_Ident := null;
+end Ortho_Ident_Hash;
diff --git a/src/ortho/debug/ortho_ident_simple.adb b/src/ortho/debug/ortho_ident_simple.adb
new file mode 100644
index 000000000..83b9756f8
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_simple.adb
@@ -0,0 +1,44 @@
+--  Ortho debug identifiers simple implementation.
+--  Copyright (C) 2005 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.
+
+package body Ortho_Ident_Simple is
+   function Get_Identifier (Str : String) return O_Ident
+   is
+   begin
+      return new String'(Str);
+   end Get_Identifier;
+
+   function Get_String (Id : O_Ident) return String is
+   begin
+      if Id = null then
+         return "?ANON?";
+      else
+         return Id.all;
+      end if;
+   end Get_String;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = null;
+   end Is_Nul;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Id.all = Str;
+   end Is_Equal;
+end Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_ident_simple.ads b/src/ortho/debug/ortho_ident_simple.ads
new file mode 100644
index 000000000..f94fe1938
--- /dev/null
+++ b/src/ortho/debug/ortho_ident_simple.ads
@@ -0,0 +1,31 @@
+--  Ortho debug identifiers simple implementation.
+--  Copyright (C) 2005 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.
+
+package Ortho_Ident_Simple is
+   type O_Ident is private;
+   O_Ident_Nul : constant O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames "=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+private
+   type O_Ident is access String;
+   O_Ident_Nul : constant O_Ident := null;
+end Ortho_Ident_Simple;
diff --git a/src/ortho/debug/ortho_nodes.ads b/src/ortho/debug/ortho_nodes.ads
new file mode 100644
index 000000000..8ade66722
--- /dev/null
+++ b/src/ortho/debug/ortho_nodes.ads
@@ -0,0 +1,21 @@
+--  Ortho debug back-end interface with front-end.
+--  Copyright (C) 2005 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 Ortho_Debug;
+
+package Ortho_Nodes renames Ortho_Debug;
diff --git a/src/ortho/gcc/Makefile b/src/ortho/gcc/Makefile
new file mode 100644
index 000000000..5aafb31c7
--- /dev/null
+++ b/src/ortho/gcc/Makefile
@@ -0,0 +1,86 @@
+ortho_srcdir=..
+orthobe_srcdir=$(ortho_srcdir)/gcc
+agcc_objdir=.
+agcc_srcdir=$(ortho_srcdir)/gcc
+SED=sed
+BE=gcc
+GNATMAKE=gnatmake
+CC=gcc
+CXX=g++
+COMPILER=$(CXX)
+LINKER=$(CXX)
+
+# Modify AGCC_GCCSRC_DIR and AGCC_GCCOBJ_DIR for your environment
+AGCC_GCCSRC_DIR:=$(HOME)/Projects/gcc4.9.2/source/gcc-4.9.2/
+AGCC_GCCOBJ_DIR:=$(HOME)/Projects/gcc4.9.2/build/
+
+# Supplied by main GCC Makefile, copied here for compatibility with same
+GMPLIBS = -L$(AGCC_GCCOBJ_DIR)./gmp/.libs -L$(AGCC_GCCOBJ_DIR)./mpfr/.libs \
+  -L$(AGCC_GCCOBJ_DIR)./mpc/src/.libs -lmpc -lmpfr -lgmp
+GMPINC = -I$(AGCC_GCCOBJ_DIR)./gmp -I$(AGCC_GCCSRC_DIR)/gmp \
+  -I$(AGCC_GCCOBJ_DIR)./mpfr -I$(AGCC_GCCSRC_DIR)/mpfr \
+  -I$(AGCC_GCCSRC_DIR)/mpc/src
+
+HOST_LIBS =
+ZLIB=-lz
+
+# Override variables in Makefile.conf for your environment
+-include $(orthobe_srcdir)/Makefile.conf
+
+all: $(ortho_exec)
+
+ORTHO_BASENAME=ortho_gcc
+include $(ortho_srcdir)/Makefile.inc
+
+AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \
+ -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \
+ -I$(AGCC_GCCSRC_DIR)/libcpp/include $(GMPINC)
+AGCC_CFLAGS=-g -Wall -DIN_GCC $(AGCC_INC_FLAGS)
+
+ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
+ $(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
+ $(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
+	$(COMPILER) -c -o $@ $< $(AGCC_CFLAGS) $(INCLUDES)
+
+AGCC_LOCAL_OBJS=ortho-lang.o
+
+AGCC_DEPS := $(AGCC_LOCAL_OBJS)
+AGCC_OBJS := $(AGCC_LOCAL_OBJS) \
+	$(AGCC_GCCOBJ_DIR)gcc/attribs.o \
+	$(AGCC_GCCOBJ_DIR)libcpp/libcpp.a \
+	$(AGCC_GCCOBJ_DIR)libiberty/libiberty.a
+
+LIBBACKTRACE = $(AGCC_GCCOBJ_DIR)/libbacktrace/.libs/libbacktrace.a
+LIBDECNUMBER = $(AGCC_GCCOBJ_DIR)/libdecnumber/libdecnumber.a
+LIBIBERTY = $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a
+CPPLIB= # Not needed for GHDL
+
+BACKEND = $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \
+         $(AGCC_GCCOBJ_DIR)/gcc/libcommon-target.a
+
+BACKENDLIBS = $(CLOOGLIBS) $(GMPLIBS) $(PLUGINLIBS) $(HOST_LIBS) \
+	$(ZLIB)
+LIBS =  $(AGCC_GCCOBJ_DIR)/gcc/libcommon.a \
+        $(CPPLIB) $(LIBINTL) $(LIBICONV) $(LIBBACKTRACE) \
+	$(LIBIBERTY) $(LIBDECNUMBER) $(HOST_LIBS)
+
+$(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force
+	$(GNATMAKE) -m -o $@ -g -aI$(ortho_srcdir) \
+	 -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \
+	 -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \
+        $(BACKEND) $(LIBS) $(BACKENDLIBS)
+
+agcc-clean: force
+	$(RM) -f $(agcc_objdir)/*.o
+	$(RM) -f $(agcc_srcdir)/*~
+
+clean: agcc-clean
+	$(RM) -f *.o *.ali ortho_nodes-main
+	$(RM) b~*.ad? *~
+
+distclean: clean agcc-clean
+
+
+force:
+
+.PHONY: force all clean agcc-clean
diff --git a/src/ortho/gcc/Makefile.conf.linux b/src/ortho/gcc/Makefile.conf.linux
new file mode 100644
index 000000000..00ea91728
--- /dev/null
+++ b/src/ortho/gcc/Makefile.conf.linux
@@ -0,0 +1,4 @@
+# Example Makefile.conf
+# Copy this file to Makefile.conf and edit as necessary for your platform
+
+HOST_LIBS = -ldl -lstdc++
diff --git a/src/ortho/gcc/lang.opt b/src/ortho/gcc/lang.opt
new file mode 100644
index 000000000..562fbe08d
--- /dev/null
+++ b/src/ortho/gcc/lang.opt
@@ -0,0 +1,96 @@
+Language
+vhdl
+
+-std=
+vhdl Joined
+Select the vhdl standard
+
+-compile-standard
+vhdl
+Used during compiler build to compile the std.standard package
+
+-bootstrap
+vhdl
+Used during compiler build to compile std packages
+
+-work=
+vhdl Joined
+Set the name of the work library
+
+-workdir=
+vhdl Joined
+Set the directory of the work library
+
+P
+vhdl JoinedOrMissing
+;-P<dir>	Add <dir> to the end of the vhdl library path
+
+-elab
+vhdl Separate
+--elab <name>	Used internally during elaboration of <name>
+
+-anaelab
+vhdl Separate
+--anaelab <name>	Used internally during elaboration of <name>
+
+; -c is a driver option for gcc.  --ghdl-source is used instead.
+;c
+;vhdl Separate
+;-c <filename>	Analyze <filename> for --anaelab
+
+;v
+;vhdl
+;Verbose
+
+-warn-
+vhdl Joined
+--warn-<name>	Warn about <name>
+
+-ghdl
+vhdl Joined
+--ghdl-<option>	Pass <option> to vhdl front-end
+
+-expect-failure
+vhdl
+Expect a compiler error (used for testsuite)
+
+-no-vital-checks
+vhdl
+Disable VITAL checks
+
+-vital-checks
+vhdl
+Enable VITAL checks
+
+fexplicit
+vhdl
+Explicit function declarations override implicit one in use
+
+frelaxed-rules
+vhdl
+Relax some LRM rules to compile vendor libraries
+
+fpsl
+vhdl
+Allow PSL asserts in comments
+
+-no-direct-drivers
+vhdl
+Disable direct drivers optimization
+
+-syn-binding
+vhdl
+Use synthetizer rules for default bindings
+
+l
+vhdl Joined Separate
+-l<filename>	Put list of files for link in <filename>
+
+; -C was commented out, as it is already defined for C/C++.
+;C
+;vhdl
+;Allow any character in comments
+
+-mb-comments
+vhdl
+Allow any character in comments
diff --git a/src/ortho/gcc/ortho-lang.c b/src/ortho/gcc/ortho-lang.c
new file mode 100644
index 000000000..c19012e6e
--- /dev/null
+++ b/src/ortho/gcc/ortho-lang.c
@@ -0,0 +1,2191 @@
+/* GCC back-end for ortho
+  Copyright (C) 2002-1014 Tristan Gingold and al.
+
+  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.  */
+
+#include <stddef.h>
+#include <math.h>
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "tm_p.h"
+#include "defaults.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "toplev.h"
+#include "opts.h"
+#include "options.h"
+#include "real.h"
+#include "tree-iterator.h"
+#include "function.h"
+#include "cgraph.h"
+#include "target.h"
+#include "convert.h"
+#include "tree-pass.h"
+#include "tree-dump.h"
+
+/* Undefine for gcc-4.8  */
+#define GCC49
+
+#ifdef GCC49
+
+#include "print-tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
+#include "varasm.h"
+
+/* Returns the number of FIELD_DECLs in TYPE.
+   Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h.  */
+
+static int
+fields_length (const_tree type)
+{
+  tree t = TYPE_FIELDS (type);
+  int count = 0;
+
+  for (; t; t = DECL_CHAIN (t))
+    if (TREE_CODE (t) == FIELD_DECL)
+      ++count;
+
+  return count;
+}
+
+#else
+
+// adapt gcc4.9 practice to gcc4.8 functions
+bool
+tree_fits_uhwi_p (const_tree t)
+{
+  return host_integerp (t, 1);
+}
+
+unsigned HOST_WIDE_INT
+tree_to_uhwi (const_tree t)
+{
+  return tree_low_cst (t, 1);
+}
+
+#endif
+
+/* TODO:
+ * remove stmt_list_stack, save in if/case/loop block
+ * Re-add -v (if necessary)
+ */
+
+static tree type_for_size (unsigned int precision, int unsignedp);
+
+const int tree_identifier_size = sizeof (struct tree_identifier);
+
+struct GTY(()) binding_level
+{
+  /*  The BIND_EXPR node for this binding.  */
+  tree bind;
+
+  /*  The BLOCK node for this binding.  */
+  tree block;
+
+  /*  If true, stack must be saved (alloca is used).  */
+  int save_stack;
+
+  /*  Parent binding level.  */
+  struct binding_level *prev;
+
+  /*  Decls in this binding.  */
+  tree first_decl;
+  tree last_decl;
+
+  /*  Blocks in this binding.  */
+  tree first_block;
+  tree last_block;
+};
+
+/*  The current binding level.  */
+static GTY(()) struct binding_level *cur_binding_level = NULL;
+
+/*  Chain of unused binding levels.  */
+static GTY(()) struct binding_level *old_binding_levels = NULL;
+
+/*  Chain of statements currently generated.  */
+static GTY(()) tree cur_stmts = NULL_TREE;
+
+static void
+push_binding (void)
+{
+  struct binding_level *res;
+
+  if (old_binding_levels == NULL)
+    res = ggc_alloc_binding_level ();
+  else
+    {
+      res = old_binding_levels;
+      old_binding_levels = res->prev;
+    }
+
+  /* Init.  */
+  res->first_decl = NULL_TREE;
+  res->last_decl = NULL_TREE;
+
+  res->first_block = NULL_TREE;
+  res->last_block = NULL_TREE;
+
+  res->save_stack = 0;
+
+  res->bind = make_node (BIND_EXPR);
+  res->block = make_node (BLOCK);
+  BIND_EXPR_BLOCK (res->bind) = res->block;
+  TREE_SIDE_EFFECTS (res->bind) = true;
+  TREE_TYPE (res->bind) = void_type_node;
+  TREE_USED (res->block) = true;
+
+  if (cur_binding_level != NULL)
+    {
+      /* Append the block created.  */
+      if (cur_binding_level->first_block == NULL)
+	cur_binding_level->first_block = res->block;
+      else
+	BLOCK_CHAIN (cur_binding_level->last_block) = res->block;
+      cur_binding_level->last_block = res->block;
+
+      BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
+    }
+
+  res->prev = cur_binding_level;
+  cur_binding_level = res;
+}
+
+static void
+push_decl (tree decl)
+{
+  DECL_CONTEXT (decl) = current_function_decl;
+
+  if (cur_binding_level->first_decl == NULL)
+    cur_binding_level->first_decl = decl;
+  else
+    TREE_CHAIN (cur_binding_level->last_decl) = decl;
+  cur_binding_level->last_decl = decl;
+}
+
+static tree
+pop_binding (void)
+{
+  tree res;
+  struct binding_level *cur;
+
+  cur = cur_binding_level;
+  res = cur->bind;
+
+  if (cur->save_stack)
+    {
+      tree tmp_var;
+      tree save;
+      tree save_call;
+      tree restore;
+      tree t;
+
+      /* Create an artificial var to save the stack pointer.  */
+      tmp_var = build_decl (input_location, VAR_DECL, NULL, ptr_type_node);
+      DECL_ARTIFICIAL (tmp_var) = true;
+      DECL_IGNORED_P (tmp_var) = true;
+      TREE_USED (tmp_var) = true;
+      push_decl (tmp_var);
+
+      /* Create the save stmt.  */
+      save_call = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_SAVE), 0);
+      save = build2 (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
+      TREE_SIDE_EFFECTS (save) = true;
+
+      /* Create the restore stmt.  */
+      restore = build_call_expr
+	(builtin_decl_implicit (BUILT_IN_STACK_RESTORE), 1, tmp_var);
+
+      /* Build a try-finally block.
+	 The statement list is the block of current statements.  */
+      t = build2 (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
+      TREE_SIDE_EFFECTS (t) = true;
+
+      /* The finally block is the restore stmt.  */
+      append_to_statement_list (restore, &TREE_OPERAND (t, 1));
+
+      /* The body of the BIND_BLOCK is the save stmt, followed by the
+	 try block.  */
+      BIND_EXPR_BODY (res) = NULL_TREE;
+      append_to_statement_list (save, &BIND_EXPR_BODY (res));
+      append_to_statement_list (t, &BIND_EXPR_BODY (res));
+    }
+  else
+    {
+      /* The body of the BIND_BLOCK is the statement block.  */
+      BIND_EXPR_BODY (res) = cur_stmts;
+    }
+  BIND_EXPR_VARS (res) = cur->first_decl;
+
+  BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
+  BLOCK_VARS (cur->block) = cur->first_decl;
+
+  cur_binding_level = cur->prev;
+  cur->prev = old_binding_levels;
+  old_binding_levels = cur;
+
+  return res;
+}
+
+// naive conversion to new vec API following the wiki at
+// http://gcc.gnu.org/wiki/cxx-conversion/cxx-vec
+// see also push_stmts, pop_stmts
+static vec <tree> stmt_list_stack = vec<tree>();
+
+static void
+push_stmts (tree stmts)
+{
+  stmt_list_stack.safe_push(cur_stmts);
+  cur_stmts = stmts;
+}
+
+static void
+pop_stmts (void)
+{
+  cur_stmts = stmt_list_stack.pop();
+}
+
+static void
+append_stmt (tree stmt)
+{
+  if (!EXPR_HAS_LOCATION (stmt))
+    SET_EXPR_LOCATION (stmt, input_location);
+  TREE_SIDE_EFFECTS (stmt) = true;
+  append_to_statement_list (stmt, &cur_stmts);
+}
+
+static GTY(()) tree top;
+
+static GTY(()) tree stack_alloc_function_ptr;
+
+static bool
+global_bindings_p (void)
+{
+  return cur_binding_level->prev == NULL;
+}
+
+static tree
+pushdecl (tree t)
+{
+  //gcc_unreachable ();
+  // gcc4.8.2 we get here from build_common_builtin_nodes () call in ortho_init
+  return t;
+}
+
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class decl_class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED);
+
+REAL_VALUE_TYPE fp_const_p5; /* 0.5 */
+REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
+REAL_VALUE_TYPE fp_const_zero; /* 0.0 */
+
+static bool
+ortho_init (void)
+{
+  tree n;
+
+  input_location = BUILTINS_LOCATION;
+
+  /* Create a global binding.  */
+  push_binding ();
+
+  build_common_tree_nodes (0, 0);
+
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("int"), integer_type_node);
+  push_decl (n);
+  n = build_decl (input_location,
+                  TYPE_DECL, get_identifier ("char"), char_type_node);
+  push_decl (n);
+
+  /* Create alloca builtin.  */
+  {
+    tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
+    tree func_type = build_function_type (ptr_type_node, args_type);
+
+    set_builtin_decl
+      (BUILT_IN_ALLOCA,
+       builtin_function
+       ("__builtin_alloca", func_type,
+	BUILT_IN_ALLOCA, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+
+    stack_alloc_function_ptr = build1
+      (ADDR_EXPR,
+       build_pointer_type (func_type),
+       builtin_decl_implicit (BUILT_IN_ALLOCA));
+  }
+
+  {
+    tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
+
+    set_builtin_decl
+      (BUILT_IN_STACK_SAVE,
+       builtin_function
+       ("__builtin_stack_save", ptr_ftype,
+	BUILT_IN_STACK_SAVE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+  }
+
+  {
+    tree ftype_ptr;
+
+    ftype_ptr = build_function_type
+      (void_type_node,
+       tree_cons (NULL_TREE, ptr_type_node, NULL_TREE));
+
+    set_builtin_decl
+      (BUILT_IN_STACK_RESTORE,
+       builtin_function
+       ("__builtin_stack_restore", ftype_ptr,
+	BUILT_IN_STACK_RESTORE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
+  }
+  {
+    REAL_VALUE_TYPE v;
+
+    REAL_VALUE_FROM_INT (v, 1, 0, DFmode);
+    real_ldexp (&fp_const_p5, &v, -1);
+
+    REAL_VALUE_FROM_INT (v, -1, -1, DFmode);
+    real_ldexp (&fp_const_m_p5, &v, -1);
+
+    REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
+  }
+
+  build_common_builtin_nodes ();
+  // FIXME: this MAY remove the need for creating the builtins above...
+  // Evaluate tree.c / build_common_builtin_nodes (); for each in turn.
+
+  return true;
+}
+
+static void
+ortho_finish (void)
+{
+}
+
+static unsigned int
+ortho_option_lang_mask (void)
+{
+  return CL_vhdl;
+}
+
+static bool
+ortho_post_options (const char **pfilename)
+{
+  if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
+    *pfilename = "*stdin*";
+
+  /* Default hook.  */
+  lhd_post_options (pfilename);
+
+  // This stops compile failures writing debug information when both -g and -O2
+  // (or -O1, -O3 or -Os) options are present.
+  // Should really make it conditional on specific options
+  // FIXME : re-evaluate if this is still necessary with newer gccrevisions
+  dwarf_strict = 1;
+
+  /* Run the back-end.  */
+  return false;
+}
+
+extern "C" int lang_handle_option (const char *opt, const char *arg);
+
+static bool
+ortho_handle_option (size_t code, const char *arg,
+		     int value ATTRIBUTE_UNUSED,
+		     int kind ATTRIBUTE_UNUSED,
+                     location_t loc ATTRIBUTE_UNUSED,
+                     const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  const char *opt;
+
+  opt = cl_options[code].opt_text;
+
+  switch (code)
+    {
+    case OPT__elab:
+    case OPT_l:
+    case OPT_c:
+    case OPT__anaelab:
+      /* Only a few options have a real arguments.  */
+      return lang_handle_option (opt, arg) != 0;
+    default:
+      /* The other options must have a joint argument.  */
+      if (arg != NULL)
+	{
+	  size_t len1;
+	  size_t len2;
+	  char *nopt;
+
+	  len1 = strlen (opt);
+	  len2 = strlen (arg);
+	  nopt = (char *) alloca (len1 + len2 + 1);
+	  memcpy (nopt, opt, len1);
+	  memcpy (nopt + len1, arg, len2);
+	  nopt[len1 + len2] = 0;
+	  opt = nopt;
+	}
+      return lang_handle_option (opt, NULL) != 0;
+    }
+}
+
+extern "C" int lang_parse_file (const char *filename);
+
+static void
+ortho_parse_file (void)
+{
+  const char *filename;
+
+  if (num_in_fnames == 0)
+    filename = NULL;
+  else
+    filename = in_fnames[0];
+
+  linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
+  input_location = linemap_line_start (line_table, 1, 252);
+
+  if (!lang_parse_file (filename))
+    errorcount++;
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
+}
+
+/*  Called by the back-end or by the front-end when the address of EXP
+    must be taken.
+    This function should found the base object (if any), and mark it as
+    addressable (via TREE_ADDRESSABLE).  It may emit a warning if this
+    object cannot be addressable (front-end restriction).
+    Returns TRUE in case of success, FALSE in case of failure.
+    Note that the status is never checked by the back-end.  */
+static bool
+ortho_mark_addressable (tree exp)
+{
+  tree n;
+
+  n = exp;
+
+  while (1)
+    switch (TREE_CODE (n))
+      {
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case COMPONENT_REF:
+      case ARRAY_REF:
+      case ARRAY_RANGE_REF:
+	n = TREE_OPERAND (n, 0);
+	break;
+
+      case FUNCTION_DECL:
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (n) = true;
+	return true;
+
+      case INDIRECT_REF:
+	return true;
+
+      default:
+	gcc_unreachable ();
+      }
+}
+
+static tree
+ortho_truthvalue_conversion (tree expr)
+{
+  tree expr_type;
+  tree t;
+  tree f;
+
+  expr_type = TREE_TYPE (expr);
+  if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
+    {
+      t = integer_one_node;
+      f = integer_zero_node;
+    }
+  else
+    {
+      f = TYPE_MIN_VALUE (expr_type);
+      t = TYPE_MAX_VALUE (expr_type);
+    }
+
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      /* Not 0 is true.  */
+      return integer_zerop (expr) ? f : t;
+
+    case REAL_CST:
+      return real_zerop (expr) ? f : t;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+/* The following function has been copied and modified from c-convert.c.  */
+
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+  const char *invalid_conv_diag;
+
+  if (type == error_mark_node
+      || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if ((invalid_conv_diag
+       = targetm.invalid_conversion (TREE_TYPE (expr), type)))
+    {
+      error (invalid_conv_diag);
+      return error_mark_node;
+    }
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1 (NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
+    {
+      gcc_unreachable ();
+    }
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      tree t = ortho_truthvalue_conversion (expr);
+      if (TREE_CODE (t) == ERROR_MARK)
+	return t;
+
+      /* If it returns a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (t) == NOP_EXPR)
+	return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
+      else
+	return fold_build1 (NOP_EXPR, type, t);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+
+  gcc_unreachable ();
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  If
+   ATTRS is nonzero, use that for the function's attribute list.  */
+static tree
+builtin_function (const char *name,
+		  tree type,
+		  int function_code,
+		  enum built_in_class decl_class,
+		  const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED)
+{
+  tree decl = build_decl (input_location,
+                          FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+  make_decl_rtl (decl);
+  DECL_BUILT_IN_CLASS (decl) = decl_class;
+  DECL_FUNCTION_CODE (decl) = (built_in_function) function_code;
+  DECL_SOURCE_LOCATION (decl) = input_location;
+  return decl;
+}
+
+#ifndef MAX_BITS_PER_WORD
+#define MAX_BITS_PER_WORD BITS_PER_WORD
+#endif
+
+/*  This variable keeps a table for types for each precision so that we only
+    allocate each of them once. Signed and unsigned types are kept separate.
+ */
+static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
+
+/*  Return an integer type with the number of bits of precision given by
+    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
+    it is a signed type.  */
+static tree
+type_for_size (unsigned int precision, int unsignedp)
+{
+  tree t;
+
+  if (precision <= MAX_BITS_PER_WORD
+      && signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
+    return signed_and_unsigned_types[precision][unsignedp];
+
+  if (unsignedp)
+    t = make_unsigned_type (precision);
+  else
+    t = make_signed_type (precision);
+
+  if (precision <= MAX_BITS_PER_WORD)
+    signed_and_unsigned_types[precision][unsignedp] = t;
+
+  return t;
+}
+
+/*  Return a data type that has machine mode MODE.  UNSIGNEDP selects
+    an unsigned type; otherwise a signed type is returned.  */
+static tree
+type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  if (SCALAR_INT_MODE_P (mode))
+    return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
+
+  if (mode == TYPE_MODE (void_type_node))
+    return void_type_node;
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  return NULL_TREE;
+}
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "vhdl"
+#undef LANG_HOOKS_IDENTIFIER_SIZE
+#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT ortho_init
+#undef LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH ortho_finish
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK ortho_option_lang_mask
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS ortho_post_options
+#undef LANG_HOOKS_HONOR_READONLY
+#define LANG_HOOKS_HONOR_READONLY true
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
+#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
+#undef LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE signed_type
+#undef LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
+#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE ortho_parse_file
+
+#define pushlevel lhd_do_nothing_i
+#define poplevel lhd_do_nothing_iii_return_null_tree
+#define set_block lhd_do_nothing_t
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+union GTY((desc ("0"),
+	   chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
+  lang_tree_node
+{
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+};
+
+/* GHDL does not use the lang_decl and lang_type.
+
+   FIXME: the variable_size annotation here is needed because these types are
+   variable-sized in some other front-ends.  Due to gengtype deficiency, the
+   GTY options of such types have to agree across all front-ends.  */
+
+struct GTY((variable_size)) lang_type { char dummy; };
+struct GTY((variable_size)) lang_decl { char dummy; };
+
+struct GTY(()) language_function
+{
+  char dummy;
+};
+
+
+extern "C" {
+
+struct GTY(()) chain_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+chain_init (struct chain_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+chain_append (struct chain_constr_type *constr, tree el)
+{
+  if (constr->first == NULL_TREE)
+    {
+      gcc_assert (constr->last == NULL_TREE);
+      constr->first = el;
+    }
+  else
+    TREE_CHAIN (constr->last) = el;
+  constr->last = el;
+}
+
+struct GTY(()) list_constr_type
+{
+  tree first;
+  tree last;
+};
+
+static void
+list_init (struct list_constr_type *constr)
+{
+  constr->first = NULL_TREE;
+  constr->last = NULL_TREE;
+}
+
+static void
+ortho_list_append (struct list_constr_type *constr, tree el)
+{
+  tree res;
+
+  res = tree_cons (NULL_TREE, el, NULL_TREE);
+  if (constr->first == NULL_TREE)
+    constr->first = res;
+  else
+    TREE_CHAIN (constr->last) = res;
+  constr->last = res;
+}
+
+enum ON_op_kind {
+  /*  Not an operation; invalid.  */
+  ON_Nil,
+
+  /*  Dyadic operations.  */
+  ON_Add_Ov,
+  ON_Sub_Ov,
+  ON_Mul_Ov,
+  ON_Div_Ov,
+  ON_Rem_Ov,
+  ON_Mod_Ov,
+
+  /*  Binary operations.  */
+  ON_And,
+  ON_Or,
+  ON_Xor,
+
+  /*  Monadic operations.  */
+  ON_Not,
+  ON_Neg_Ov,
+  ON_Abs_Ov,
+
+  /*  Comparaisons  */
+  ON_Eq,
+  ON_Neq,
+  ON_Le,
+  ON_Lt,
+  ON_Ge,
+  ON_Gt,
+
+  ON_LAST
+};
+
+static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
+  ERROR_MARK,
+
+  PLUS_EXPR,
+  MINUS_EXPR,
+  MULT_EXPR,
+  ERROR_MARK,
+  TRUNC_MOD_EXPR,
+  FLOOR_MOD_EXPR,
+
+  BIT_AND_EXPR,
+  BIT_IOR_EXPR,
+  BIT_XOR_EXPR,
+
+  BIT_NOT_EXPR,
+  NEGATE_EXPR,
+  ABS_EXPR,
+
+  EQ_EXPR,
+  NE_EXPR,
+  LE_EXPR,
+  LT_EXPR,
+  GE_EXPR,
+  GT_EXPR,
+};
+
+tree
+new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
+{
+  tree left_type;
+  enum tree_code code;
+
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  left_type = TREE_TYPE (left);
+  gcc_assert (left_type == TREE_TYPE (right));
+
+  switch (kind)
+    {
+    case ON_Div_Ov:
+      if (TREE_CODE (left_type) == REAL_TYPE)
+	code = RDIV_EXPR;
+      else
+	code = TRUNC_DIV_EXPR;
+      break;
+    default:
+      code = ON_op_to_TREE_CODE[kind];
+      break;
+    }
+  return build2 (code, left_type, left, right);
+}
+
+tree
+new_monadic_op (enum ON_op_kind kind, tree operand)
+{
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand);
+}
+
+tree
+new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype)
+{
+  gcc_assert (TREE_CODE (ntype) == BOOLEAN_TYPE);
+  gcc_assert (TREE_TYPE (left) == TREE_TYPE (right));
+
+  /* Truncate to avoid representations issue.  */
+  kind = (enum ON_op_kind)((unsigned)kind & 0xff);
+
+  return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right);
+}
+
+tree
+new_convert_ov (tree val, tree rtype)
+{
+  tree val_type;
+  enum tree_code val_code;
+  enum tree_code rtype_code;
+  enum tree_code code;
+
+  val_type = TREE_TYPE (val);
+  if (val_type == rtype)
+    return val;
+
+  /*  FIXME: check conversions.  */
+  val_code = TREE_CODE (val_type);
+  rtype_code = TREE_CODE (rtype);
+  if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
+    {
+      /*  REAL to INTEGER
+          Gcc only handles FIX_TRUNC_EXPR, but we need rounding.  */
+      tree m_p5;
+      tree p5;
+      tree zero;
+      tree saved;
+      tree comp;
+      tree adj;
+      tree res;
+
+      m_p5 = build_real (val_type, fp_const_m_p5);
+      p5 = build_real (val_type, fp_const_p5);
+      zero = build_real (val_type, fp_const_zero);
+      saved = save_expr (val);
+      comp = build2 (GE_EXPR, integer_type_node, saved, zero);
+      /*  FIXME: instead of res = res + (comp ? .5 : -.5)
+	  do: res = res (comp ? + : -) .5  */
+      adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
+      res = build2 (PLUS_EXPR, val_type, saved, adj);
+      res = build1 (FIX_TRUNC_EXPR, rtype, res);
+      return res;
+    }
+  else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
+    code = FLOAT_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
+    code = CONVERT_EXPR;
+  else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
+    code = NOP_EXPR;
+  else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
+    code = NOP_EXPR;
+  else
+    gcc_unreachable ();
+
+  return build1 (code, rtype, val);
+}
+
+tree
+new_alloca (tree rtype, tree size)
+{
+  tree res;
+
+  /* Must save stack except when at function level.  */
+  if (cur_binding_level->prev != NULL
+      && cur_binding_level->prev->prev != NULL)
+    cur_binding_level->save_stack = 1;
+
+  res = build_call_nary (ptr_type_node, stack_alloc_function_ptr,
+                         1, fold_convert (size_type_node, size));
+  return fold_convert (rtype, res);
+}
+
+tree
+new_signed_literal (tree ltype, long long value)
+{
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (ltype, lo, hi);
+  return res;
+}
+
+tree
+new_unsigned_literal (tree ltype, unsigned long long value)
+{
+  tree res;
+  unsigned HOST_WIDE_INT lo;
+  unsigned HOST_WIDE_INT hi;
+
+  lo = value;
+  hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (ltype, lo, hi);
+  return res;
+}
+
+tree
+new_null_access (tree ltype)
+{
+  tree res;
+
+  res = build_int_cst_wide (ltype, 0, 0);
+  return res;
+}
+
+tree
+new_float_literal (tree ltype, double value)
+{
+  signed long long s;
+  double frac;
+  int ex;
+  REAL_VALUE_TYPE r_sign;
+  REAL_VALUE_TYPE r_exp;
+  REAL_VALUE_TYPE r;
+  tree res;
+  HOST_WIDE_INT lo;
+  HOST_WIDE_INT hi;
+
+  frac = frexp (value, &ex);
+
+  s = ldexp (frac, 60);
+  lo = s;
+  hi = (s >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
+  res = build_int_cst_wide (long_integer_type_node, lo, hi);
+  REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
+  real_2expN (&r_exp, ex - 60, DFmode);
+  real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
+  res = build_real (ltype, r);
+  return res;
+}
+
+struct GTY(()) o_element_list
+{
+  tree res;
+  struct chain_constr_type chain;
+};
+
+void
+new_uncomplete_record_type (tree *res)
+{
+  *res = make_node (RECORD_TYPE);
+}
+
+void
+start_record_type (struct o_element_list *elements)
+{
+  elements->res = make_node (RECORD_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+start_uncomplete_record_type (tree res, struct o_element_list *elements)
+{
+  elements->res = res;
+  chain_init (&elements->chain);
+}
+
+static void
+new_record_union_field (struct o_element_list *list,
+			tree *el,
+			tree ident,
+			tree etype)
+{
+  tree res;
+
+  res = build_decl (input_location,
+                    FIELD_DECL, ident, etype);
+  DECL_CONTEXT (res) = list->res;
+  chain_append (&list->chain, res);
+  *el = res;
+}
+
+void
+new_record_field (struct o_element_list *list,
+		  tree *el,
+		  tree ident,
+		  tree etype)
+{
+  return new_record_union_field (list, el, ident, etype);
+}
+
+void
+finish_record_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+
+  if (TYPE_NAME (elements->res) != NULL_TREE)
+    {
+      /*  The type was completed.  */
+      rest_of_type_compilation (elements->res, 1);
+    }
+}
+
+void
+start_union_type (struct o_element_list *elements)
+{
+  elements->res =  make_node (UNION_TYPE);
+  chain_init (&elements->chain);
+}
+
+void
+new_union_field (struct o_element_list *elements,
+		 tree *el,
+		 tree ident,
+		 tree etype)
+{
+  return new_record_union_field (elements, el, ident, etype);
+}
+
+void
+finish_union_type (struct o_element_list *elements, tree *res)
+{
+  TYPE_FIELDS (elements->res) = elements->chain.first;
+  layout_type (elements->res);
+  *res = elements->res;
+}
+
+tree
+new_unsigned_type (int size)
+{
+  return make_unsigned_type (size);
+}
+
+tree
+new_signed_type (int size)
+{
+  return make_signed_type (size);
+}
+
+tree
+new_float_type (void)
+{
+  tree res;
+
+  res = make_node (REAL_TYPE);
+  TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
+  layout_type (res);
+  return res;
+}
+
+tree
+new_access_type (tree dtype)
+{
+  tree res;
+
+  if (dtype == NULL_TREE)
+    {
+      res = make_node (POINTER_TYPE);
+      TREE_TYPE (res) = NULL_TREE;
+      /* Seems necessary.  */
+      SET_TYPE_MODE (res, Pmode);
+      layout_type (res);
+      return res;
+    }
+  else
+    return build_pointer_type (dtype);
+}
+
+void
+finish_access_type (tree atype, tree dtype)
+{
+  gcc_assert (TREE_CODE (atype) == POINTER_TYPE
+	      && TREE_TYPE (atype) == NULL_TREE);
+
+  TREE_TYPE (atype) = dtype;
+}
+
+tree
+new_array_type (tree el_type, tree index_type)
+{
+  return build_array_type (el_type, index_type);
+}
+
+
+tree
+new_constrained_array_type (tree atype, tree length)
+{
+  tree range_type;
+  tree index_type;
+  tree len;
+  tree one;
+  tree res;
+
+  index_type = TYPE_DOMAIN (atype);
+  if (integer_zerop (length))
+    {
+      /*  Handle null array, by creating a one-length array...  */
+      len = size_zero_node;
+    }
+  else
+    {
+      one = build_int_cstu (index_type, 1);
+      len = build2 (MINUS_EXPR, index_type, length, one);
+      len = fold (len);
+    }
+
+  range_type = build_range_type (index_type, size_zero_node, len);
+  res = build_array_type (TREE_TYPE (atype), range_type);
+
+  /* Constrained arrays are *always* a subtype of its array type.
+     Just copy alias set.  */
+  TYPE_ALIAS_SET (res) = get_alias_set (atype);
+  return res;
+}
+
+void
+new_boolean_type (tree *res,
+		  tree false_id ATTRIBUTE_UNUSED, tree *false_e,
+		  tree true_id ATTRIBUTE_UNUSED, tree *true_e)
+{
+  *res = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (*res) = 1;
+  fixup_unsigned_type (*res);
+  *false_e = TYPE_MIN_VALUE (*res);
+  *true_e = TYPE_MAX_VALUE (*res);
+}
+
+struct o_enum_list
+{
+  tree res;
+  struct chain_constr_type chain;
+  int num;
+  int size;
+};
+
+void
+start_enum_type (struct o_enum_list *list, int size)
+{
+  list->res = make_node (ENUMERAL_TYPE);
+  // as of gcc4.8, TYPE_PRECISION of 0 is rigorously enforced!
+  TYPE_PRECISION(list->res) = size;
+  chain_init (&list->chain);
+  list->num = 0;
+  list->size = size;
+}
+
+void
+new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
+{
+  *res = build_int_cstu (list->res, (HOST_WIDE_INT)(list->num));
+  chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
+  list->num++;
+}
+
+void
+finish_enum_type (struct o_enum_list *list, tree *res)
+{
+  *res = list->res;
+  TYPE_VALUES (*res) = list->chain.first;
+  TYPE_UNSIGNED (*res) = 1;
+  TYPE_PRECISION (*res) = list->size;
+  set_min_and_max_values_for_integral_type (*res, list->size, 1);
+  layout_type (*res);
+}
+
+struct GTY(()) o_record_aggr_list
+{
+  /* Type of the record.  */
+  tree atype;
+  /* Type of the next field to be added.  */
+  tree field;
+  /* Vector of elements.  */
+  // VEC(constructor_elt,gc) *elts;
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_record_aggr (struct o_record_aggr_list *list, tree atype)
+{
+  list->atype = atype;
+  list->field = TYPE_FIELDS (atype);
+  //list->elts = VEC_alloc (constructor_elt, gc, fields_length (atype));
+  vec_alloc(list->elts, fields_length (atype));
+}
+
+void
+new_record_aggr_el (struct o_record_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, list->field, value);
+  list->field = TREE_CHAIN (list->field);
+}
+
+void
+finish_record_aggr (struct o_record_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+struct GTY(()) o_array_aggr_list
+{
+  tree atype;
+  /* Vector of elements.  */
+  vec<constructor_elt,va_gc> *elts;
+};
+
+void
+start_array_aggr (struct o_array_aggr_list *list, tree atype)
+{
+  tree nelts;
+  unsigned HOST_WIDE_INT n;
+
+  list->atype = atype;
+  list->elts = NULL;
+
+  nelts = array_type_nelts (atype);
+  gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts));
+
+  n = tree_to_uhwi (nelts) + 1;
+  vec_alloc(list->elts, n);
+}
+
+void
+new_array_aggr_el (struct o_array_aggr_list *list, tree value)
+{
+  CONSTRUCTOR_APPEND_ELT (list->elts, NULL_TREE, value);
+}
+
+void
+finish_array_aggr (struct o_array_aggr_list *list, tree *res)
+{
+  *res = build_constructor (list->atype, list->elts);
+}
+
+
+tree
+new_union_aggr (tree atype, tree field, tree value)
+{
+  tree res;
+
+  res = build_constructor_single (atype, field, value);
+  TREE_CONSTANT (res) = 1;
+  return res;
+}
+
+tree
+new_indexed_element (tree arr, tree index)
+{
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
+		 arr, index, NULL_TREE, NULL_TREE);
+}
+
+tree
+new_slice (tree arr, tree res_type, tree index)
+{
+#if 0
+  tree res;
+  tree el_ptr_type;
+  tree el_type;
+  tree res_ptr_type;
+#endif
+
+  /*  *((RES_TYPE *)(&ARR[INDEX]))
+      convert ARR to a pointer, add index, and reconvert to array ?  */
+  gcc_assert (TREE_CODE (res_type) == ARRAY_TYPE);
+
+  ortho_mark_addressable (arr);
+  return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
+#if 0
+  el_type = TREE_TYPE (TREE_TYPE (arr));
+  el_ptr_type = build_pointer_type (el_type);
+
+  res = build4 (ARRAY_REF, el_type, arr, index, NULL_TREE, NULL_TREE);
+  res = build1 (ADDR_EXPR, el_ptr_type, res);
+  res_ptr_type = build_pointer_type (res_type);
+  res = build1 (NOP_EXPR, res_ptr_type, res);
+  res = build1 (INDIRECT_REF, res_type, res);
+  return res;
+#endif
+}
+
+tree
+new_selected_element (tree rec, tree el)
+{
+  tree res;
+
+  gcc_assert (TREE_CODE (TREE_TYPE (rec)) == RECORD_TYPE);
+
+  res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
+  return res;
+}
+
+tree
+new_access_element (tree acc)
+{
+  tree acc_type;
+
+  acc_type = TREE_TYPE (acc);
+  gcc_assert (TREE_CODE (acc_type) == POINTER_TYPE);
+
+  return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
+}
+
+tree
+new_offsetof (tree rec_type, tree field, tree rtype)
+{
+  tree off;
+  tree bit_off;
+  HOST_WIDE_INT pos;
+  tree res;
+
+  gcc_assert (DECL_CONTEXT (field) == rec_type);
+
+  off = DECL_FIELD_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (off));
+
+  bit_off = DECL_FIELD_BIT_OFFSET (field);
+
+  /*  The offset must be a constant.  */
+  gcc_assert (tree_fits_uhwi_p (bit_off));
+
+  pos = TREE_INT_CST_LOW (off)
+        + (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
+  res = build_int_cstu (rtype, pos);
+  return res;
+}
+
+tree
+new_sizeof (tree atype, tree rtype)
+{
+ tree size;
+
+ size = TYPE_SIZE_UNIT (atype);
+
+ return fold (build1 (NOP_EXPR, rtype, size));
+}
+
+tree
+new_alignof (tree atype, tree rtype)
+{
+  return build_int_cstu (rtype, TYPE_ALIGN_UNIT (atype));
+}
+
+static tree
+ortho_build_addr (tree lvalue, tree atype)
+{
+  tree res;
+
+  if (TREE_CODE (lvalue) == INDIRECT_REF)
+    {
+      /* ADDR_REF(INDIRECT_REF(x)) -> x.  */
+      res = TREE_OPERAND (lvalue, 0);
+    }
+  else
+    {
+      tree ptr_type;
+
+      /* &base[off] -> base+off.  */
+      ortho_mark_addressable (lvalue);
+
+      if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
+	ptr_type = build_pointer_type (TREE_TYPE (lvalue));
+      else
+	ptr_type = atype;
+      res = fold_build1 (ADDR_EXPR, ptr_type, lvalue);
+    }
+
+  if (TREE_TYPE (res) != atype)
+    res = fold_build1 (NOP_EXPR, atype, res);
+
+  return res;
+}
+
+tree
+new_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+tree
+new_global_unchecked_address (tree lvalue, tree atype)
+{
+  return ortho_build_addr (lvalue, atype);
+}
+
+/*  Return a pointer to function FUNC. */
+static tree
+build_function_ptr (tree func)
+{
+  return build1 (ADDR_EXPR,
+		 build_pointer_type (TREE_TYPE (func)), func);
+}
+
+tree
+new_subprogram_address (tree subprg, tree atype)
+{
+  return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
+}
+
+tree
+new_value (tree lvalue)
+{
+  return lvalue;
+}
+
+void
+new_debug_line_decl (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+new_type_decl (tree ident, tree atype)
+{
+  tree decl;
+
+  TYPE_NAME (atype) = ident;
+  decl = build_decl (input_location, TYPE_DECL, ident, atype);
+  TYPE_STUB_DECL (atype) = decl;
+  push_decl (decl);
+  /*
+      if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
+         --  Do not generate debug info for uncompleted types.
+         Rest_Of_Type_Compilation (Ttype, C_True);
+      end if;
+  */
+}
+
+enum o_storage { o_storage_external,
+		 o_storage_public,
+		 o_storage_private,
+		 o_storage_local };
+
+static void
+set_storage (tree Node, enum o_storage storage)
+{
+  switch (storage)
+    {
+    case o_storage_external:
+      DECL_EXTERNAL (Node) = 1;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 0;
+      break;
+    case o_storage_public:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 1;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_private:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 1;
+      break;
+    case o_storage_local:
+      DECL_EXTERNAL (Node) = 0;
+      TREE_PUBLIC (Node) = 0;
+      TREE_STATIC (Node) = 0;
+      break;
+    }
+}
+
+void
+new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree cst;
+
+  cst = build_decl (input_location, VAR_DECL, ident, atype);
+  set_storage (cst, storage);
+  TREE_READONLY (cst) = 1;
+  push_decl (cst);
+  switch (storage)
+    {
+    case o_storage_local:
+      gcc_unreachable ();
+    case o_storage_external:
+      /*  We are at top level if Current_Function_Decl is null.  */
+      rest_of_decl_compilation
+	(cst, current_function_decl == NULL_TREE, 0);
+      break;
+    case o_storage_public:
+    case o_storage_private:
+      break;
+    }
+  *res = cst;
+}
+
+void
+start_const_value (tree *cst ATTRIBUTE_UNUSED)
+{
+}
+
+void
+finish_const_value (tree *cst, tree val)
+{
+  DECL_INITIAL (*cst) = val;
+  TREE_CONSTANT (val) = 1;
+  TREE_STATIC (*cst) = 1;
+  rest_of_decl_compilation
+        (*cst, current_function_decl == NULL_TREE, 0);
+}
+
+void
+new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
+{
+  tree var;
+
+  var = build_decl (input_location, VAR_DECL, ident, atype);
+  if (current_function_decl != NULL_TREE)
+    {
+      /*  Local variable. */
+      TREE_STATIC (var) = 0;
+      DECL_EXTERNAL (var) = 0;
+      TREE_PUBLIC (var) = 0;
+    }
+  else
+    set_storage (var, storage);
+
+  push_decl (var);
+
+  if (current_function_decl == NULL_TREE)
+    rest_of_decl_compilation (var, 1, 0);
+
+  *res = var;
+}
+
+struct GTY(()) o_inter_list
+{
+  tree ident;
+  enum o_storage storage;
+
+  /*  Return type.  */
+  tree rtype;
+
+  /*  List of parameter types.  */
+  struct list_constr_type param_list;
+
+  /*  Chain of parameters declarations.  */
+  struct chain_constr_type param_chain;
+};
+
+void
+start_function_decl (struct o_inter_list *interfaces,
+		     tree ident,
+		     enum o_storage storage,
+		     tree rtype)
+{
+  interfaces->ident = ident;
+  interfaces->storage = storage;
+  interfaces->rtype = rtype;
+  chain_init (&interfaces->param_chain);
+  list_init (&interfaces->param_list);
+}
+
+void
+start_procedure_decl (struct o_inter_list *interfaces,
+		      tree ident,
+		      enum o_storage storage)
+{
+  start_function_decl (interfaces, ident, storage, void_type_node);
+}
+
+void
+new_interface_decl (struct o_inter_list *interfaces,
+		    tree *res,
+		    tree ident,
+		    tree atype)
+{
+  tree r;
+
+  r = build_decl (input_location, PARM_DECL, ident, atype);
+  /* DECL_CONTEXT (Res, Xxx); */
+
+  /*  Do type conversion: convert boolean and enums to int  */
+  switch (TREE_CODE (atype))
+    {
+    case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
+      DECL_ARG_TYPE (r) = integer_type_node;
+    default:
+      DECL_ARG_TYPE (r) = atype;
+    }
+
+  layout_decl (r, 0);
+
+  chain_append (&interfaces->param_chain, r);
+  ortho_list_append (&interfaces->param_list, atype);
+  *res = r;
+}
+
+void
+finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
+{
+  tree decl;
+  tree result;
+  tree parm;
+  int is_global;
+
+  /* Append a void type in the parameter types chain, so that the function
+     is known not be have variables arguments.  */
+  ortho_list_append (&interfaces->param_list, void_type_node);
+
+  decl = build_decl (input_location, FUNCTION_DECL, interfaces->ident,
+		     build_function_type (interfaces->rtype,
+					  interfaces->param_list.first));
+  DECL_SOURCE_LOCATION (decl) = input_location;
+
+  is_global = current_function_decl == NULL_TREE
+    || interfaces->storage == o_storage_external;
+  if (is_global)
+    set_storage (decl, interfaces->storage);
+  else
+    {
+      /*  A nested subprogram.  */
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+    }
+  /*  The function exist in static storage. */
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  TREE_ADDRESSABLE (decl) = 1;
+
+  /*  Declare the result.
+      FIXME: should be moved in start_function_body. */
+  result = build_decl (input_location,
+                       RESULT_DECL, NULL_TREE, interfaces->rtype);
+  DECL_RESULT (decl) = result;
+  DECL_CONTEXT (result) = decl;
+
+  DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
+  /* Set DECL_CONTEXT of parameters.  */
+  for (parm = interfaces->param_chain.first;
+       parm != NULL_TREE;
+       parm = TREE_CHAIN (parm))
+    DECL_CONTEXT (parm) = decl;
+
+  push_decl (decl);
+
+  /* External functions are never nested.
+     Remove their context, which is set by push_decl.  */
+  if (interfaces->storage == o_storage_external)
+    DECL_CONTEXT (decl) = NULL_TREE;
+
+  if (is_global)
+    rest_of_decl_compilation (decl, 1, 0);
+
+  *res = decl;
+}
+
+void
+start_subprogram_body (tree func)
+{
+  gcc_assert (current_function_decl == DECL_CONTEXT (func));
+  current_function_decl = func;
+
+  /* The function is not anymore external.  */
+  DECL_EXTERNAL (func) = 0;
+
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_subprogram_body (void)
+{
+  tree bind;
+  tree func;
+  tree parent;
+
+  bind = pop_binding ();
+  pop_stmts ();
+
+  func = current_function_decl;
+  DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
+  DECL_SAVED_TREE (func) = bind;
+
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (func, false);
+
+  /* Store the end of the function.  */
+  cfun->function_end_locus = input_location;
+
+  parent = DECL_CONTEXT (func);
+
+  if (parent != NULL)
+    cgraph_get_create_node (func);
+  else
+    cgraph_finalize_function (func, false);
+
+  current_function_decl = parent;
+  set_cfun (NULL);
+}
+
+
+void
+new_debug_line_stmt (int line)
+{
+  input_location = linemap_line_start (line_table, line, 252);
+}
+
+void
+start_declare_stmt (void)
+{
+  push_stmts (alloc_stmt_list ());
+  push_binding ();
+}
+
+void
+finish_declare_stmt (void)
+{
+  tree bind;
+
+  bind = pop_binding ();
+  pop_stmts ();
+  append_stmt (bind);
+}
+
+
+struct GTY(()) o_assoc_list
+{
+  tree subprg;
+  vec<tree, va_gc> *vecptr;
+};
+
+void
+start_association (struct o_assoc_list *assocs, tree subprg)
+{
+  assocs->subprg = subprg;
+  assocs->vecptr = NULL;
+}
+
+void
+new_association (struct o_assoc_list *assocs, tree val)
+{
+  vec_safe_push(assocs->vecptr, val);
+}
+
+tree
+new_function_call (struct o_assoc_list *assocs)
+{
+  return build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                         build_function_ptr (assocs->subprg),
+                         assocs->vecptr);
+}
+
+void
+new_procedure_call (struct o_assoc_list *assocs)
+{
+  tree res;
+
+  res = build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
+                        build_function_ptr (assocs->subprg),
+                        assocs->vecptr);
+  TREE_SIDE_EFFECTS (res) = 1;
+  append_stmt (res);
+}
+
+void
+new_assign_stmt (tree target, tree value)
+{
+  tree n;
+
+  n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
+  TREE_SIDE_EFFECTS (n) = 1;
+  append_stmt (n);
+}
+
+void
+new_func_return_stmt (tree value)
+{
+  tree assign;
+  tree stmt;
+  tree res;
+
+  res = DECL_RESULT (current_function_decl);
+  assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
+  TREE_SIDE_EFFECTS (assign) = 1;
+  stmt = build1 (RETURN_EXPR, void_type_node, assign);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+void
+new_proc_return_stmt (void)
+{
+  tree stmt;
+
+  stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
+  TREE_SIDE_EFFECTS (stmt) = 1;
+  append_stmt (stmt);
+}
+
+
+struct GTY(()) o_if_block
+{
+  tree stmt;
+};
+
+void
+start_if_stmt (struct o_if_block *block, tree cond)
+{
+  tree stmt;
+  tree stmts;
+
+  stmts = alloc_stmt_list ();
+  stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
+  block->stmt = stmt;
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+new_else_stmt (struct o_if_block *block)
+{
+  tree stmts;
+
+  pop_stmts ();
+  stmts = alloc_stmt_list ();
+  COND_EXPR_ELSE (block->stmt) = stmts;
+  push_stmts (stmts);
+}
+
+void
+finish_if_stmt (struct o_if_block *block ATTRIBUTE_UNUSED)
+{
+  pop_stmts ();
+}
+
+
+struct GTY(()) o_snode
+{
+  tree beg_label;
+  tree end_label;
+};
+
+/* Create an artificial label.  */
+static tree
+build_label (void)
+{
+  tree res;
+
+  res = build_decl (input_location, LABEL_DECL, NULL_TREE, void_type_node);
+  DECL_CONTEXT (res) = current_function_decl;
+  DECL_ARTIFICIAL (res) = 1;
+  return res;
+}
+
+void
+start_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  label->beg_label = build_label ();
+
+  stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
+  append_stmt (stmt);
+
+  label->end_label = build_label ();
+}
+
+void
+finish_loop_stmt (struct o_snode *label)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
+  TREE_USED (label->beg_label) = 1;
+  append_stmt (stmt);
+  /*  Emit the end label only if there is a goto to it.
+      (Return may be used to exit from the loop).  */
+  if (TREE_USED (label->end_label))
+    {
+      stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
+      append_stmt (stmt);
+    }
+}
+
+void
+new_exit_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
+  append_stmt (stmt);
+  TREE_USED (l->end_label) = 1;
+}
+
+void
+new_next_stmt (struct o_snode *l)
+{
+  tree stmt;
+
+  stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
+  TREE_USED (l->beg_label) = 1;
+  append_stmt (stmt);
+}
+
+struct GTY(()) o_case_block
+{
+  tree case_type;
+  tree end_label;
+  int add_break;
+};
+
+void
+start_case_stmt (struct o_case_block *block, tree value)
+{
+  tree stmt;
+  tree stmts;
+
+  block->case_type = TREE_TYPE (value);
+  block->end_label = build_label ();
+  block->add_break = 0;
+  stmts = alloc_stmt_list ();
+  stmt = build3 (SWITCH_EXPR, block->case_type, value, stmts, NULL_TREE);
+  append_stmt (stmt);
+  push_stmts (stmts);
+}
+
+void
+start_choice (struct o_case_block *block)
+{
+  tree stmt;
+  if (block->add_break)
+    {
+      stmt = build1 (GOTO_EXPR, block->case_type, block->end_label);
+      append_stmt (stmt);
+
+      block->add_break = 0;
+    }
+}
+
+void
+new_expr_choice (struct o_case_block *block ATTRIBUTE_UNUSED, tree expr)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (expr, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_range_choice (struct o_case_block *block ATTRIBUTE_UNUSED,
+		  tree low, tree high)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (low, high, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+new_default_choice (struct o_case_block *block ATTRIBUTE_UNUSED)
+{
+  tree stmt;
+
+  stmt = build_case_label
+    (NULL_TREE, NULL_TREE, create_artificial_label (input_location));
+  append_stmt (stmt);
+}
+
+void
+finish_choice (struct o_case_block *block)
+{
+  block->add_break = 1;
+}
+
+void
+finish_case_stmt (struct o_case_block *block)
+{
+  tree stmt;
+
+  pop_stmts ();
+  stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
+  append_stmt (stmt);
+}
+
+bool
+compare_identifier_string (tree id, const char *str, size_t len)
+{
+  if (IDENTIFIER_LENGTH (id) != len)
+    return false;
+  if (!memcmp (IDENTIFIER_POINTER (id), str, len))
+    return true;
+  else
+    return false;
+}
+
+void
+get_identifier_string (tree id, const char **str, int *len)
+{
+  *len = IDENTIFIER_LENGTH (id);
+  *str = IDENTIFIER_POINTER (id);
+}
+
+// C linkage wrappers for two (now C++) functions so that
+// Ada code can call them without name mangling
+tree get_identifier_with_length_c (const char *c, size_t s)
+{
+  return get_identifier_with_length(c, s);
+}
+
+int toplev_main_c (int argc, char **argv)
+{
+  return toplev_main(argc, argv);
+}
+
+void
+debug_tree_c (tree expr)
+{
+  warning (OPT_Wall, "Debug tree");
+  debug_tree (expr);
+}
+
+} // end extern "C"
+
+#include "debug.h"
+#include "gt-vhdl-ortho-lang.h"
+#include "gtype-vhdl.h"
diff --git a/src/ortho/gcc/ortho_gcc-main.adb b/src/ortho/gcc/ortho_gcc-main.adb
new file mode 100644
index 000000000..70c8a7f79
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.adb
@@ -0,0 +1,42 @@
+--  GCC back-end for ortho
+--  Copyright (C) 2002-1014 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 Ortho_Gcc_Front;
+with Ada.Command_Line; use Ada.Command_Line;
+
+procedure Ortho_Gcc.Main
+is
+   gnat_argc : Integer;
+   gnat_argv : System.Address;
+
+   pragma Import (C, gnat_argc);
+   pragma Import (C, gnat_argv);
+
+   function Toplev_Main (Argc : Integer; Argv : System.Address)
+                        return Integer;
+   pragma Import (C, Toplev_Main, "toplev_main_c");
+
+   Status : Exit_Status;
+begin
+   Ortho_Gcc_Front.Init;
+
+   --  Note: GCC set signal handlers...
+   Status := Exit_Status (Toplev_Main (gnat_argc, gnat_argv));
+   Set_Exit_Status (Status);
+end Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc-main.ads b/src/ortho/gcc/ortho_gcc-main.ads
new file mode 100644
index 000000000..4bd73a1b6
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc-main.ads
@@ -0,0 +1 @@
+procedure Ortho_Gcc.Main;
diff --git a/src/ortho/gcc/ortho_gcc.adb b/src/ortho/gcc/ortho_gcc.adb
new file mode 100644
index 000000000..ae7b4f53b
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.adb
@@ -0,0 +1,121 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 Ada.Unchecked_Deallocation;
+with Ortho_Gcc_Front; use Ortho_Gcc_Front;
+
+package body Ortho_Gcc is
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Lit);
+   end New_Lit;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Obj);
+   end New_Obj;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return O_Enode (Obj);
+   end New_Obj_Value;
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+   begin
+      null;
+   end New_Debug_Filename_Decl;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   --  Representation of a C String: this is an access to a bounded string.
+   --  Therefore, with GNAT, such an access is a thin pointer.
+   subtype Fat_C_String is String (Positive);
+   type C_String is access all Fat_C_String;
+   pragma Convention (C, C_String);
+
+   C_String_Null : constant C_String := null;
+
+   --  Return the length of a C String (ie, the number of characters before
+   --  the Nul).
+   function C_String_Len (Str : C_String) return Natural;
+   pragma Import (C, C_String_Len, "strlen");
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+                               return Integer;
+   pragma Export (C, Lang_Handle_Option);
+
+   function Lang_Parse_File (Filename : C_String) return Integer;
+   pragma Export (C, Lang_Parse_File);
+
+   function Lang_Handle_Option (Opt : C_String; Arg : C_String)
+     return Integer
+   is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Name => String_Acc, Object => String);
+
+      Res : Natural;
+      Ada_Opt : String_Acc;
+      Ada_Arg : String_Acc;
+      Len : Natural;
+   begin
+      Len := C_String_Len (Opt);
+      Ada_Opt := new String'(Opt (1 .. Len));
+      if Arg /= C_String_Null then
+         Len := C_String_Len (Arg);
+         Ada_Arg := new String'(Arg (1 .. Len));
+      else
+         Ada_Arg := null;
+      end if;
+      Res := Ortho_Gcc_Front.Decode_Option (Ada_Opt, Ada_Arg);
+      Unchecked_Deallocation (Ada_Opt);
+      Unchecked_Deallocation (Ada_Arg);
+      return Res;
+   end Lang_Handle_Option;
+
+   function Lang_Parse_File (Filename : C_String) return Integer
+   is
+      Len : Natural;
+      File : String_Acc;
+   begin
+      if Filename = C_String_Null then
+         File := null;
+      else
+         Len := C_String_Len (Filename);
+         File := new String'(Filename.all (1 .. Len));
+      end if;
+
+      if Ortho_Gcc_Front.Parse (File) then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Lang_Parse_File;
+
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads
new file mode 100644
index 000000000..0afdc0887
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.ads
@@ -0,0 +1,701 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_gcc.private.ads
+--
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  GCC supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+
+   subtype Vec_Ptr is System.Address;
+
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      Case_Type : Tree;
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Atype : Tree;
+      Afield : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Record_Aggr_List);
+
+   type O_Array_Aggr_List is record
+      Atype : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc.private.ads b/src/ortho/gcc/ortho_gcc.private.ads
new file mode 100644
index 000000000..cc2f556f0
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc.private.ads
@@ -0,0 +1,269 @@
+--  GCC back-end for ortho.
+--  Copyright (C) 2002-1014 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 Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package Ortho_Gcc is
+
+private
+   --  GCC supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   pragma Convention (C, O_Storage);
+   --   pragma Convention (C, ON_Op_Kind);
+
+   subtype Tree is System.Address;
+   NULL_TREE : constant Tree := System.Null_Address;
+
+   subtype Vec_Ptr is System.Address;
+
+   type O_Cnode is new Tree;
+   type O_Enode is new Tree;
+   type O_Lnode is new Tree;
+   type O_Tnode is new Tree;
+   type O_Fnode is new Tree;
+   type O_Dnode is new Tree;
+   type O_Snode is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Snode);
+
+   O_Cnode_Null : constant O_Cnode := O_Cnode (NULL_TREE);
+   O_Enode_Null : constant O_Enode := O_Enode (NULL_TREE);
+   O_Lnode_Null : constant O_Lnode := O_Lnode (NULL_TREE);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (NULL_TREE);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (NULL_TREE);
+   O_Snode_Null : constant O_Snode := (NULL_TREE, NULL_TREE);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (NULL_TREE);
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Obj);
+   pragma Inline (New_Obj_Value);
+
+   --  Efficiently append element EL to a chain.
+   --  FIRST is the first element of the chain (must NULL_TREE if the chain
+   --   is empty),
+   --  LAST is the last element of the chain (idem).
+   type Chain_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, Chain_Constr_Type);
+   procedure Chain_Init (Constr : out Chain_Constr_Type);
+   pragma Import (C, Chain_Init);
+   procedure Chain_Append (Constr : in out Chain_Constr_Type; El : Tree);
+   pragma Import (C, Chain_Append);
+
+   --  Efficiently append element EL to a list.
+   type List_Constr_Type is record
+      First : Tree;
+      Last : Tree;
+   end record;
+   pragma Convention (C, List_Constr_Type);
+   procedure List_Init (Constr : out List_Constr_Type);
+   pragma Import (C, List_Init);
+   procedure List_Append (Constr : in out List_Constr_Type; El : Tree);
+   pragma Import (C, List_Append, "ortho_list_append");
+
+   type O_Loop_Block is record
+      Beg_Label : Tree;
+      End_Label : Tree;
+   end record;
+   pragma Convention (C, O_Loop_Block);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      --  Return type.
+      Rtype : O_Tnode;
+      --  List of parameter types.
+      Param_List : List_Constr_Type;
+      --  Chain of parameters declarations.
+      Param_Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Inter_List);
+
+   type O_Element_List is record
+      Res : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+   pragma Convention (C, O_Element_List);
+
+   type O_Case_Block is record
+      Case_Type : Tree;
+      End_Label : Tree;
+      Add_Break : Integer;
+   end record;
+   pragma Convention (C, O_Case_Block);
+
+   type O_If_Block is record
+      Stmt : Tree;
+   end record;
+   pragma Convention (C, O_If_Block);
+
+   type O_Aggr_List is record
+      Atype : Tree;
+      Chain : Chain_Constr_Type;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Atype : Tree;
+      Afield : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Record_Aggr_List);
+
+   type O_Array_Aggr_List is record
+      Atype : Tree;
+      Vec : Vec_Ptr;
+   end record;
+   pragma Convention (C, O_Array_Aggr_List);
+
+   type O_Assoc_List is record
+      Subprg : Tree;
+      List : List_Constr_Type;
+   end record;
+   pragma Convention (C, O_Assoc_List);
+
+   type O_Enum_List is record
+      --  The enumeral_type node.
+      Res : Tree;
+      --  Chain of literals.
+      Chain : Chain_Constr_Type;
+      --  Numeral value (from 0 to nbr - 1) of the next literal to be declared.
+      Num : Natural;
+      --  Size of the enumeration type.
+      Size : Natural;
+   end record;
+   pragma Convention (C, O_Enum_List);
+
+   pragma Import (C, New_Dyadic_Op);
+   pragma Import (C, New_Monadic_Op);
+   pragma Import (C, New_Compare_Op);
+
+   pragma Import (C, New_Convert_Ov);
+   pragma Import (C, New_Alloca);
+
+   pragma Import (C, New_Signed_Literal);
+   pragma Import (C, New_Unsigned_Literal);
+   pragma Import (C, New_Float_Literal);
+   pragma Import (C, New_Null_Access);
+
+   pragma Import (C, Start_Record_Type);
+   pragma Import (C, New_Record_Field);
+   pragma Import (C, Finish_Record_Type);
+   pragma Import (C, New_Uncomplete_Record_Type);
+   pragma Import (C, Start_Uncomplete_Record_Type);
+
+   pragma Import (C, Start_Union_Type);
+   pragma Import (C, New_Union_Field);
+   pragma Import (C, Finish_Union_Type);
+
+   pragma Import (C, New_Unsigned_Type);
+   pragma Import (C, New_Signed_Type);
+   pragma Import (C, New_Float_Type);
+
+   pragma Import (C, New_Access_Type);
+   pragma Import (C, Finish_Access_Type);
+
+   pragma Import (C, New_Array_Type);
+   pragma Import (C, New_Constrained_Array_Type);
+
+   pragma Import (C, New_Boolean_Type);
+   pragma Import (C, Start_Enum_Type);
+   pragma Import (C, New_Enum_Literal);
+   pragma Import (C, Finish_Enum_Type);
+
+   pragma Import (C, Start_Record_Aggr);
+   pragma Import (C, New_Record_Aggr_El);
+   pragma Import (C, Finish_Record_Aggr);
+   pragma Import (C, Start_Array_Aggr);
+   pragma Import (C, New_Array_Aggr_El);
+   pragma Import (C, Finish_Array_Aggr);
+   pragma Import (C, New_Union_Aggr);
+
+   pragma Import (C, New_Indexed_Element);
+   pragma Import (C, New_Slice);
+   pragma Import (C, New_Selected_Element);
+   pragma Import (C, New_Access_Element);
+
+   pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
+   pragma Import (C, New_Offsetof);
+
+   pragma Import (C, New_Address);
+   pragma Import (C, New_Global_Address);
+   pragma Import (C, New_Unchecked_Address);
+   pragma Import (C, New_Global_Unchecked_Address);
+   pragma Import (C, New_Subprogram_Address);
+
+   pragma Import (C, New_Value);
+
+   pragma Import (C, New_Type_Decl);
+   pragma Import (C, New_Debug_Line_Decl);
+   pragma Import (C, New_Const_Decl);
+   pragma Import (C, New_Var_Decl);
+
+   pragma Import (C, Start_Const_Value);
+   pragma Import (C, Finish_Const_Value);
+
+   pragma Import (C, Start_Function_Decl);
+   pragma Import (C, Start_Procedure_Decl);
+   pragma Import (C, New_Interface_Decl);
+   pragma Import (C, Finish_Subprogram_Decl);
+
+   pragma Import (C, Start_Subprogram_Body);
+   pragma Import (C, Finish_Subprogram_Body);
+
+   pragma Import (C, New_Debug_Line_Stmt);
+   pragma Import (C, Start_Declare_Stmt);
+   pragma Import (C, Finish_Declare_Stmt);
+   pragma Import (C, Start_Association);
+   pragma Import (C, New_Association);
+   pragma Import (C, New_Function_Call);
+   pragma Import (C, New_Procedure_Call);
+
+   pragma Import (C, New_Assign_Stmt);
+
+   pragma Import (C, Start_If_Stmt);
+   pragma Import (C, New_Else_Stmt);
+   pragma Import (C, Finish_If_Stmt);
+
+   pragma Import (C, New_Return_Stmt);
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_func_return_stmt", (O_Enode));
+   pragma Import_Procedure (New_Return_Stmt,
+                              "new_proc_return_stmt", null);
+
+   pragma Import (C, Start_Loop_Stmt);
+   pragma Import (C, Finish_Loop_Stmt);
+   pragma Import (C, New_Exit_Stmt);
+   pragma Import (C, New_Next_Stmt);
+
+   pragma Import (C, Start_Case_Stmt);
+   pragma Import (C, Start_Choice);
+   pragma Import (C, New_Expr_Choice);
+   pragma Import (C, New_Range_Choice);
+   pragma Import (C, New_Default_Choice);
+   pragma Import (C, Finish_Choice);
+   pragma Import (C, Finish_Case_Stmt);
+end Ortho_Gcc;
diff --git a/src/ortho/gcc/ortho_gcc_front.ads b/src/ortho/gcc/ortho_gcc_front.ads
new file mode 100644
index 000000000..553057b20
--- /dev/null
+++ b/src/ortho/gcc/ortho_gcc_front.ads
@@ -0,0 +1,2 @@
+with Ortho_Front;
+package Ortho_Gcc_Front renames Ortho_Front;
diff --git a/src/ortho/gcc/ortho_ident.adb b/src/ortho/gcc/ortho_ident.adb
new file mode 100644
index 000000000..770fece2b
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.adb
@@ -0,0 +1,56 @@
+--  GCC back-end for ortho (identifiers)
+--  Copyright (C) 2002-1014 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.
+
+package body Ortho_Ident is
+   function Get_Identifier_With_Length (Str : Address; Size : Integer)
+                                       return O_Ident;
+   pragma Import (C, Get_Identifier_With_Length,
+                  "get_identifier_with_length_c");
+
+   function Compare_Identifier_String
+     (Id : O_Ident; Str : Address; Size : Integer)
+     return Boolean;
+   pragma Import (C, Compare_Identifier_String);
+   pragma Warnings (Off, Compare_Identifier_String);
+
+   function Get_Identifier (Str : String) return O_Ident is
+   begin
+      return Get_Identifier_With_Length (Str'Address, Str'Length);
+   end Get_Identifier;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean is
+   begin
+      return Compare_Identifier_String (Id, Str'Address, Str'Length);
+   end Is_Equal;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      procedure Get_Identifier_String
+        (Id : O_Ident; Str_Ptr : Address; Len_Ptr : Address);
+      pragma Import (C, Get_Identifier_String);
+
+      Len : Natural;
+      type Str_Acc is access String (Positive);
+      Str : Str_Acc;
+   begin
+      Get_Identifier_String (Id, Str'Address, Len'Address);
+      return Str (1 .. Len);
+   end Get_String;
+
+end Ortho_Ident;
+
diff --git a/src/ortho/gcc/ortho_ident.ads b/src/ortho/gcc/ortho_ident.ads
new file mode 100644
index 000000000..76c09ceb9
--- /dev/null
+++ b/src/ortho/gcc/ortho_ident.ads
@@ -0,0 +1,30 @@
+--  GCC back-end for ortho (identifiers)
+--  Copyright (C) 2002-1014 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; use System;
+
+package Ortho_Ident is
+   subtype O_Ident is Address;
+   function Get_Identifier (Str : String) return O_Ident;
+   function Get_String (Id : O_Ident) return String;
+   function Is_Equal (L, R : O_Ident) return Boolean renames System."=";
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   O_Ident_Nul : constant O_Ident;
+private
+   O_Ident_Nul : constant O_Ident := Null_Address;
+end Ortho_Ident;
diff --git a/src/ortho/gcc/ortho_nodes.ads b/src/ortho/gcc/ortho_nodes.ads
new file mode 100644
index 000000000..7c6c4a076
--- /dev/null
+++ b/src/ortho/gcc/ortho_nodes.ads
@@ -0,0 +1,3 @@
+with Ortho_Gcc;
+
+package Ortho_Nodes renames Ortho_Gcc;
diff --git a/src/ortho/llvm/Makefile b/src/ortho/llvm/Makefile
new file mode 100644
index 000000000..135dbdf4b
--- /dev/null
+++ b/src/ortho/llvm/Makefile
@@ -0,0 +1,30 @@
+ortho_srcdir=..
+GNAT_FLAGS=-gnaty3befhkmr -gnata -gnatf -gnatwael -gnat05
+CXX=clang++ --std=c++11
+LLVM_CONFIG=llvm-config
+SED=sed
+BE=llvm
+
+all: $(ortho_exec)
+
+$(ortho_exec): $(ortho_srcdir)/llvm/ortho_llvm.ads force llvm-cbindings.o
+	gnatmake -m -o $@ -g -aI$(ortho_srcdir)/llvm -aI$(ortho_srcdir) \
+	$(GNAT_FLAGS) ortho_code_main -bargs -E \
+	-largs llvm-cbindings.o `$(LLVM_CONFIG) --ldflags --libs --system-libs` -lc++ #-static
+
+llvm-cbindings.o: $(ortho_srcdir)/llvm/llvm-cbindings.cpp
+	$(CXX) -c  -I`$(LLVM_CONFIG) --includedir --cflags` -g -o $@ $<
+
+clean:
+	$(RM) -f *.o *.ali ortho_code_main
+	$(RM) b~*.ad? *~
+
+distclean: clean
+
+
+force:
+
+.PHONY: force all clean
+
+ORTHO_BASENAME=ortho_llvm
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/llvm/llvm-analysis.ads b/src/ortho/llvm/llvm-analysis.ads
new file mode 100644
index 000000000..bfecec579
--- /dev/null
+++ b/src/ortho/llvm/llvm-analysis.ads
@@ -0,0 +1,53 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Analysis is
+   type VerifierFailureAction is
+     (
+      AbortProcessAction, -- verifier will print to stderr and abort()
+      PrintMessageAction, -- verifier will print to stderr and return 1
+      ReturnStatusAction  -- verifier will just return 1
+     );
+   pragma Convention (C, VerifierFailureAction);
+
+   -- Verifies that a module is valid, taking the specified action if not.
+   -- Optionally returns a human-readable description of any invalid
+   -- constructs.
+   -- OutMessage must be disposed with DisposeMessage. */
+   function VerifyModule(M : ModuleRef;
+                         Action : VerifierFailureAction;
+                         OutMessage : access Cstring)
+                        return Integer;
+
+   -- Verifies that a single function is valid, taking the specified
+   --  action. Useful for debugging.
+   function VerifyFunction(Fn : ValueRef; Action : VerifierFailureAction)
+     return Integer;
+
+   -- Open up a ghostview window that displays the CFG of the current function.
+   -- Useful for debugging.
+   procedure ViewFunctionCFG(Fn : ValueRef);
+   procedure ViewFunctionCFGOnly(Fn : ValueRef);
+private
+   pragma Import (C, VerifyModule, "LLVMVerifyModule");
+   pragma Import (C, VerifyFunction, "LLVMVerifyFunction");
+   pragma Import (C, ViewFunctionCFG, "LLVMViewFunctionCFG");
+   pragma Import (C, ViewFunctionCFGOnly, "LLVMViewFunctionCFGOnly");
+end LLVM.Analysis;
+
diff --git a/src/ortho/llvm/llvm-bitwriter.ads b/src/ortho/llvm/llvm-bitwriter.ads
new file mode 100644
index 000000000..3f9c518e4
--- /dev/null
+++ b/src/ortho/llvm/llvm-bitwriter.ads
@@ -0,0 +1,34 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Interfaces.C; use Interfaces.C;
+
+package LLVM.BitWriter is
+   -- Writes a module to an open file descriptor. Returns 0 on success.
+   -- Closes the Handle. Use dup first if this is not what you want.
+   function WriteBitcodeToFileHandle(M : ModuleRef; Handle : File_Descriptor)
+                                    return int;
+
+   -- Writes a module to the specified path. Returns 0 on success.
+   function WriteBitcodeToFile(M : ModuleRef; Path : Cstring)
+                              return int;
+private
+   pragma Import (C, WriteBitcodeToFileHandle, "LLVMWriteBitcodeToFileHandle");
+   pragma Import (C, WriteBitcodeToFile, "LLVMWriteBitcodeToFile");
+end LLVM.BitWriter;
diff --git a/src/ortho/llvm/llvm-cbindings.cpp b/src/ortho/llvm/llvm-cbindings.cpp
new file mode 100644
index 000000000..e4d666ade
--- /dev/null
+++ b/src/ortho/llvm/llvm-cbindings.cpp
@@ -0,0 +1,61 @@
+/*  LLVM binding
+  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+  02111-1307, USA.  */
+#include "llvm-c/Target.h"
+#include "llvm-c/Core.h"
+#include "llvm-c/ExecutionEngine.h"
+#include "llvm/IR/Type.h"
+#include "llvm/IR/LLVMContext.h"
+#include "llvm/IR/Metadata.h"
+#include "llvm/ExecutionEngine/ExecutionEngine.h"
+
+using namespace llvm;
+
+extern "C" {
+
+void
+LLVMInitializeNativeTarget_noinline (void)
+{
+  LLVMInitializeNativeTarget ();
+}
+
+void
+LLVMInitializeNativeAsmPrinter_noinline (void)
+{
+  LLVMInitializeNativeAsmPrinter();
+}
+
+LLVMTypeRef LLVMMetadataTypeInContext(LLVMContextRef C) {
+  return (LLVMTypeRef) Type::getMetadataTy(*unwrap(C));
+}
+
+LLVMTypeRef LLVMMetadataType_extra(void) {
+  return LLVMMetadataTypeInContext(LLVMGetGlobalContext());
+}
+
+void
+LLVMMDNodeReplaceOperandWith_extra (LLVMValueRef N, unsigned i, LLVMValueRef V) {
+  MDNode *MD = cast<MDNode>(unwrap(N));
+  MD->replaceOperandWith (i, unwrap(V));
+}
+
+void *LLVMGetPointerToFunction(LLVMExecutionEngineRef EE, LLVMValueRef Func)
+{
+  return unwrap(EE)->getPointerToFunction(unwrap<Function>(Func));
+}
+
+}
diff --git a/src/ortho/llvm/llvm-core.ads b/src/ortho/llvm/llvm-core.ads
new file mode 100644
index 000000000..74a47484f
--- /dev/null
+++ b/src/ortho/llvm/llvm-core.ads
@@ -0,0 +1,1279 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; 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 Interfaces.C; use Interfaces.C;
+use Interfaces;
+
+package LLVM.Core is
+
+   subtype Cstring is System.Address;
+   function "=" (L, R : Cstring) return Boolean renames System."=";
+   --  Null_Cstring : constant Cstring := Null_Address;
+   Nul : constant String := (1 => Character'Val (0));
+   Empty_Cstring : constant Cstring := Nul'Address;
+
+   --  The top-level container for all LLVM global data. See the LLVMContext
+   --  class.
+   type ContextRef is new System.Address;
+
+   --  The top-level container for all other LLVM Intermediate
+   --  Representation (IR) objects. See the llvm::Module class.
+   type ModuleRef is new System.Address;
+
+   subtype Bool is int;
+
+   --  Each value in the LLVM IR has a type, an LLVMTypeRef. See the llvm::Type
+   --  class.
+   type TypeRef is new System.Address;
+   Null_TypeRef : constant TypeRef := TypeRef (System.Null_Address);
+   type TypeRefArray is array (unsigned range <>) of TypeRef;
+   pragma Convention (C, TypeRefArray);
+
+   type ValueRef is new System.Address;
+   Null_ValueRef : constant ValueRef := ValueRef (System.Null_Address);
+   type ValueRefArray is array (unsigned range <>) of ValueRef; -- Ada
+   pragma Convention (C, ValueRefArray);
+
+   type BasicBlockRef is new System.Address;
+   Null_BasicBlockRef : constant BasicBlockRef :=
+     BasicBlockRef (System.Null_Address);
+   type BasicBlockRefArray is
+     array (unsigned range <>) of BasicBlockRef; -- Ada
+   pragma Convention (C, BasicBlockRefArray);
+
+   type BuilderRef is new System.Address;
+
+   --  Used to provide a module to JIT or interpreter.
+   --  See the llvm::MemoryBuffer class.
+   type MemoryBufferRef is new System.Address;
+
+   --  See the llvm::PassManagerBase class.
+   type PassManagerRef is new System.Address;
+
+   type Attribute is new unsigned;
+   ZExtAttribute            : constant Attribute := 2**0;
+   SExtAttribute            : constant Attribute := 2**1;
+   NoReturnAttribute        : constant Attribute := 2**2;
+   InRegAttribute           : constant Attribute := 2**3;
+   StructRetAttribute       : constant Attribute := 2**4;
+   NoUnwindAttribute        : constant Attribute := 2**5;
+   NoAliasAttribute         : constant Attribute := 2**6;
+   ByValAttribute           : constant Attribute := 2**7;
+   NestAttribute            : constant Attribute := 2**8;
+   ReadNoneAttribute        : constant Attribute := 2**9;
+   ReadOnlyAttribute        : constant Attribute := 2**10;
+   NoInlineAttribute        : constant Attribute := 1**11;
+   AlwaysInlineAttribute    : constant Attribute := 1**12;
+   OptimizeForSizeAttribute : constant Attribute := 1**13;
+   StackProtectAttribute    : constant Attribute := 1**14;
+   StackProtectReqAttribute : constant Attribute := 1**15;
+   Alignment                : constant Attribute := 31**16;
+   NoCaptureAttribute       : constant Attribute := 1**21;
+   NoRedZoneAttribute       : constant Attribute := 1**22;
+   NoImplicitFloatAttribute : constant Attribute := 1**23;
+   NakedAttribute           : constant Attribute := 1**24;
+   InlineHintAttribute      : constant Attribute := 1**25;
+   StackAlignment           : constant Attribute := 7**26;
+   ReturnsTwice             : constant Attribute := 1**29;
+   UWTable                  : constant Attribute := 1**30;
+   NonLazyBind              : constant Attribute := 1**31;
+
+   type TypeKind is
+     (
+      VoidTypeKind,        --  type with no size
+      HalfTypeKind,        --  16 bit floating point type
+      FloatTypeKind,       --  32 bit floating point type
+      DoubleTypeKind,      --  64 bit floating point type
+      X86_FP80TypeKind,    --  80 bit floating point type (X87)
+      FP128TypeKind,       --  128 bit floating point type (112-bit mantissa)
+      PPC_FP128TypeKind,   --  128 bit floating point type (two 64-bits)
+      LabelTypeKind,       --  Labels
+      IntegerTypeKind,     --  Arbitrary bit width integers
+      FunctionTypeKind,    --  Functions
+      StructTypeKind,      --  Structures
+      ArrayTypeKind,       --  Arrays
+      PointerTypeKind,     --  Pointers
+      VectorTypeKind,      --  SIMD 'packed' format, or other vector type
+      MetadataTypeKind,    --  Metadata
+      X86_MMXTypeKind      --  X86 MMX
+     );
+   pragma Convention (C, TypeKind);
+
+   type Linkage is
+     (
+      ExternalLinkage,    --  Externally visible function
+      AvailableExternallyLinkage,
+      LinkOnceAnyLinkage, --  Keep one copy of function when linking (inline)
+      LinkOnceODRLinkage, --  Same, but only replaced by someth equivalent.
+      LinkOnceODRAutoHideLinkage, --  Obsolete
+      WeakAnyLinkage,     --  Keep one copy of function when linking (weak)
+      WeakODRLinkage,     --  Same, but only replaced by someth equivalent.
+      AppendingLinkage,   --  Special purpose, only applies to global arrays
+      InternalLinkage,    --  Rename collisions when linking (static func)
+      PrivateLinkage,     --  Like Internal, but omit from symbol table
+      DLLImportLinkage,   --  Obsolete
+      DLLExportLinkage,   --  Obsolete
+      ExternalWeakLinkage,--  ExternalWeak linkage description
+      GhostLinkage,       --  Obsolete
+      CommonLinkage,      --  Tentative definitions
+      LinkerPrivateLinkage, --  Like Private, but linker removes.
+      LinkerPrivateWeakLinkage --  Like LinkerPrivate, but is weak.
+     );
+   pragma Convention (C, Linkage);
+
+   type Visibility is
+     (
+      DefaultVisibility,  --  The GV is visible
+      HiddenVisibility,   --  The GV is hidden
+      ProtectedVisibility --  The GV is protected
+     );
+   pragma Convention (C, Visibility);
+
+   type CallConv is new unsigned;
+   CCallConv           : constant CallConv := 0;
+   FastCallConv        : constant CallConv := 8;
+   ColdCallConv        : constant CallConv := 9;
+   X86StdcallCallConv  : constant CallConv := 64;
+   X86FastcallCallConv : constant CallConv := 6;
+
+   type IntPredicate is new unsigned;
+   IntEQ  : constant IntPredicate := 32; -- equal
+   IntNE  : constant IntPredicate := 33; -- not equal
+   IntUGT : constant IntPredicate := 34; -- unsigned greater than
+   IntUGE : constant IntPredicate := 35; -- unsigned greater or equal
+   IntULT : constant IntPredicate := 36; -- unsigned less than
+   IntULE : constant IntPredicate := 37; -- unsigned less or equal
+   IntSGT : constant IntPredicate := 38; -- signed greater than
+   IntSGE : constant IntPredicate := 39; -- signed greater or equal
+   IntSLT : constant IntPredicate := 40; -- signed less than
+   IntSLE : constant IntPredicate := 41; -- signed less or equal
+
+   type RealPredicate is
+     (
+      RealPredicateFalse, --  Always false (always folded)
+      RealOEQ,            --  True if ordered and equal
+      RealOGT,            --  True if ordered and greater than
+      RealOGE,            --  True if ordered and greater than or equal
+      RealOLT,            --  True if ordered and less than
+      RealOLE,            --  True if ordered and less than or equal
+      RealONE,            --  True if ordered and operands are unequal
+      RealORD,            --  True if ordered (no nans)
+      RealUNO,            --  True if unordered: isnan(X) | isnan(Y)
+      RealUEQ,            --  True if unordered or equal
+      RealUGT,            --  True if unordered or greater than
+      RealUGE,            --  True if unordered, greater than, or equal
+      RealULT,            --  True if unordered or less than
+      RealULE,            --  True if unordered, less than, or equal
+      RealUNE,            --  True if unordered or not equal
+      RealPredicateTrue   --  Always true (always folded)
+     );
+
+   -- Error handling ----------------------------------------------------
+
+   procedure DisposeMessage (Message : Cstring);
+
+
+   --  Context
+
+   --  Create a new context.
+   --  Every call to this function should be paired with a call to
+   -- LLVMContextDispose() or the context will leak memory.
+   function ContextCreate return ContextRef;
+
+   --  Obtain the global context instance.
+   function GetGlobalContext return ContextRef;
+
+   --  Destroy a context instance.
+   --  This should be called for every call to LLVMContextCreate() or memory
+   --  will be leaked.
+   procedure ContextDispose (C : ContextRef);
+
+   function GetMDKindIDInContext
+     (C : ContextRef; Name : Cstring; Slen : unsigned)
+     return unsigned;
+
+   function GetMDKindID(Name : String; Slen : unsigned) return unsigned;
+
+   -- Modules -----------------------------------------------------------
+
+   -- Create and destroy modules.
+   -- See llvm::Module::Module.
+   function ModuleCreateWithName (ModuleID : Cstring) return ModuleRef;
+
+   -- See llvm::Module::~Module.
+   procedure DisposeModule (M : ModuleRef);
+
+   -- Data layout. See Module::getDataLayout.
+   function GetDataLayout(M : ModuleRef) return Cstring;
+   procedure SetDataLayout(M : ModuleRef; Triple : Cstring);
+
+   -- Target triple. See Module::getTargetTriple.
+   function GetTarget (M : ModuleRef) return Cstring;
+   procedure SetTarget (M : ModuleRef; Triple : Cstring);
+
+   -- See Module::dump.
+   procedure DumpModule(M : ModuleRef);
+
+   --  Print a representation of a module to a file. The ErrorMessage needs to
+   --  be disposed with LLVMDisposeMessage. Returns 0 on success, 1 otherwise.
+   --
+   --  @see Module::print()
+   function PrintModuleToFile(M : ModuleRef;
+                              Filename : Cstring;
+                              ErrorMessage : access Cstring) return Bool;
+
+
+   -- Types -------------------------------------------------------------
+
+   -- LLVM types conform to the following hierarchy:
+   --
+   --   types:
+   --     integer type
+   --     real type
+   --     function type
+   --     sequence types:
+   --       array type
+   --       pointer type
+   --       vector type
+   --     void type
+   --     label type
+   --     opaque type
+
+   -- See llvm::LLVMTypeKind::getTypeID.
+   function GetTypeKind (Ty : TypeRef) return TypeKind;
+
+   -- Operations on integer types
+   function Int1Type return TypeRef;
+   function Int8Type return TypeRef;
+   function Int16Type return TypeRef;
+   function Int32Type return TypeRef;
+   function Int64Type return TypeRef;
+   function IntType(NumBits : unsigned) return TypeRef;
+   function GetIntTypeWidth(IntegerTy : TypeRef) return unsigned;
+
+   function MetadataType return TypeRef;
+
+   -- Operations on real types
+   function FloatType return TypeRef;
+   function DoubleType return TypeRef;
+   function X86FP80Type return TypeRef;
+   function FP128Type return TypeRef;
+   function PPCFP128Type return TypeRef;
+
+   -- Operations on function types
+   function FunctionType(ReturnType : TypeRef;
+                         ParamTypes : TypeRefArray;
+                         ParamCount : unsigned;
+                         IsVarArg : int) return TypeRef;
+
+   function IsFunctionVarArg(FunctionTy : TypeRef) return int;
+   function GetReturnType(FunctionTy : TypeRef) return TypeRef;
+   function CountParamTypes(FunctionTy : TypeRef) return unsigned;
+   procedure GetParamTypes(FunctionTy : TypeRef; Dest : out TypeRefArray);
+
+   -- Operations on struct types
+   function StructType(ElementTypes : TypeRefArray;
+                       ElementCount : unsigned;
+                       Packed : Bool) return TypeRef;
+   function StructCreateNamed(C : ContextRef; Name : Cstring) return TypeRef;
+   procedure StructSetBody(StructTy : TypeRef;
+                           ElementTypes : TypeRefArray;
+                           ElementCount : unsigned;
+                           Packed : Bool);
+   function CountStructElementTypes(StructTy : TypeRef) return unsigned;
+   procedure GetStructElementTypes(StructTy : TypeRef;
+                                   Dest : out TypeRefArray);
+   function IsPackedStruct(StructTy : TypeRef) return Bool;
+
+
+   -- Operations on array, pointer, and vector types (sequence types)
+   function ArrayType(ElementType : TypeRef; ElementCount : unsigned)
+                     return TypeRef;
+   function PointerType(ElementType : TypeRef; AddressSpace : unsigned := 0)
+                       return TypeRef;
+   function VectorType(ElementType : TypeRef; ElementCount : unsigned)
+                      return TypeRef;
+
+   function GetElementType(Ty : TypeRef) return TypeRef;
+   function GetArrayLength(ArrayTy : TypeRef) return unsigned;
+   function GetPointerAddressSpace(PointerTy : TypeRef) return unsigned;
+   function GetVectorSize(VectorTy : TypeRef) return unsigned;
+
+   -- Operations on other types.
+   function VoidType return TypeRef;
+   function LabelType return TypeRef;
+
+   -- Values ------------------------------------------------------------
+   -- The bulk of LLVM's object model consists of values, which comprise a very
+   -- rich type hierarchy.
+   --
+   --   values:
+   --     constants:
+   --       scalar constants
+   --       composite contants
+   --       globals:
+   --         global variable
+   --         function
+   --         alias
+   --       basic blocks
+
+   -- Operations on all values
+   function TypeOf(Val : ValueRef) return TypeRef;
+   function GetValueName(Val : ValueRef) return Cstring;
+   procedure SetValueName(Val : ValueRef; Name : Cstring);
+   procedure DumpValue(Val : ValueRef);
+
+   -- Operations on constants of any type
+   function ConstNull(Ty : TypeRef) return ValueRef; --  All zero
+   function ConstAllOnes(Ty : TypeRef) return ValueRef; -- Int or Vec
+   function GetUndef(Ty : TypeRef) return ValueRef;
+   function IsConstant(Val : ValueRef) return int;
+   function IsNull(Val : ValueRef) return int;
+   function IsUndef(Val : ValueRef) return int;
+
+   --  Convert value instances between types.
+   --
+   --  Internally, an LLVMValueRef is "pinned" to a specific type. This
+   --  series of functions allows you to cast an instance to a specific
+   --  type.
+   --
+   --  If the cast is not valid for the specified type, NULL is returned.
+   --
+   -- @see llvm::dyn_cast_or_null<>
+   function IsAInstruction (Val : ValueRef) return ValueRef;
+
+   -- Operations on scalar constants
+   function ConstInt(IntTy : TypeRef; N : Unsigned_64; SignExtend : int)
+                    return ValueRef;
+   function ConstReal(RealTy : TypeRef; N : double) return ValueRef;
+   function ConstRealOfString(RealTy : TypeRef; Text : Cstring)
+                             return ValueRef;
+
+
+   -- Obtain the zero extended value for an integer constant value.
+   -- @see llvm::ConstantInt::getZExtValue()
+   function ConstIntGetZExtValue (ConstantVal : ValueRef) return Unsigned_64;
+
+   -- Operations on composite constants
+   function ConstString(Str : Cstring;
+                        Length : unsigned; DontNullTerminate : int)
+                       return ValueRef;
+   function ConstArray(ElementTy : TypeRef;
+                       ConstantVals : ValueRefArray; Length : unsigned)
+                      return ValueRef;
+   function ConstStruct(ConstantVals : ValueRefArray;
+                        Count : unsigned; packed : int) return ValueRef;
+
+   --  Create a non-anonymous ConstantStruct from values.
+   --  @see llvm::ConstantStruct::get()
+   function ConstNamedStruct(StructTy : TypeRef;
+                             ConstantVals : ValueRefArray;
+                             Count : unsigned) return ValueRef;
+
+   function ConstVector(ScalarConstantVals : ValueRefArray; Size : unsigned)
+                       return ValueRef;
+
+   -- Constant expressions
+   function SizeOf(Ty : TypeRef) return ValueRef;
+   function AlignOf(Ty : TypeRef) return ValueRef;
+
+   function ConstNeg(ConstantVal : ValueRef) return ValueRef;
+   function ConstNot(ConstantVal : ValueRef) return ValueRef;
+   function ConstAdd(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstSub(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstMul(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstUDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstSDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFDiv(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstURem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstSRem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFRem(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstAnd(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstOr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                   return ValueRef;
+   function ConstXor(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstICmp(Predicate : IntPredicate;
+                      LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstFCmp(Predicate : RealPredicate;
+                      LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstShl(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                    return ValueRef;
+   function ConstLShr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstAShr(LHSConstant : ValueRef; RHSConstant : ValueRef)
+                     return ValueRef;
+   function ConstGEP(ConstantVal : ValueRef;
+                     ConstantIndices : ValueRefArray; NumIndices : unsigned)
+                    return ValueRef;
+   function ConstTrunc(ConstantVal : ValueRef; ToType : TypeRef)
+                      return ValueRef;
+   function ConstSExt(ConstantVal : ValueRef; ToType : TypeRef)
+                     return ValueRef;
+   function ConstZExt(ConstantVal : ValueRef; ToType : TypeRef)
+                     return ValueRef;
+   function ConstFPTrunc(ConstantVal : ValueRef; ToType : TypeRef)
+                        return ValueRef;
+   function ConstFPExt(ConstantVal : ValueRef; ToType : TypeRef)
+                      return ValueRef;
+   function ConstUIToFP(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstSIToFP(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstFPToUI(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstFPToSI(ConstantVal : ValueRef; ToType : TypeRef)
+                       return ValueRef;
+   function ConstPtrToInt(ConstantVal : ValueRef; ToType : TypeRef)
+                         return ValueRef;
+   function ConstIntToPtr(ConstantVal : ValueRef; ToType : TypeRef)
+                         return ValueRef;
+   function ConstBitCast(ConstantVal : ValueRef; ToType : TypeRef)
+                        return ValueRef;
+
+   function ConstTruncOrBitCast(ConstantVal : ValueRef; ToType : TypeRef)
+                               return ValueRef;
+
+   function ConstSelect(ConstantCondition : ValueRef;
+                        ConstantIfTrue : ValueRef;
+                        ConstantIfFalse : ValueRef) return ValueRef;
+   function ConstExtractElement(VectorConstant : ValueRef;
+                                IndexConstant : ValueRef) return ValueRef;
+   function ConstInsertElement(VectorConstant : ValueRef;
+                               ElementValueConstant : ValueRef;
+                               IndexConstant : ValueRef) return ValueRef;
+   function ConstShuffleVector(VectorAConstant : ValueRef;
+                               VectorBConstant : ValueRef;
+                               MaskConstant : ValueRef) return ValueRef;
+
+   -- Operations on global variables, functions, and aliases (globals)
+   function GetGlobalParent(Global : ValueRef) return ModuleRef;
+   function IsDeclaration(Global : ValueRef) return int;
+   function GetLinkage(Global : ValueRef) return Linkage;
+   procedure SetLinkage(Global : ValueRef; Link : Linkage);
+   function GetSection(Global : ValueRef) return Cstring;
+   procedure SetSection(Global : ValueRef; Section : Cstring);
+   function GetVisibility(Global : ValueRef) return Visibility;
+   procedure SetVisibility(Global : ValueRef; Viz : Visibility);
+   function GetAlignment(Global : ValueRef) return unsigned;
+   procedure SetAlignment(Global : ValueRef; Bytes : unsigned);
+
+   -- Operations on global variables
+   function AddGlobal(M : ModuleRef; Ty : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function GetNamedGlobal(M : ModuleRef; Name : Cstring) return ValueRef;
+   function GetFirstGlobal(M : ModuleRef) return ValueRef;
+   function GetLastGlobal(M : ModuleRef) return ValueRef;
+   function GetNextGlobal(GlobalVar : ValueRef) return ValueRef;
+   function GetPreviousGlobal(GlobalVar : ValueRef) return ValueRef;
+   procedure DeleteGlobal(GlobalVar : ValueRef);
+   function GetInitializer(GlobalVar : ValueRef) return ValueRef;
+   procedure SetInitializer(GlobalVar : ValueRef; ConstantVal : ValueRef);
+   function IsThreadLocal(GlobalVar : ValueRef) return int;
+   procedure SetThreadLocal(GlobalVar : ValueRef; IsThreadLocal : int);
+   function IsGlobalConstant(GlobalVar : ValueRef) return int;
+   procedure SetGlobalConstant(GlobalVar : ValueRef; IsConstant : int);
+
+   --  Obtain the number of operands for named metadata in a module.
+   --  @see llvm::Module::getNamedMetadata()
+   function GetNamedMetadataNumOperands(M : ModuleRef; Name : Cstring)
+                                       return unsigned;
+
+   --  Obtain the named metadata operands for a module.
+   --  The passed LLVMValueRef pointer should refer to an array of
+   --  LLVMValueRef at least LLVMGetNamedMetadataNumOperands long. This
+   --  array will be populated with the LLVMValueRef instances. Each
+   --  instance corresponds to a llvm::MDNode.
+   --  @see llvm::Module::getNamedMetadata()
+   --  @see llvm::MDNode::getOperand()
+   procedure GetNamedMetadataOperands
+     (M : ModuleRef; Name : Cstring; Dest : ValueRefArray);
+
+   --  Add an operand to named metadata.
+   --  @see llvm::Module::getNamedMetadata()
+   --  @see llvm::MDNode::addOperand()
+   procedure AddNamedMetadataOperand
+     (M : ModuleRef; Name : Cstring; Val : ValueRef);
+
+   -- Operations on functions
+   function AddFunction(M : ModuleRef; Name : Cstring; FunctionTy : TypeRef)
+                       return ValueRef;
+   function GetNamedFunction(M : ModuleRef; Name : Cstring) return ValueRef;
+   function GetFirstFunction(M : ModuleRef) return ValueRef;
+   function GetLastFunction(M : ModuleRef) return ValueRef;
+   function GetNextFunction(Fn : ValueRef) return ValueRef;
+   function GetPreviousFunction(Fn : ValueRef) return ValueRef;
+   procedure DeleteFunction(Fn : ValueRef);
+   function GetIntrinsicID(Fn : ValueRef) return unsigned;
+   function GetFunctionCallConv(Fn : ValueRef) return CallConv;
+   procedure SetFunctionCallConv(Fn : ValueRef; CC : CallConv);
+   function GetGC(Fn : ValueRef) return Cstring;
+   procedure SetGC(Fn : ValueRef; Name : Cstring);
+
+   --  Add an attribute to a function.
+   --  @see llvm::Function::addAttribute()
+   procedure AddFunctionAttr (Fn : ValueRef; PA : Attribute);
+
+   --  Add a target-dependent attribute to a fuction
+   --  @see llvm::AttrBuilder::addAttribute()
+   procedure AddTargetDependentFunctionAttr
+     (Fn : ValueRef; A : Cstring; V : Cstring);
+
+   --  Obtain an attribute from a function.
+   --  @see llvm::Function::getAttributes()
+   function GetFunctionAttr (Fn : ValueRef) return Attribute;
+
+   --  Remove an attribute from a function.
+   procedure RemoveFunctionAttr (Fn : ValueRef; PA : Attribute);
+
+   -- Operations on parameters
+   function CountParams(Fn : ValueRef) return unsigned;
+   procedure GetParams(Fn : ValueRef; Params : ValueRefArray);
+   function GetParam(Fn : ValueRef; Index : unsigned) return ValueRef;
+   function GetParamParent(Inst : ValueRef) return ValueRef;
+   function GetFirstParam(Fn : ValueRef) return ValueRef;
+   function GetLastParam(Fn : ValueRef) return ValueRef;
+   function GetNextParam(Arg : ValueRef) return ValueRef;
+   function GetPreviousParam(Arg : ValueRef) return ValueRef;
+   procedure AddAttribute(Arg : ValueRef; PA : Attribute);
+   procedure RemoveAttribute(Arg : ValueRef; PA : Attribute);
+   procedure SetParamAlignment(Arg : ValueRef; align : unsigned);
+
+   --  Metadata
+
+   --  Obtain a MDString value from a context.
+   --  The returned instance corresponds to the llvm::MDString class.
+   --  The instance is specified by string data of a specified length. The
+   --  string content is copied, so the backing memory can be freed after
+   --  this function returns.
+   function MDStringInContext(C : ContextRef; Str : Cstring; Len : unsigned)
+                             return ValueRef;
+
+   --  Obtain a MDString value from the global context.
+   function MDString(Str : Cstring; Len : unsigned) return ValueRef;
+
+   --  Obtain a MDNode value from a context.
+   --  The returned value corresponds to the llvm::MDNode class.
+   function MDNodeInContext
+     (C : ContextRef; Vals : ValueRefArray; Count : unsigned)
+     return ValueRef;
+
+   --  Obtain a MDNode value from the global context.
+   function MDNode(Vals : ValueRefArray; Count : unsigned) return ValueRef;
+
+   --  Obtain the underlying string from a MDString value.
+   --  @param V Instance to obtain string from.
+   --  @param Len Memory address which will hold length of returned string.
+   --  @return String data in MDString.
+   function GetMDString(V : ValueRef; Len : access unsigned) return Cstring;
+
+   --  Obtain the number of operands from an MDNode value.
+   --  @param V MDNode to get number of operands from.
+   --  @return Number of operands of the MDNode.
+   function GetMDNodeNumOperands(V : ValueRef) return unsigned;
+
+   --  Obtain the given MDNode's operands.
+   --  The passed LLVMValueRef pointer should point to enough memory to hold
+   --  all of the operands of the given MDNode (see LLVMGetMDNodeNumOperands)
+   --  as LLVMValueRefs. This memory will be populated with the LLVMValueRefs
+   --  of the MDNode's operands.
+   --  @param V MDNode to get the operands from.
+   --  @param Dest Destination array for operands.
+   procedure GetMDNodeOperands(V : ValueRef; Dest : ValueRefArray);
+
+   procedure MDNodeReplaceOperandWith
+     (N : ValueRef; I : unsigned; V : ValueRef);
+
+   -- Operations on basic blocks
+   function BasicBlockAsValue(BB : BasicBlockRef) return ValueRef;
+   function ValueIsBasicBlock(Val : ValueRef) return int;
+   function ValueAsBasicBlock(Val : ValueRef) return BasicBlockRef;
+   function GetBasicBlockParent(BB : BasicBlockRef) return ValueRef;
+   function CountBasicBlocks(Fn : ValueRef) return unsigned;
+   procedure GetBasicBlocks(Fn : ValueRef; BasicBlocks : BasicBlockRefArray);
+   function GetFirstBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function GetLastBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function GetNextBasicBlock(BB : BasicBlockRef) return BasicBlockRef;
+   function GetPreviousBasicBlock(BB : BasicBlockRef) return BasicBlockRef;
+   function GetEntryBasicBlock(Fn : ValueRef) return BasicBlockRef;
+   function AppendBasicBlock(Fn : ValueRef; Name : Cstring)
+                            return BasicBlockRef;
+   function InsertBasicBlock(InsertBeforeBB : BasicBlockRef;
+                             Name : Cstring) return BasicBlockRef;
+   procedure DeleteBasicBlock(BB : BasicBlockRef);
+
+   -- Operations on instructions
+
+   --  Determine whether an instruction has any metadata attached.
+   function HasMetadata(Val: ValueRef) return Bool;
+
+   --  Return metadata associated with an instruction value.
+   function GetMetadata(Val : ValueRef; KindID : unsigned) return ValueRef;
+
+   --  Set metadata associated with an instruction value.
+   procedure SetMetadata(Val : ValueRef; KindID : unsigned; Node : ValueRef);
+
+   function GetInstructionParent(Inst : ValueRef) return BasicBlockRef;
+   function GetFirstInstruction(BB : BasicBlockRef) return ValueRef;
+   function GetLastInstruction(BB : BasicBlockRef) return ValueRef;
+   function GetNextInstruction(Inst : ValueRef) return ValueRef;
+   function GetPreviousInstruction(Inst : ValueRef) return ValueRef;
+
+   -- Operations on call sites
+   procedure SetInstructionCallConv(Instr : ValueRef; CC : unsigned);
+   function GetInstructionCallConv(Instr : ValueRef) return unsigned;
+   procedure AddInstrAttribute(Instr : ValueRef;
+                               index : unsigned; Attr : Attribute);
+   procedure RemoveInstrAttribute(Instr : ValueRef;
+                                 index : unsigned; Attr : Attribute);
+   procedure SetInstrParamAlignment(Instr : ValueRef;
+                                    index : unsigned; align : unsigned);
+
+   -- Operations on call instructions (only)
+   function IsTailCall(CallInst : ValueRef) return int;
+   procedure SetTailCall(CallInst : ValueRef; IsTailCall : int);
+
+   -- Operations on phi nodes
+   procedure AddIncoming(PhiNode : ValueRef; IncomingValues : ValueRefArray;
+                        IncomingBlocks : BasicBlockRefArray; Count : unsigned);
+   function CountIncoming(PhiNode : ValueRef) return unsigned;
+   function GetIncomingValue(PhiNode : ValueRef; Index : unsigned)
+                            return ValueRef;
+   function GetIncomingBlock(PhiNode : ValueRef; Index : unsigned)
+                            return BasicBlockRef;
+
+   -- Instruction builders ----------------------------------------------
+   --  An instruction builder represents a point within a basic block,
+   --  and is the exclusive means of building instructions using the C
+   --  interface.
+
+   function CreateBuilder return BuilderRef;
+   procedure PositionBuilder(Builder : BuilderRef;
+                             Block : BasicBlockRef; Instr : ValueRef);
+   procedure PositionBuilderBefore(Builder : BuilderRef; Instr : ValueRef);
+   procedure PositionBuilderAtEnd(Builder : BuilderRef; Block : BasicBlockRef);
+   function GetInsertBlock(Builder : BuilderRef) return BasicBlockRef;
+   procedure DisposeBuilder(Builder : BuilderRef);
+
+   -- Terminators
+   function BuildRetVoid(Builder : BuilderRef) return ValueRef;
+   function BuildRet(Builder : BuilderRef; V : ValueRef) return ValueRef;
+   function BuildBr(Builder : BuilderRef; Dest : BasicBlockRef)
+                   return ValueRef;
+   function BuildCondBr(Builder : BuilderRef;
+                        If_Br : ValueRef;
+                        Then_Br : BasicBlockRef; Else_Br : BasicBlockRef)
+                       return ValueRef;
+   function BuildSwitch(Builder : BuilderRef;
+                        V : ValueRef;
+                        Else_Br : BasicBlockRef; NumCases : unsigned)
+                       return ValueRef;
+   function BuildInvoke(Builder : BuilderRef;
+                        Fn : ValueRef;
+                        Args : ValueRefArray;
+                        NumArgs : unsigned;
+                        Then_Br : BasicBlockRef;
+                        Catch : BasicBlockRef;
+                        Name : Cstring) return ValueRef;
+   function BuildUnwind(Builder : BuilderRef) return ValueRef;
+   function BuildUnreachable(Builder : BuilderRef) return ValueRef;
+
+   -- Add a case to the switch instruction
+   procedure AddCase(Switch : ValueRef;
+                     OnVal : ValueRef; Dest : BasicBlockRef);
+
+   -- Arithmetic
+   function BuildAdd(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNSWAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildNUWAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFAdd(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+
+   function BuildSub(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNSWSub(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildNUWSub(Builder : BuilderRef;
+                        LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFSub(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   function BuildMul(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildFMul(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   function BuildUDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFDiv(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildURem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSRem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFRem(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildShl(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildLShr(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildAShr(Builder : BuilderRef;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildAnd(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildOr(Builder : BuilderRef;
+                    LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                   return ValueRef;
+   function BuildXor(Builder : BuilderRef;
+                     LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNeg(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildFNeg(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+   function BuildNot(Builder : BuilderRef; V : ValueRef; Name : Cstring)
+                    return ValueRef;
+
+   -- Memory
+   function BuildMalloc(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildArrayMalloc(Builder : BuilderRef;
+                             Ty : TypeRef; Val : ValueRef; Name : Cstring)
+                            return ValueRef;
+   function BuildAlloca(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildArrayAlloca(Builder : BuilderRef;
+                             Ty : TypeRef; Val : ValueRef; Name : Cstring)
+                            return ValueRef;
+   function BuildFree(Builder : BuilderRef; PointerVal : ValueRef)
+                     return ValueRef;
+   function BuildLoad(Builder : BuilderRef; PointerVal : ValueRef;
+                           Name : Cstring) return ValueRef;
+   function BuildStore(Builder : BuilderRef; Val : ValueRef; Ptr : ValueRef)
+                      return ValueRef;
+   function BuildGEP(Builder : BuilderRef;
+                     Pointer : ValueRef;
+                     Indices : ValueRefArray;
+                     NumIndices : unsigned; Name : Cstring) return ValueRef;
+
+   -- Casts
+   function BuildTrunc(Builder : BuilderRef;
+                       Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildZExt(Builder : BuilderRef;
+                      Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function BuildSExt(Builder : BuilderRef;
+                      Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFPToUI(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFPToSI(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildUIToFP(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildSIToFP(Builder : BuilderRef;
+                        Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                       return ValueRef;
+   function BuildFPTrunc(Builder : BuilderRef;
+                         Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                        return ValueRef;
+   function BuildFPExt(Builder : BuilderRef;
+                       Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildPtrToInt(Builder : BuilderRef;
+                          Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                         return ValueRef;
+   function BuildIntToPtr(Builder : BuilderRef;
+                          Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                         return ValueRef;
+   function BuildBitCast(Builder : BuilderRef;
+                         Val : ValueRef; DestTy : TypeRef; Name : Cstring)
+                        return ValueRef;
+
+   -- Comparisons
+   function BuildICmp(Builder : BuilderRef;
+                      Op : IntPredicate;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+   function BuildFCmp(Builder : BuilderRef;
+                      Op : RealPredicate;
+                      LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+                     return ValueRef;
+
+   -- Miscellaneous instructions
+   function BuildPhi(Builder : BuilderRef; Ty : TypeRef; Name : Cstring)
+                    return ValueRef;
+   function BuildCall(Builder : BuilderRef;
+                      Fn : ValueRef;
+                      Args : ValueRefArray; NumArgs : unsigned; Name : Cstring)
+                     return ValueRef;
+   function BuildSelect(Builder : BuilderRef;
+                        If_Sel : ValueRef;
+                        Then_Sel : ValueRef;
+                        Else_Sel : ValueRef;
+                        Name : Cstring) return ValueRef;
+   function BuildVAArg(Builder : BuilderRef;
+                       List : ValueRef; Ty : TypeRef; Name : Cstring)
+                      return ValueRef;
+   function BuildExtractElement(Builder : BuilderRef;
+                                VecVal : ValueRef;
+                                Index : ValueRef;
+                                Name : Cstring) return ValueRef;
+   function BuildInsertElement(Builder : BuilderRef;
+                               VecVal : ValueRef;
+                               EltVal : ValueRef;
+                               Index : ValueRef;
+                               Name : Cstring) return ValueRef;
+   function BuildShuffleVector(Builder : BuilderRef;
+                               V1 : ValueRef;
+                               V2 : ValueRef;
+                               Mask : ValueRef;
+                               Name : Cstring) return ValueRef;
+
+   -- Memory buffers ----------------------------------------------------
+
+   function CreateMemoryBufferWithContentsOfFile
+     (Path : Cstring;
+      OutMemBuf : access MemoryBufferRef;
+      OutMessage : access Cstring) return int;
+   function CreateMemoryBufferWithSTDIN
+     (OutMemBuf : access MemoryBufferRef;
+      OutMessage : access Cstring) return int;
+   procedure DisposeMemoryBuffer(MemBuf : MemoryBufferRef);
+
+
+   -- Pass Managers -----------------------------------------------------
+
+   -- Constructs a new whole-module pass pipeline. This type of pipeline is
+   -- suitable for link-time optimization and whole-module transformations.
+   -- See llvm::PassManager::PassManager.
+   function CreatePassManager return PassManagerRef;
+
+   -- Constructs a new function-by-function pass pipeline over the module
+   -- provider. It does not take ownership of the module provider. This type of
+   -- pipeline is suitable for code generation and JIT compilation tasks.
+   -- See llvm::FunctionPassManager::FunctionPassManager.
+   function CreateFunctionPassManagerForModule(M : ModuleRef)
+                                              return PassManagerRef;
+
+   -- Initializes, executes on the provided module, and finalizes all of the
+   -- passes scheduled in the pass manager. Returns 1 if any of the passes
+   -- modified the module, 0 otherwise. See llvm::PassManager::run(Module&).
+   function RunPassManager(PM : PassManagerRef; M : ModuleRef)
+                          return int;
+
+   -- Initializes all of the function passes scheduled in the function pass
+   -- manager. Returns 1 if any of the passes modified the module, 0 otherwise.
+   -- See llvm::FunctionPassManager::doInitialization.
+   function InitializeFunctionPassManager(FPM : PassManagerRef)
+                                         return int;
+
+   --  Executes all of the function passes scheduled in the function
+   --  pass manager on the provided function. Returns 1 if any of the
+   --  passes modified the function, false otherwise.
+   -- See llvm::FunctionPassManager::run(Function&).
+   function RunFunctionPassManager (FPM : PassManagerRef; F : ValueRef)
+                                   return int;
+
+   -- Finalizes all of the function passes scheduled in in the function pass
+   -- manager. Returns 1 if any of the passes modified the module, 0 otherwise.
+   -- See llvm::FunctionPassManager::doFinalization.
+   function FinalizeFunctionPassManager(FPM : PassManagerRef)
+                                       return int;
+
+   --  Frees the memory of a pass pipeline. For function pipelines,
+   --  does not free the module provider.
+   -- See llvm::PassManagerBase::~PassManagerBase.
+   procedure DisposePassManager(PM : PassManagerRef);
+
+private
+   pragma Import (C, ContextCreate, "LLVMContextCreate");
+   pragma Import (C, GetGlobalContext, "LLVMGetGlobalContext");
+   pragma Import (C, ContextDispose, "LLVMContextDispose");
+
+   pragma Import (C, GetMDKindIDInContext, "LLVMGetMDKindIDInContext");
+   pragma Import (C, GetMDKindID, "LLVMGetMDKindID");
+
+   pragma Import (C, DisposeMessage, "LLVMDisposeMessage");
+   pragma Import (C, ModuleCreateWithName, "LLVMModuleCreateWithName");
+   pragma Import (C, DisposeModule, "LLVMDisposeModule");
+   pragma Import (C, GetDataLayout, "LLVMGetDataLayout");
+   pragma Import (C, SetDataLayout, "LLVMSetDataLayout");
+   pragma Import (C, GetTarget, "LLVMGetTarget");
+   pragma Import (C, SetTarget, "LLVMSetTarget");
+   pragma Import (C, DumpModule, "LLVMDumpModule");
+   pragma Import (C, PrintModuleToFile, "LLVMPrintModuleToFile");
+   pragma Import (C, GetTypeKind, "LLVMGetTypeKind");
+   pragma Import (C, Int1Type, "LLVMInt1Type");
+   pragma Import (C, Int8Type, "LLVMInt8Type");
+   pragma Import (C, Int16Type, "LLVMInt16Type");
+   pragma Import (C, Int32Type, "LLVMInt32Type");
+   pragma Import (C, Int64Type, "LLVMInt64Type");
+   pragma Import (C, IntType, "LLVMIntType");
+   pragma Import (C, GetIntTypeWidth, "LLVMGetIntTypeWidth");
+   pragma Import (C, MetadataType, "LLVMMetadataType_extra");
+
+   pragma Import (C, FloatType, "LLVMFloatType");
+   pragma Import (C, DoubleType, "LLVMDoubleType");
+   pragma Import (C, X86FP80Type, "LLVMX86FP80Type");
+   pragma Import (C, FP128Type, "LLVMFP128Type");
+   pragma Import (C, PPCFP128Type, "LLVMPPCFP128Type");
+
+   pragma Import (C, FunctionType, "LLVMFunctionType");
+   pragma Import (C, IsFunctionVarArg, "LLVMIsFunctionVarArg");
+   pragma Import (C, GetReturnType, "LLVMGetReturnType");
+   pragma Import (C, CountParamTypes, "LLVMCountParamTypes");
+   pragma Import (C, GetParamTypes, "LLVMGetParamTypes");
+
+   pragma Import (C, StructType, "LLVMStructType");
+   pragma Import (C, StructCreateNamed, "LLVMStructCreateNamed");
+   pragma Import (C, StructSetBody, "LLVMStructSetBody");
+   pragma Import (C, CountStructElementTypes, "LLVMCountStructElementTypes");
+   pragma Import (C, GetStructElementTypes, "LLVMGetStructElementTypes");
+   pragma Import (C, IsPackedStruct, "LLVMIsPackedStruct");
+
+   pragma Import (C, ArrayType, "LLVMArrayType");
+   pragma Import (C, PointerType, "LLVMPointerType");
+   pragma Import (C, VectorType, "LLVMVectorType");
+   pragma Import (C, GetElementType, "LLVMGetElementType");
+   pragma Import (C, GetArrayLength, "LLVMGetArrayLength");
+   pragma Import (C, GetPointerAddressSpace, "LLVMGetPointerAddressSpace");
+   pragma Import (C, GetVectorSize, "LLVMGetVectorSize");
+
+   pragma Import (C, VoidType, "LLVMVoidType");
+   pragma Import (C, LabelType, "LLVMLabelType");
+
+   pragma Import (C, TypeOf, "LLVMTypeOf");
+   pragma Import (C, GetValueName, "LLVMGetValueName");
+   pragma Import (C, SetValueName, "LLVMSetValueName");
+   pragma Import (C, DumpValue, "LLVMDumpValue");
+
+   pragma Import (C, ConstNull, "LLVMConstNull");
+   pragma Import (C, ConstAllOnes, "LLVMConstAllOnes");
+   pragma Import (C, GetUndef, "LLVMGetUndef");
+   pragma Import (C, IsConstant, "LLVMIsConstant");
+   pragma Import (C, IsNull, "LLVMIsNull");
+   pragma Import (C, IsUndef, "LLVMIsUndef");
+   pragma Import (C, IsAInstruction, "LLVMIsAInstruction");
+
+   pragma Import (C, ConstInt, "LLVMConstInt");
+   pragma Import (C, ConstReal, "LLVMConstReal");
+   pragma Import (C, ConstIntGetZExtValue, "LLVMConstIntGetZExtValue");
+   pragma Import (C, ConstRealOfString, "LLVMConstRealOfString");
+   pragma Import (C, ConstString, "LLVMConstString");
+   pragma Import (C, ConstArray, "LLVMConstArray");
+   pragma Import (C, ConstStruct, "LLVMConstStruct");
+   pragma Import (C, ConstNamedStruct, "LLVMConstNamedStruct");
+   pragma Import (C, ConstVector, "LLVMConstVector");
+
+   pragma Import (C, SizeOf, "LLVMSizeOf");
+   pragma Import (C, AlignOf, "LLVMAlignOf");
+   pragma Import (C, ConstNeg, "LLVMConstNeg");
+   pragma Import (C, ConstNot, "LLVMConstNot");
+   pragma Import (C, ConstAdd, "LLVMConstAdd");
+   pragma Import (C, ConstSub, "LLVMConstSub");
+   pragma Import (C, ConstMul, "LLVMConstMul");
+   pragma Import (C, ConstUDiv, "LLVMConstUDiv");
+   pragma Import (C, ConstSDiv, "LLVMConstSDiv");
+   pragma Import (C, ConstFDiv, "LLVMConstFDiv");
+   pragma Import (C, ConstURem, "LLVMConstURem");
+   pragma Import (C, ConstSRem, "LLVMConstSRem");
+   pragma Import (C, ConstFRem, "LLVMConstFRem");
+   pragma Import (C, ConstAnd, "LLVMConstAnd");
+   pragma Import (C, ConstOr, "LLVMConstOr");
+   pragma Import (C, ConstXor, "LLVMConstXor");
+   pragma Import (C, ConstICmp, "LLVMConstICmp");
+   pragma Import (C, ConstFCmp, "LLVMConstFCmp");
+   pragma Import (C, ConstShl, "LLVMConstShl");
+   pragma Import (C, ConstLShr, "LLVMConstLShr");
+   pragma Import (C, ConstAShr, "LLVMConstAShr");
+   pragma Import (C, ConstGEP, "LLVMConstGEP");
+   pragma Import (C, ConstTrunc, "LLVMConstTrunc");
+   pragma Import (C, ConstSExt, "LLVMConstSExt");
+   pragma Import (C, ConstZExt, "LLVMConstZExt");
+   pragma Import (C, ConstFPTrunc, "LLVMConstFPTrunc");
+   pragma Import (C, ConstFPExt, "LLVMConstFPExt");
+   pragma Import (C, ConstUIToFP, "LLVMConstUIToFP");
+   pragma Import (C, ConstSIToFP, "LLVMConstSIToFP");
+   pragma Import (C, ConstFPToUI, "LLVMConstFPToUI");
+   pragma Import (C, ConstFPToSI, "LLVMConstFPToSI");
+   pragma Import (C, ConstPtrToInt, "LLVMConstPtrToInt");
+   pragma Import (C, ConstIntToPtr, "LLVMConstIntToPtr");
+   pragma Import (C, ConstBitCast, "LLVMConstBitCast");
+   pragma Import (C, ConstTruncOrBitCast, "LLVMConstTruncOrBitCast");
+   pragma Import (C, ConstSelect, "LLVMConstSelect");
+   pragma Import (C, ConstExtractElement, "LLVMConstExtractElement");
+   pragma Import (C, ConstInsertElement, "LLVMConstInsertElement");
+   pragma Import (C, ConstShuffleVector, "LLVMConstShuffleVector");
+
+   pragma Import (C, GetGlobalParent, "LLVMGetGlobalParent");
+   pragma Import (C, IsDeclaration, "LLVMIsDeclaration");
+   pragma Import (C, GetLinkage, "LLVMGetLinkage");
+   pragma Import (C, SetLinkage, "LLVMSetLinkage");
+   pragma Import (C, GetSection, "LLVMGetSection");
+   pragma Import (C, SetSection, "LLVMSetSection");
+   pragma Import (C, GetVisibility, "LLVMGetVisibility");
+   pragma Import (C, SetVisibility, "LLVMSetVisibility");
+   pragma Import (C, GetAlignment, "LLVMGetAlignment");
+   pragma Import (C, SetAlignment, "LLVMSetAlignment");
+
+   pragma Import (C, AddGlobal, "LLVMAddGlobal");
+   pragma Import (C, GetNamedGlobal, "LLVMGetNamedGlobal");
+   pragma Import (C, GetFirstGlobal, "LLVMGetFirstGlobal");
+   pragma Import (C, GetLastGlobal, "LLVMGetLastGlobal");
+   pragma Import (C, GetNextGlobal, "LLVMGetNextGlobal");
+   pragma Import (C, GetPreviousGlobal, "LLVMGetPreviousGlobal");
+   pragma Import (C, DeleteGlobal, "LLVMDeleteGlobal");
+   pragma Import (C, GetInitializer, "LLVMGetInitializer");
+   pragma Import (C, SetInitializer, "LLVMSetInitializer");
+   pragma Import (C, IsThreadLocal, "LLVMIsThreadLocal");
+   pragma Import (C, SetThreadLocal, "LLVMSetThreadLocal");
+   pragma Import (C, IsGlobalConstant, "LLVMIsGlobalConstant");
+   pragma Import (C, SetGlobalConstant, "LLVMSetGlobalConstant");
+
+   pragma Import (C, GetNamedMetadataNumOperands,
+                  "LLVMGetNamedMetadataNumOperands");
+   pragma Import (C, GetNamedMetadataOperands, "LLVMGetNamedMetadataOperands");
+   pragma Import (C, AddNamedMetadataOperand, "LLVMAddNamedMetadataOperand");
+
+   pragma Import (C, AddFunction, "LLVMAddFunction");
+   pragma Import (C, GetNamedFunction, "LLVMGetNamedFunction");
+   pragma Import (C, GetFirstFunction, "LLVMGetFirstFunction");
+   pragma Import (C, GetLastFunction, "LLVMGetLastFunction");
+   pragma Import (C, GetNextFunction, "LLVMGetNextFunction");
+   pragma Import (C, GetPreviousFunction, "LLVMGetPreviousFunction");
+   pragma Import (C, DeleteFunction, "LLVMDeleteFunction");
+   pragma Import (C, GetIntrinsicID, "LLVMGetIntrinsicID");
+   pragma Import (C, GetFunctionCallConv, "LLVMGetFunctionCallConv");
+   pragma Import (C, SetFunctionCallConv, "LLVMSetFunctionCallConv");
+   pragma Import (C, GetGC, "LLVMGetGC");
+   pragma Import (C, SetGC, "LLVMSetGC");
+
+   pragma Import (C, AddFunctionAttr, "LLVMAddFunctionAttr");
+   pragma import (C, AddTargetDependentFunctionAttr,
+                  "LLVMAddTargetDependentFunctionAttr");
+   pragma Import (C, GetFunctionAttr, "LLVMGetFunctionAttr");
+   pragma Import (C, RemoveFunctionAttr, "LLVMRemoveFunctionAttr");
+
+   pragma Import (C, CountParams, "LLVMCountParams");
+   pragma Import (C, GetParams, "LLVMGetParams");
+   pragma Import (C, GetParam, "LLVMGetParam");
+   pragma Import (C, GetParamParent, "LLVMGetParamParent");
+   pragma Import (C, GetFirstParam, "LLVMGetFirstParam");
+   pragma Import (C, GetLastParam, "LLVMGetLastParam");
+   pragma Import (C, GetNextParam, "LLVMGetNextParam");
+   pragma Import (C, GetPreviousParam, "LLVMGetPreviousParam");
+   pragma Import (C, AddAttribute, "LLVMAddAttribute");
+   pragma Import (C, RemoveAttribute, "LLVMRemoveAttribute");
+   pragma Import (C, SetParamAlignment, "LLVMSetParamAlignment");
+
+   pragma Import (C, MDStringInContext, "LLVMMDStringInContext");
+   pragma Import (C, MDString, "LLVMMDString");
+   pragma Import (C, MDNodeInContext, "LLVMMDNodeInContext");
+   pragma Import (C, MDNode, "LLVMMDNode");
+   pragma Import (C, GetMDString, "LLVMGetMDString");
+   pragma Import (C, GetMDNodeNumOperands, "LLVMGetMDNodeNumOperands");
+   pragma Import (C, GetMDNodeOperands, "LLVMGetMDNodeOperands");
+   pragma Import (C, MDNodeReplaceOperandWith,
+                  "LLVMMDNodeReplaceOperandWith_extra");
+
+   pragma Import (C, BasicBlockAsValue, "LLVMBasicBlockAsValue");
+   pragma Import (C, ValueIsBasicBlock, "LLVMValueIsBasicBlock");
+   pragma Import (C, ValueAsBasicBlock, "LLVMValueAsBasicBlock");
+   pragma Import (C, GetBasicBlockParent, "LLVMGetBasicBlockParent");
+   pragma Import (C, CountBasicBlocks, "LLVMCountBasicBlocks");
+   pragma Import (C, GetBasicBlocks, "LLVMGetBasicBlocks");
+   pragma Import (C, GetFirstBasicBlock, "LLVMGetFirstBasicBlock");
+   pragma Import (C, GetLastBasicBlock, "LLVMGetLastBasicBlock");
+   pragma Import (C, GetNextBasicBlock, "LLVMGetNextBasicBlock");
+   pragma Import (C, GetPreviousBasicBlock, "LLVMGetPreviousBasicBlock");
+   pragma Import (C, GetEntryBasicBlock, "LLVMGetEntryBasicBlock");
+   pragma Import (C, AppendBasicBlock, "LLVMAppendBasicBlock");
+   pragma Import (C, InsertBasicBlock, "LLVMInsertBasicBlock");
+   pragma Import (C, DeleteBasicBlock, "LLVMDeleteBasicBlock");
+
+   pragma Import (C, HasMetadata, "LLVMHasMetadata");
+   pragma Import (C, GetMetadata, "LLVMGetMetadata");
+   pragma Import (C, SetMetadata, "LLVMSetMetadata");
+
+   pragma Import (C, GetInstructionParent, "LLVMGetInstructionParent");
+   pragma Import (C, GetFirstInstruction, "LLVMGetFirstInstruction");
+   pragma Import (C, GetLastInstruction, "LLVMGetLastInstruction");
+   pragma Import (C, GetNextInstruction, "LLVMGetNextInstruction");
+   pragma Import (C, GetPreviousInstruction, "LLVMGetPreviousInstruction");
+
+   pragma Import (C, SetInstructionCallConv, "LLVMSetInstructionCallConv");
+   pragma Import (C, GetInstructionCallConv, "LLVMGetInstructionCallConv");
+   pragma Import (C, AddInstrAttribute, "LLVMAddInstrAttribute");
+   pragma Import (C, RemoveInstrAttribute, "LLVMRemoveInstrAttribute");
+   pragma Import (C, SetInstrParamAlignment, "LLVMSetInstrParamAlignment");
+
+   pragma Import (C, IsTailCall, "LLVMIsTailCall");
+   pragma Import (C, SetTailCall, "LLVMSetTailCall");
+
+   pragma Import (C, AddIncoming, "LLVMAddIncoming");
+   pragma Import (C, CountIncoming, "LLVMCountIncoming");
+   pragma Import (C, GetIncomingValue, "LLVMGetIncomingValue");
+   pragma Import (C, GetIncomingBlock, "LLVMGetIncomingBlock");
+
+   pragma Import (C, CreateBuilder, "LLVMCreateBuilder");
+   pragma Import (C, PositionBuilder, "LLVMPositionBuilder");
+   pragma Import (C, PositionBuilderBefore, "LLVMPositionBuilderBefore");
+   pragma Import (C, PositionBuilderAtEnd, "LLVMPositionBuilderAtEnd");
+   pragma Import (C, GetInsertBlock, "LLVMGetInsertBlock");
+   pragma Import (C, DisposeBuilder, "LLVMDisposeBuilder");
+
+   -- Terminators
+   pragma Import (C, BuildRetVoid, "LLVMBuildRetVoid");
+   pragma Import (C, BuildRet, "LLVMBuildRet");
+   pragma Import (C, BuildBr, "LLVMBuildBr");
+   pragma Import (C, BuildCondBr, "LLVMBuildCondBr");
+   pragma Import (C, BuildSwitch, "LLVMBuildSwitch");
+   pragma Import (C, BuildInvoke, "LLVMBuildInvoke");
+   pragma Import (C, BuildUnwind, "LLVMBuildUnwind");
+   pragma Import (C, BuildUnreachable, "LLVMBuildUnreachable");
+
+   -- Add a case to the switch instruction
+   pragma Import (C, AddCase, "LLVMAddCase");
+
+   -- Arithmetic
+   pragma Import (C, BuildAdd, "LLVMBuildAdd");
+   pragma Import (C, BuildNSWAdd, "LLVMBuildNSWAdd");
+   pragma Import (C, BuildNUWAdd, "LLVMBuildNUWAdd");
+   pragma Import (C, BuildFAdd, "LLVMBuildFAdd");
+   pragma Import (C, BuildSub, "LLVMBuildSub");
+   pragma Import (C, BuildNSWSub, "LLVMBuildNSWSub");
+   pragma Import (C, BuildNUWSub, "LLVMBuildNUWSub");
+   pragma Import (C, BuildFSub, "LLVMBuildFSub");
+   pragma Import (C, BuildMul, "LLVMBuildMul");
+   pragma Import (C, BuildFMul, "LLVMBuildFMul");
+   pragma Import (C, BuildUDiv, "LLVMBuildUDiv");
+   pragma Import (C, BuildSDiv, "LLVMBuildSDiv");
+   pragma Import (C, BuildFDiv, "LLVMBuildFDiv");
+   pragma Import (C, BuildURem, "LLVMBuildURem");
+   pragma Import (C, BuildSRem, "LLVMBuildSRem");
+   pragma Import (C, BuildFRem, "LLVMBuildFRem");
+   pragma Import (C, BuildShl, "LLVMBuildShl");
+   pragma Import (C, BuildLShr, "LLVMBuildLShr");
+   pragma Import (C, BuildAShr, "LLVMBuildAShr");
+   pragma Import (C, BuildAnd, "LLVMBuildAnd");
+   pragma Import (C, BuildOr, "LLVMBuildOr");
+   pragma Import (C, BuildXor, "LLVMBuildXor");
+   pragma Import (C, BuildNeg, "LLVMBuildNeg");
+   pragma Import (C, BuildFNeg, "LLVMBuildFNeg");
+   pragma Import (C, BuildNot, "LLVMBuildNot");
+
+   -- Memory
+   pragma Import (C, BuildMalloc, "LLVMBuildMalloc");
+   pragma Import (C, BuildArrayMalloc, "LLVMBuildArrayMalloc");
+   pragma Import (C, BuildAlloca, "LLVMBuildAlloca");
+   pragma Import (C, BuildArrayAlloca, "LLVMBuildArrayAlloca");
+   pragma Import (C, BuildFree, "LLVMBuildFree");
+   pragma Import (C, BuildLoad, "LLVMBuildLoad");
+   pragma Import (C, BuildStore, "LLVMBuildStore");
+   pragma Import (C, BuildGEP, "LLVMBuildGEP");
+
+   -- Casts
+   pragma Import (C, BuildTrunc, "LLVMBuildTrunc");
+   pragma Import (C, BuildZExt, "LLVMBuildZExt");
+   pragma Import (C, BuildSExt, "LLVMBuildSExt");
+   pragma Import (C, BuildFPToUI, "LLVMBuildFPToUI");
+   pragma Import (C, BuildFPToSI, "LLVMBuildFPToSI");
+   pragma Import (C, BuildUIToFP, "LLVMBuildUIToFP");
+   pragma Import (C, BuildSIToFP, "LLVMBuildSIToFP");
+   pragma Import (C, BuildFPTrunc, "LLVMBuildFPTrunc");
+   pragma Import (C, BuildFPExt, "LLVMBuildFPExt");
+   pragma Import (C, BuildPtrToInt, "LLVMBuildPtrToInt");
+   pragma Import (C, BuildIntToPtr, "LLVMBuildIntToPtr");
+   pragma Import (C, BuildBitCast, "LLVMBuildBitCast");
+
+   -- Comparisons
+   pragma Import (C, BuildICmp, "LLVMBuildICmp");
+   pragma Import (C, BuildFCmp, "LLVMBuildFCmp");
+
+   -- Miscellaneous instructions
+   pragma Import (C, BuildPhi, "LLVMBuildPhi");
+   pragma Import (C, BuildCall, "LLVMBuildCall");
+   pragma Import (C, BuildSelect, "LLVMBuildSelect");
+   pragma Import (C, BuildVAArg, "LLVMBuildVAArg");
+   pragma Import (C, BuildExtractElement, "LLVMBuildExtractElement");
+   pragma Import (C, BuildInsertElement, "LLVMBuildInsertElement");
+   pragma Import (C, BuildShuffleVector, "LLVMBuildShuffleVector");
+
+   -- Memory buffers ----------------------------------------------------
+   pragma Import (C, CreateMemoryBufferWithContentsOfFile,
+                  "LLVMCreateMemoryBufferWithContentsOfFile");
+   pragma Import (C, CreateMemoryBufferWithSTDIN,
+                  "LLVMCreateMemoryBufferWithSTDIN");
+   pragma Import (C, DisposeMemoryBuffer, "LLVMDisposeMemoryBuffer");
+
+   -- Pass Managers -----------------------------------------------------
+   pragma Import (C, CreatePassManager, "LLVMCreatePassManager");
+   pragma Import (C, CreateFunctionPassManagerForModule,
+                  "LLVMCreateFunctionPassManagerForModule");
+   pragma Import (C, RunPassManager, "LLVMRunPassManager");
+   pragma Import (C, InitializeFunctionPassManager,
+                  "LLVMInitializeFunctionPassManager");
+   pragma Import (C, RunFunctionPassManager,
+                  "LLVMRunFunctionPassManager");
+   pragma Import (C, FinalizeFunctionPassManager,
+                  "LLVMFinalizeFunctionPassManager");
+   pragma Import (C, DisposePassManager, "LLVMDisposePassManager");
+
+end LLVM.Core;
diff --git a/src/ortho/llvm/llvm-executionengine.ads b/src/ortho/llvm/llvm-executionengine.ads
new file mode 100644
index 000000000..72d4cda2f
--- /dev/null
+++ b/src/ortho/llvm/llvm-executionengine.ads
@@ -0,0 +1,163 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System; use System;
+with Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+
+package LLVM.ExecutionEngine is
+   type GenericValueRef is new Address;
+   type GenericValueRefArray is array (unsigned range <>) of GenericValueRef;
+   pragma Convention (C, GenericValueRefArray);
+   type ExecutionEngineRef is new Address;
+
+   procedure LinkInJIT;
+   procedure LinkInMCJIT;
+   procedure LinkInInterpreter;
+
+   -- Operations on generic values --------------------------------------
+
+   function CreateGenericValueOfInt(Ty : TypeRef;
+                                    N : Unsigned_64;
+                                    IsSigned : Integer)
+                                   return GenericValueRef;
+
+   function CreateGenericValueOfPointer(P : System.Address)
+                                           return GenericValueRef;
+
+   function CreateGenericValueOfFloat(Ty : TypeRef; N : double)
+                                         return GenericValueRef;
+
+   function GenericValueIntWidth(GenValRef : GenericValueRef)
+                                    return unsigned;
+
+   function GenericValueToInt(GenVal : GenericValueRef;
+                                  IsSigned : Integer) return Unsigned_64;
+
+   function GenericValueToPointer(GenVal : GenericValueRef)
+                                     return System.Address;
+
+   function GenericValueToFloat(TyRef : TypeRef; GenVal : GenericValueRef)
+                               return double;
+
+   procedure DisposeGenericValue(GenVal : GenericValueRef);
+
+   -- Operations on execution engines -----------------------------------
+
+   function CreateExecutionEngineForModule
+     (EE : access ExecutionEngineRef; M : ModuleRef; Error : access Cstring)
+     return Bool;
+
+   function CreateInterpreterForModule (Interp : access ExecutionEngineRef;
+                                        M : ModuleRef;
+                                        Error : access Cstring)
+                                       return Bool;
+
+   function CreateJITCompilerForModule (JIT : access ExecutionEngineRef;
+                                        M : ModuleRef;
+                                        OptLevel : unsigned;
+                                        Error : access Cstring)
+     return Bool;
+
+
+   procedure DisposeExecutionEngine(EE : ExecutionEngineRef);
+
+   procedure RunStaticConstructors(EE : ExecutionEngineRef);
+
+   procedure RunStaticDestructors(EE : ExecutionEngineRef);
+
+   function RunFunctionAsMain(EE : ExecutionEngineRef;
+                              F : ValueRef;
+                              ArgC : unsigned; Argv : Address; EnvP : Address)
+                             return Integer;
+
+   function RunFunction(EE : ExecutionEngineRef;
+                        F : ValueRef;
+                        NumArgs : unsigned;
+                        Args : GenericValueRefArray)
+                       return GenericValueRef;
+
+   procedure FreeMachineCodeForFunction(EE : ExecutionEngineRef; F : ValueRef);
+
+   procedure AddModule(EE : ExecutionEngineRef; M : ModuleRef);
+
+   function RemoveModule(EE : ExecutionEngineRef;
+                         M : ModuleRef;
+                         OutMod : access ModuleRef;
+                         OutError : access Cstring) return Bool;
+
+   function FindFunction(EE : ExecutionEngineRef; Name : Cstring;
+                                                  OutFn : access ValueRef)
+                        return Integer;
+
+   function GetExecutionEngineTargetData(EE : ExecutionEngineRef)
+                                        return TargetDataRef;
+
+   procedure AddGlobalMapping(EE : ExecutionEngineRef; Global : ValueRef;
+                                                       Addr : Address);
+
+   function GetPointerToGlobal (EE : ExecutionEngineRef; GV : ValueRef)
+                               return Address;
+   function GetPointerToFunctionOrStub (EE : ExecutionEngineRef;
+                                        Func : ValueRef)
+                                       return Address;
+
+private
+   pragma Import (C, LinkInJIT, "LLVMLinkInJIT");
+   pragma Import (C, LinkInMCJIT, "LLVMLinkInMCJIT");
+   pragma Import (C, LinkInInterpreter, "LLVMLinkInInterpreter");
+
+   pragma Import (C, CreateGenericValueOfInt, "LLVMCreateGenericValueOfInt");
+   pragma Import (C, CreateGenericValueOfPointer,
+                  "LLVMCreateGenericValueOfPointer");
+   pragma Import (C, CreateGenericValueOfFloat,
+                  "LLVMCreateGenericValueOfFloat");
+   pragma Import (C, GenericValueIntWidth, "LLVMGenericValueIntWidth");
+   pragma Import (C, GenericValueToInt, "LLVMGenericValueToInt");
+   pragma Import (C, GenericValueToPointer, "LLVMGenericValueToPointer");
+   pragma Import (C, GenericValueToFloat, "LLVMGenericValueToFloat");
+   pragma Import (C, DisposeGenericValue, "LLVMDisposeGenericValue");
+
+   -- Operations on execution engines -----------------------------------
+
+   pragma Import (C, CreateExecutionEngineForModule,
+                  "LLVMCreateExecutionEngineForModule");
+   pragma Import (C, CreateInterpreterForModule,
+                  "LLVMCreateInterpreterForModule");
+   pragma Import (C, CreateJITCompilerForModule,
+                  "LLVMCreateJITCompilerForModule");
+   pragma Import (C, DisposeExecutionEngine, "LLVMDisposeExecutionEngine");
+   pragma Import (C, RunStaticConstructors, "LLVMRunStaticConstructors");
+   pragma Import (C, RunStaticDestructors, "LLVMRunStaticDestructors");
+   pragma Import (C, RunFunctionAsMain, "LLVMRunFunctionAsMain");
+   pragma Import (C, RunFunction, "LLVMRunFunction");
+   pragma Import (C, FreeMachineCodeForFunction,
+                  "LLVMFreeMachineCodeForFunction");
+   pragma Import (C, AddModule, "LLVMAddModule");
+   pragma Import (C, RemoveModule, "LLVMRemoveModule");
+   pragma Import (C, FindFunction, "LLVMFindFunction");
+   pragma Import (C, GetExecutionEngineTargetData,
+                "LLVMGetExecutionEngineTargetData");
+   pragma Import (C, AddGlobalMapping, "LLVMAddGlobalMapping");
+
+   pragma Import (C, GetPointerToFunctionOrStub,
+                  "LLVMGetPointerToFunctionOrStub");
+   pragma Import (C, GetPointerToGlobal,
+                  "LLVMGetPointerToGlobal");
+end LLVM.ExecutionEngine;
diff --git a/src/ortho/llvm/llvm-target.ads b/src/ortho/llvm/llvm-target.ads
new file mode 100644
index 000000000..b7c35848a
--- /dev/null
+++ b/src/ortho/llvm/llvm-target.ads
@@ -0,0 +1,84 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; 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 Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Target is
+
+   type TargetDataRef is new System.Address;
+
+   --  LLVMInitializeNativeTarget - The main program should call this function
+   --  to initialize the native target corresponding to the host.  This is
+   --  useful for JIT applications to ensure that the target gets linked in
+   --  correctly.
+   procedure InitializeNativeTarget;
+   pragma Import (C, InitializeNativeTarget,
+                  "LLVMInitializeNativeTarget_noinline");
+
+   --  LLVMInitializeNativeTargetAsmPrinter - The main program should call this
+   --  function to initialize the printer for the native target corresponding
+   --  to the host.
+   procedure InitializeNativeAsmPrinter;
+   pragma Import (C, InitializeNativeAsmPrinter,
+                  "LLVMInitializeNativeAsmPrinter_noinline");
+
+   --  Creates target data from a target layout string.
+   --  See the constructor llvm::DataLayout::DataLayout.
+   function CreateTargetData (StringRep : Cstring) return TargetDataRef;
+   pragma Import (C, CreateTargetData, "LLVMCreateTargetData");
+
+   --  Adds target data information to a pass manager. This does not take
+   --  ownership of the target data.
+   --  See the method llvm::PassManagerBase::add.
+   procedure AddTargetData(TD : TargetDataRef; PM : PassManagerRef);
+   pragma Import (C, AddTargetData, "LLVMAddTargetData");
+
+   --  Converts target data to a target layout string. The string must be
+   --  disposed with LLVMDisposeMessage.
+   --  See the constructor llvm::DataLayout::DataLayout. */
+   function CopyStringRepOfTargetData(TD :TargetDataRef) return Cstring;
+   pragma Import (C, CopyStringRepOfTargetData,
+                  "LLVMCopyStringRepOfTargetData");
+
+   --  Returns the pointer size in bytes for a target.
+   --  See the method llvm::DataLayout::getPointerSize.
+   function PointerSize(TD : TargetDataRef) return unsigned;
+   pragma Import (C, PointerSize, "LLVMPointerSize");
+
+   --  Computes the ABI size of a type in bytes for a target.
+   --  See the method llvm::DataLayout::getTypeAllocSize.
+   function ABISizeOfType (TD : TargetDataRef; Ty: TypeRef) return Unsigned_64;
+   pragma Import (C, ABISizeOfType, "LLVMABISizeOfType");
+
+   --  Computes the ABI alignment of a type in bytes for a target.
+   --  See the method llvm::DataLayout::getTypeABISize.
+   function ABIAlignmentOfType (TD : TargetDataRef; Ty: TypeRef)
+                               return Unsigned_32;
+   pragma Import (C, ABIAlignmentOfType, "LLVMABIAlignmentOfType");
+
+   --  Computes the byte offset of the indexed struct element for a target.
+   --  See the method llvm::StructLayout::getElementContainingOffset.
+   function OffsetOfElement(TD : TargetDataRef;
+                            StructTy : TypeRef;
+                            Element : Unsigned_32)
+                           return Unsigned_64;
+   pragma Import (C, OffsetOfElement, "LLVMOffsetOfElement");
+
+end LLVM.Target;
diff --git a/src/ortho/llvm/llvm-targetmachine.ads b/src/ortho/llvm/llvm-targetmachine.ads
new file mode 100644
index 000000000..cbf074940
--- /dev/null
+++ b/src/ortho/llvm/llvm-targetmachine.ads
@@ -0,0 +1,122 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; 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 LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+
+package LLVM.TargetMachine is
+
+   type TargetMachineRef is new System.Address;
+   Null_TargetMachineRef : constant TargetMachineRef :=
+     TargetMachineRef (System.Null_Address);
+
+   type TargetRef is new System.Address;
+   Null_TargetRef : constant TargetRef := TargetRef (System.Null_Address);
+
+   type CodeGenOptLevel is (CodeGenLevelNone,
+                            CodeGenLevelLess,
+                            CodeGenLevelDefault,
+                            CodeGenLevelAggressive);
+   pragma Convention (C, CodeGenOptLevel);
+
+   type RelocMode is (RelocDefault,
+                      RelocStatic,
+                      RelocPIC,
+                      RelocDynamicNoPic);
+   pragma Convention (C, RelocMode);
+
+   type CodeModel is (CodeModelDefault,
+                      CodeModelJITDefault,
+                      CodeModelSmall,
+                      CodeModelKernel,
+                      CodeModelMedium,
+                      CodeModelLarge);
+   pragma Convention (C, CodeModel);
+
+   type CodeGenFileType is (AssemblyFile,
+                            ObjectFile);
+   pragma Convention (C, CodeGenFileType);
+
+   --  Returns the first llvm::Target in the registered targets list.
+   function GetFirstTarget return TargetRef;
+   pragma Import (C, GetFirstTarget, "LLVMGetFirstTarget");
+
+   --  Returns the next llvm::Target given a previous one (or null if there's
+   --  none) */
+   function GetNextTarget(T : TargetRef) return TargetRef;
+   pragma Import (C, GetNextTarget, "LLVMGetNextTarget");
+
+   --  Target
+
+   --  Finds the target corresponding to the given name and stores it in T.
+   --  Returns 0 on success.
+   function GetTargetFromName (Name : Cstring) return TargetRef;
+   pragma Import (C, GetTargetFromName, "LLVMGetTargetFromName");
+
+   --  Finds the target corresponding to the given triple and stores it in T.
+   --  Returns 0 on success. Optionally returns any error in ErrorMessage.
+   --  Use LLVMDisposeMessage to dispose the message.
+   --  Ada: ErrorMessage is the address of a Cstring.
+   function GetTargetFromTriple
+     (Triple : Cstring; T : access TargetRef; ErrorMessage : access Cstring)
+     return Bool;
+   pragma Import (C, GetTargetFromTriple, "LLVMGetTargetFromTriple");
+
+   --  Returns the name of a target. See llvm::Target::getName
+   function GetTargetName (T: TargetRef) return Cstring;
+   pragma Import (C, GetTargetName, "LLVMGetTargetName");
+
+   --  Returns the description  of a target. See llvm::Target::getDescription
+   function GetTargetDescription (T : TargetRef) return Cstring;
+   pragma Import (C, GetTargetDescription, "LLVMGetTargetDescription");
+
+   --  Target Machine ----------------------------------------------------
+
+   --  Creates a new llvm::TargetMachine. See llvm::Target::createTargetMachine
+
+   function CreateTargetMachine(T : TargetRef;
+                                Triple : Cstring;
+                                CPU : Cstring;
+                                Features : Cstring;
+                                Level : CodeGenOptLevel;
+                                Reloc : RelocMode;
+                                CM : CodeModel)
+                               return TargetMachineRef;
+   pragma Import (C, CreateTargetMachine, "LLVMCreateTargetMachine");
+
+   -- Returns the llvm::DataLayout used for this llvm:TargetMachine.
+   function GetTargetMachineData(T : TargetMachineRef) return TargetDataRef;
+   pragma Import (C, GetTargetMachineData, "LLVMGetTargetMachineData");
+
+   --  Emits an asm or object file for the given module to the filename. This
+   --  wraps several c++ only classes (among them a file stream). Returns any
+   --  error in ErrorMessage. Use LLVMDisposeMessage to dispose the message.
+   function TargetMachineEmitToFile(T : TargetMachineRef;
+                                    M : ModuleRef;
+                                    Filename : Cstring;
+                                    Codegen : CodeGenFileType;
+                                    ErrorMessage : access Cstring)
+                                   return Bool;
+   pragma Import (C, TargetMachineEmitToFile,
+                  "LLVMTargetMachineEmitToFile");
+
+   --  Get a triple for the host machine as a string. The result needs to be
+   --  disposed with LLVMDisposeMessage.
+   function GetDefaultTargetTriple return Cstring;
+   pragma Import (C, GetDefaultTargetTriple, "LLVMGetDefaultTargetTriple");
+end LLVM.TargetMachine;
diff --git a/src/ortho/llvm/llvm-transforms-scalar.ads b/src/ortho/llvm/llvm-transforms-scalar.ads
new file mode 100644
index 000000000..0f23ce87e
--- /dev/null
+++ b/src/ortho/llvm/llvm-transforms-scalar.ads
@@ -0,0 +1,169 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with LLVM.Core; use LLVM.Core;
+
+package LLVM.Transforms.Scalar is
+   --  See llvm::createAggressiveDCEPass function.
+   procedure AddAggressiveDCEPass(PM : PassManagerRef);
+   pragma Import (C, AddAggressiveDCEPass, "LLVMAddAggressiveDCEPass");
+
+   --  See llvm::createCFGSimplificationPass function.
+   procedure AddCFGSimplificationPass(PM : PassManagerRef);
+   pragma Import (C, AddCFGSimplificationPass, "LLVMAddCFGSimplificationPass");
+
+   --  See llvm::createDeadStoreEliminationPass function.
+   procedure AddDeadStoreEliminationPass(PM : PassManagerRef);
+   pragma Import (C, AddDeadStoreEliminationPass,
+                  "LLVMAddDeadStoreEliminationPass");
+
+   --  See llvm::createScalarizerPass function.
+   procedure AddScalarizerPass(PM : PassManagerRef);
+   pragma Import (C, AddScalarizerPass, "LLVMAddScalarizerPass");
+
+   --  See llvm::createGVNPass function.
+   procedure AddGVNPass(PM : PassManagerRef);
+   pragma Import (C, AddGVNPass, "LLVMAddGVNPass");
+
+   --  See llvm::createIndVarSimplifyPass function.
+   procedure AddIndVarSimplifyPass(PM : PassManagerRef);
+   pragma Import (C, AddIndVarSimplifyPass, "LLVMAddIndVarSimplifyPass");
+
+   --  See llvm::createInstructionCombiningPass function.
+   procedure AddInstructionCombiningPass(PM : PassManagerRef);
+   pragma Import (C, AddInstructionCombiningPass,
+                  "LLVMAddInstructionCombiningPass");
+
+   --  See llvm::createJumpThreadingPass function.
+   procedure AddJumpThreadingPass(PM : PassManagerRef);
+   pragma Import (C, AddJumpThreadingPass, "LLVMAddJumpThreadingPass");
+
+   --  See llvm::createLICMPass function.
+   procedure AddLICMPass(PM : PassManagerRef);
+   pragma Import (C, AddLICMPass, "LLVMAddLICMPass");
+
+   --  See llvm::createLoopDeletionPass function.
+   procedure AddLoopDeletionPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopDeletionPass, "LLVMAddLoopDeletionPass");
+
+   --  See llvm::createLoopIdiomPass function
+   procedure AddLoopIdiomPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopIdiomPass, "LLVMAddLoopIdiomPass");
+
+   --  See llvm::createLoopRotatePass function.
+   procedure AddLoopRotatePass(PM : PassManagerRef);
+   pragma Import (C, AddLoopRotatePass, "LLVMAddLoopRotatePass");
+
+   --  See llvm::createLoopRerollPass function.
+   procedure AddLoopRerollPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopRerollPass, "LLVMAddLoopRerollPass");
+
+   --  See llvm::createLoopUnrollPass function.
+   procedure AddLoopUnrollPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopUnrollPass, "LLVMAddLoopUnrollPass");
+
+   --  See llvm::createLoopUnswitchPass function.
+   procedure AddLoopUnswitchPass(PM : PassManagerRef);
+   pragma Import (C, AddLoopUnswitchPass, "LLVMAddLoopUnswitchPass");
+
+   --  See llvm::createMemCpyOptPass function.
+   procedure AddMemCpyOptPass(PM : PassManagerRef);
+   pragma Import (C, AddMemCpyOptPass, "LLVMAddMemCpyOptPass");
+
+   --  See llvm::createPartiallyInlineLibCallsPass function.
+   procedure AddPartiallyInlineLibCallsPass(PM : PassManagerRef);
+   pragma Import (C, AddPartiallyInlineLibCallsPass,
+                  "LLVMAddPartiallyInlineLibCallsPass");
+
+   --  See llvm::createPromoteMemoryToRegisterPass function.
+   procedure AddPromoteMemoryToRegisterPass(PM : PassManagerRef);
+   pragma Import (C, AddPromoteMemoryToRegisterPass,
+                  "LLVMAddPromoteMemoryToRegisterPass");
+
+   --  See llvm::createReassociatePass function.
+   procedure AddReassociatePass(PM : PassManagerRef);
+   pragma Import (C, AddReassociatePass, "LLVMAddReassociatePass");
+
+   --  See llvm::createSCCPPass function.
+   procedure AddSCCPPass(PM : PassManagerRef);
+   pragma Import (C, AddSCCPPass, "LLVMAddSCCPPass");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPass(PM : PassManagerRef);
+   pragma Import (C, AddScalarReplAggregatesPass,
+                  "LLVMAddScalarReplAggregatesPass");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPassSSA(PM : PassManagerRef);
+   pragma Import (C, AddScalarReplAggregatesPassSSA,
+                  "LLVMAddScalarReplAggregatesPassSSA");
+
+   --  See llvm::createScalarReplAggregatesPass function.
+   procedure AddScalarReplAggregatesPassWithThreshold
+     (PM : PassManagerRef; Threshold : Integer);
+   pragma Import (C, AddScalarReplAggregatesPassWithThreshold,
+                  "LLVMAddScalarReplAggregatesPassWithThreshold");
+
+   --  See llvm::createSimplifyLibCallsPass function.
+   procedure AddSimplifyLibCallsPass(PM : PassManagerRef);
+   pragma Import (C, AddSimplifyLibCallsPass, "LLVMAddSimplifyLibCallsPass");
+
+   --  See llvm::createTailCallEliminationPass function.
+   procedure AddTailCallEliminationPass(PM : PassManagerRef);
+   pragma Import (C, AddTailCallEliminationPass,
+                  "LLVMAddTailCallEliminationPass");
+
+   --  See llvm::createConstantPropagationPass function.
+   procedure AddConstantPropagationPass(PM : PassManagerRef);
+   pragma Import (C, AddConstantPropagationPass,
+                  "LLVMAddConstantPropagationPass");
+
+   --  See llvm::demotePromoteMemoryToRegisterPass function.
+   procedure AddDemoteMemoryToRegisterPass(PM : PassManagerRef);
+   pragma Import (C, AddDemoteMemoryToRegisterPass,
+                  "LLVMAddDemoteMemoryToRegisterPass");
+
+   --  See llvm::createVerifierPass function.
+   procedure AddVerifierPass(PM : PassManagerRef);
+   pragma Import (C, AddVerifierPass, "LLVMAddVerifierPass");
+
+   --  See llvm::createCorrelatedValuePropagationPass function
+   procedure AddCorrelatedValuePropagationPass(PM : PassManagerRef);
+   pragma Import (C, AddCorrelatedValuePropagationPass,
+                  "LLVMAddCorrelatedValuePropagationPass");
+
+   --  See llvm::createEarlyCSEPass function
+   procedure AddEarlyCSEPass(PM : PassManagerRef);
+   pragma Import (C, AddEarlyCSEPass, "LLVMAddEarlyCSEPass");
+
+   --  See llvm::createLowerExpectIntrinsicPass function
+   procedure AddLowerExpectIntrinsicPass(PM : PassManagerRef);
+   pragma Import (C, AddLowerExpectIntrinsicPass,
+                  "LLVMAddLowerExpectIntrinsicPass");
+
+   --  See llvm::createTypeBasedAliasAnalysisPass function
+   procedure AddTypeBasedAliasAnalysisPass(PM : PassManagerRef);
+   pragma Import (C, AddTypeBasedAliasAnalysisPass,
+                  "LLVMAddTypeBasedAliasAnalysisPass");
+
+   --  See llvm::createBasicAliasAnalysisPass function
+   procedure AddBasicAliasAnalysisPass(PM : PassManagerRef);
+   pragma Import (C, AddBasicAliasAnalysisPass,
+                  "LLVMAddBasicAliasAnalysisPass");
+end LLVM.Transforms.Scalar;
+
+
diff --git a/src/ortho/llvm/llvm-transforms.ads b/src/ortho/llvm/llvm-transforms.ads
new file mode 100644
index 000000000..d5a8011ce
--- /dev/null
+++ b/src/ortho/llvm/llvm-transforms.ads
@@ -0,0 +1,21 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package LLVM.Transforms is
+   pragma Pure (LLVM.Transforms);
+end LLVM.Transforms;
diff --git a/src/ortho/llvm/llvm.ads b/src/ortho/llvm/llvm.ads
new file mode 100644
index 000000000..80d036b84
--- /dev/null
+++ b/src/ortho/llvm/llvm.ads
@@ -0,0 +1,21 @@
+--  LLVM binding
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package LLVM is
+   pragma Pure (LLVM);
+end LLVM;
diff --git a/src/ortho/llvm/ortho_code_main.adb b/src/ortho/llvm/ortho_code_main.adb
new file mode 100644
index 000000000..300bb32d1
--- /dev/null
+++ b/src/ortho/llvm/ortho_code_main.adb
@@ -0,0 +1,391 @@
+--  LLVM back-end for ortho - Main subprogram.
+--  Copyright (C) 2014 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 Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Ortho_Front; use Ortho_Front;
+with LLVM.BitWriter;
+with LLVM.Core; use LLVM.Core;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+with LLVM.Target; use LLVM.Target;
+with LLVM.TargetMachine; use LLVM.TargetMachine;
+with LLVM.Analysis;
+with LLVM.Transforms.Scalar;
+with Ortho_LLVM; use Ortho_LLVM;
+with Interfaces;
+with Interfaces.C; use Interfaces.C;
+
+procedure Ortho_Code_Main is
+   --  Name of the output filename (given by option '-o').
+   Output : String_Acc := null;
+
+   type Output_Kind_Type is (Output_Llvm, Output_Bytecode,
+                             Output_Assembly, Output_Object);
+   Output_Kind : Output_Kind_Type := Output_Llvm;
+
+   --  True if the LLVM output must be displayed (set by '--dump-llvm')
+   Flag_Dump_Llvm : Boolean := False;
+
+   --  Index of the first file argument.
+   First_File : Natural;
+
+   --  Set by '--exec': function to call and its argument (an integer)
+   Exec_Func : String_Acc := null;
+   Exec_Val : Integer := 0;
+
+   --  Current option index.
+   Optind : Natural;
+
+   --  Number of arguments.
+   Argc : constant Natural := Argument_Count;
+
+   --  Name of the module.
+   Module_Name : String := "ortho" & Ascii.Nul;
+
+   --  Target triple.
+   Triple : Cstring := Empty_Cstring;
+
+   --  Execution engine
+   Engine : aliased ExecutionEngineRef;
+
+   Target : aliased TargetRef;
+
+   CPU : constant Cstring := Empty_Cstring;
+   Features : constant Cstring := Empty_Cstring;
+   Reloc : constant RelocMode := RelocDefault;
+
+   procedure Dump_Llvm
+   is
+      use LLVM.Analysis;
+      Msg : aliased Cstring;
+   begin
+      DumpModule (Module);
+      if LLVM.Analysis.VerifyModule
+        (Module, PrintMessageAction, Msg'Access) /= 0
+      then
+         null;
+      end if;
+   end Dump_Llvm;
+
+   function To_String (C : Cstring) return String is
+      function Strlen (C : Cstring) return Natural;
+      pragma Import (C, Strlen);
+
+      subtype Fat_String is String (Positive);
+      type Fat_String_Acc is access Fat_String;
+
+      function To_Fat_String_Acc is new
+        Ada.Unchecked_Conversion (Cstring, Fat_String_Acc);
+   begin
+      return To_Fat_String_Acc (C)(1 .. Strlen (C));
+   end To_String;
+
+   Codegen : CodeGenFileType := ObjectFile;
+
+   Msg : aliased Cstring;
+begin
+   Ortho_Front.Init;
+
+   --  Decode options.
+   First_File := Natural'Last;
+   Optind := 1;
+   while Optind <= Argc loop
+      declare
+         Arg : constant String := Argument (Optind);
+      begin
+         if Arg (1) = '-' then
+            if Arg = "--dump-llvm" then
+               Flag_Dump_Llvm := True;
+            elsif Arg = "-o" then
+               if Optind = Argc then
+                  Put_Line (Standard_Error, "error: missing filename to '-o'");
+                  return;
+               end if;
+               Output := new String'(Argument (Optind + 1) & ASCII.Nul);
+               Optind := Optind + 1;
+            elsif Arg = "-quiet" then
+               --  Skip silently.
+               null;
+            elsif Arg = "-S" then
+               Output_Kind := Output_Assembly;
+               Codegen := AssemblyFile;
+            elsif Arg = "-c" then
+               Output_Kind := Output_Object;
+               Codegen := ObjectFile;
+            elsif Arg = "-O0" then
+               Optimization := CodeGenLevelNone;
+            elsif Arg = "-O1" then
+               Optimization := CodeGenLevelLess;
+            elsif Arg = "-O2" then
+               Optimization := CodeGenLevelDefault;
+            elsif Arg = "-O3" then
+               Optimization := CodeGenLevelAggressive;
+            elsif Arg = "--emit-llvm" then
+               Output_Kind := Output_Llvm;
+            elsif Arg = "--emit-bc" then
+               Output_Kind := Output_Bytecode;
+            elsif Arg = "--exec" then
+               if Optind + 1 >= Argc then
+                  Put_Line (Standard_Error,
+                            "error: missing function name to '--exec'");
+                  return;
+               end if;
+               Exec_Func := new String'(Argument (Optind + 1));
+               Exec_Val := Integer'Value (Argument (Optind + 2));
+               Optind := Optind + 2;
+            elsif Arg = "-g" then
+               Flag_Debug := True;
+            else
+               --  This is really an argument.
+               declare
+                  procedure Unchecked_Deallocation is
+                     new Ada.Unchecked_Deallocation
+                    (Name => String_Acc, Object => String);
+
+                  Opt : String_Acc := new String'(Arg);
+                  Opt_Arg : String_Acc;
+                  Res : Natural;
+               begin
+                  if Optind < Argument_Count then
+                     Opt_Arg := new String'(Argument (Optind + 1));
+                  else
+                     Opt_Arg := null;
+                  end if;
+                  Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
+                  case Res is
+                     when 0 =>
+                        Put_Line (Standard_Error,
+                                  "unknown option '" & Arg & "'");
+                        return;
+                     when 1 =>
+                        null;
+                     when 2 =>
+                        Optind := Optind + 1;
+                     when others =>
+                        raise Program_Error;
+                  end case;
+                  Unchecked_Deallocation (Opt);
+                  Unchecked_Deallocation (Opt_Arg);
+               end;
+            end if;
+         else
+            First_File := Optind;
+            exit;
+         end if;
+      end;
+      Optind := Optind + 1;
+   end loop;
+
+   --  Link with LLVM libraries.
+   InitializeNativeTarget;
+   InitializeNativeAsmPrinter;
+
+   LinkInJIT;
+
+   Module := ModuleCreateWithName (Module_Name'Address);
+
+   if Output = null and then Exec_Func /= null then
+      -- Now we going to create JIT
+      if CreateExecutionEngineForModule
+        (Engine'Access, Module, Msg'Access) /= 0
+      then
+         Put_Line (Standard_Error,
+                   "cannot create execute: " & To_String (Msg));
+         raise Program_Error;
+      end if;
+
+      Target_Data := GetExecutionEngineTargetData (Engine);
+   else
+      --  Extract target triple
+      Triple := GetDefaultTargetTriple;
+      SetTarget (Module, Triple);
+
+      --  Get Target
+      if GetTargetFromTriple (Triple, Target'Access, Msg'Access) /= 0 then
+         raise Program_Error;
+      end if;
+
+      --  Create a target machine
+      Target_Machine := CreateTargetMachine
+        (Target, Triple, CPU, Features, Optimization, Reloc, CodeModelDefault);
+
+      Target_Data := GetTargetMachineData (Target_Machine);
+   end if;
+
+   SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
+
+   if False then
+      declare
+         Targ : TargetRef;
+      begin
+         Put_Line ("Triple: " & To_String (Triple));
+         New_Line;
+         Put_Line ("Targets:");
+         Targ := GetFirstTarget;
+         while Targ /= Null_TargetRef loop
+            Put_Line (" " & To_String (GetTargetName (Targ))
+                        & ": " & To_String (GetTargetDescription (Targ)));
+            Targ := GetNextTarget (Targ);
+         end loop;
+      end;
+      -- Target_Data := CreateTargetData (Triple);
+   end if;
+
+   Ortho_LLVM.Init;
+
+   Set_Exit_Status (Failure);
+
+   if First_File > Argument_Count then
+      begin
+         if not Parse (null) then
+            return;
+         end if;
+      exception
+         when others =>
+            return;
+      end;
+   else
+      for I in First_File .. Argument_Count loop
+         declare
+            Filename : constant String_Acc :=
+              new String'(Argument (First_File));
+         begin
+            if not Parse (Filename) then
+               return;
+            end if;
+         exception
+            when others =>
+               return;
+         end;
+      end loop;
+   end if;
+
+   if Flag_Debug then
+      Ortho_LLVM.Finish_Debug;
+   end if;
+
+   --  Ortho_Mcode.Finish;
+
+   if Flag_Dump_Llvm then
+      Dump_Llvm;
+   end if;
+
+   --  Verify module.
+   if LLVM.Analysis.VerifyModule
+     (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
+   then
+      DisposeMessage (Msg);
+      raise Program_Error;
+   end if;
+
+   if Optimization > CodeGenLevelNone then
+      declare
+         use LLVM.Transforms.Scalar;
+         Global_Manager : constant Boolean := False;
+         Pass_Manager : PassManagerRef;
+         Res : Bool;
+         pragma Unreferenced (Res);
+         A_Func : ValueRef;
+      begin
+         if Global_Manager then
+            Pass_Manager := CreatePassManager;
+         else
+            Pass_Manager := CreateFunctionPassManagerForModule (Module);
+         end if;
+
+         LLVM.Target.AddTargetData (Target_Data, Pass_Manager);
+         AddPromoteMemoryToRegisterPass (Pass_Manager);
+         AddCFGSimplificationPass (Pass_Manager);
+
+         if Global_Manager then
+            Res := RunPassManager (Pass_Manager, Module);
+         else
+            A_Func := GetFirstFunction (Module);
+            while A_Func /= Null_ValueRef loop
+               Res := RunFunctionPassManager (Pass_Manager, A_Func);
+               A_Func := GetNextFunction (A_Func);
+            end loop;
+         end if;
+      end;
+   end if;
+
+   if Output /= null then
+      declare
+         Error : Boolean;
+      begin
+         Msg := Empty_Cstring;
+
+         case Output_Kind is
+            when Output_Assembly
+              | Output_Object =>
+               Error := LLVM.TargetMachine.TargetMachineEmitToFile
+                 (Target_Machine, Module,
+                  Output.all'Address, Codegen, Msg'Access) /= 0;
+            when Output_Bytecode =>
+               Error := LLVM.BitWriter.WriteBitcodeToFile
+                 (Module, Output.all'Address) /= 0;
+            when Output_Llvm =>
+               Error := PrintModuleToFile
+                 (Module, Output.all'Address, Msg'Access) /= 0;
+         end case;
+         if Error then
+            Put_Line (Standard_Error,
+                      "error while writing to " & Output.all);
+            if Msg /= Empty_Cstring then
+               Put_Line (Standard_Error,
+                         "message: " & To_String (Msg));
+               DisposeMessage (Msg);
+            end if;
+            Set_Exit_Status (2);
+            return;
+         end if;
+      end;
+   elsif Exec_Func /= null then
+      declare
+         use Interfaces;
+         Res : GenericValueRef;
+         Vals : GenericValueRefArray (0 .. 0);
+         Func : aliased ValueRef;
+      begin
+         if FindFunction (Engine, Exec_Func.all'Address, Func'Access) /= 0 then
+            raise Program_Error;
+         end if;
+
+         -- Call the function with argument n:
+         Vals (0) := CreateGenericValueOfInt
+           (Int32Type, Unsigned_64 (Exec_Val), 0);
+         Res := RunFunction (Engine, Func, 1, Vals);
+
+         -- import result of execution
+         Put_Line ("Result is "
+                     & Unsigned_64'Image (GenericValueToInt (Res, 0)));
+
+      end;
+   else
+      Dump_Llvm;
+   end if;
+
+   Set_Exit_Status (Success);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      raise;
+end Ortho_Code_Main;
diff --git a/src/ortho/llvm/ortho_ident.adb b/src/ortho/llvm/ortho_ident.adb
new file mode 100644
index 000000000..e7b650539
--- /dev/null
+++ b/src/ortho/llvm/ortho_ident.adb
@@ -0,0 +1,134 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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.
+
+package body Ortho_Ident is
+   type Chunk (Max : Positive);
+   type Chunk_Acc is access Chunk;
+
+   type Chunk (Max : Positive) is record
+      Prev : Chunk_Acc;
+      Len : Natural := 0;
+      S : String (1 .. Max);
+   end record;
+
+   Cur_Chunk : Chunk_Acc := null;
+
+   subtype Fat_String is String (Positive);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Len : constant Natural := Str'Length;
+      Max : Positive;
+      Org : Positive;
+   begin
+      if Cur_Chunk = null or else Cur_Chunk.Len + Len >= Cur_Chunk.Max then
+         if Cur_Chunk = null then
+            Max := 32 * 1024;
+         else
+            Max := 2 * Cur_Chunk.Max;
+         end if;
+         if Len + 2 > Max then
+            Max := 2 * (Len + 2);
+         end if;
+         declare
+            New_Chunk : Chunk_Acc;
+         begin
+            --  Do not use allocator by expression, as we don't want to
+            --  initialize S.
+            New_Chunk := new Chunk (Max);
+            New_Chunk.Len := 0;
+            New_Chunk.Prev := Cur_Chunk;
+            Cur_Chunk := New_Chunk;
+         end;
+      end if;
+
+      Org := Cur_Chunk.Len + 1;
+      Cur_Chunk.S (Org .. Org + Len - 1) := Str;
+      Cur_Chunk.S (Org + Len) := ASCII.NUL;
+      Cur_Chunk.Len := Org + Len;
+
+      return (Addr => Cur_Chunk.S (Org)'Address);
+   end Get_Identifier;
+
+   function Is_Equal (L, R : O_Ident) return Boolean
+   is
+   begin
+      return L = R;
+   end Is_Equal;
+
+   function Get_String_Length (Id : O_Ident) return Natural
+   is
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return I - 1;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return Str (1 .. I - 1);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Id.Addr;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Istr : Fat_String;
+      pragma Import (Ada, Istr);
+      for Istr'Address use Id.Addr;
+
+      Str_Len : constant Natural := Str'Length;
+   begin
+      for I in Istr'Range loop
+         if Istr (I) = ASCII.NUL then
+            return I - 1 = Str_Len;
+         end if;
+         if I > Str_Len then
+            return False;
+         end if;
+         if Istr (I) /= Str (Str'First + I - 1) then
+            return False;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+end Ortho_Ident;
diff --git a/src/ortho/llvm/ortho_ident.ads b/src/ortho/llvm/ortho_ident.ads
new file mode 100644
index 000000000..7d3955c02
--- /dev/null
+++ b/src/ortho/llvm/ortho_ident.ads
@@ -0,0 +1,42 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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;
+
+package Ortho_Ident is
+   type O_Ident is private;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Is_Equal (L, R : O_Ident) return Boolean;
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+   function Get_String (Id : O_Ident) return String;
+   function Get_String_Length (Id : O_Ident) return Natural;
+
+   --  Note: the address is always valid.
+   function Get_Cstring (Id : O_Ident) return System.Address;
+
+   O_Ident_Nul : constant O_Ident;
+
+private
+   type O_Ident is record
+      Addr : System.Address;
+   end record;
+   O_Ident_Nul : constant O_Ident := (Addr => System.Null_Address);
+
+   pragma Inline (Get_Cstring);
+end Ortho_Ident;
diff --git a/src/ortho/llvm/ortho_jit.adb b/src/ortho/llvm/ortho_jit.adb
new file mode 100644
index 000000000..fdda667d9
--- /dev/null
+++ b/src/ortho/llvm/ortho_jit.adb
@@ -0,0 +1,151 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO; use Ada.Text_IO;
+
+with Ortho_LLVM; use Ortho_LLVM;
+with Ortho_LLVM.Jit;
+
+with LLVM.Core; use LLVM.Core;
+with LLVM.Target; use LLVM.Target;
+--  with LLVM.TargetMachine; use LLVM.TargetMachine;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+with LLVM.Analysis;
+--  with Interfaces;
+with Interfaces.C; use Interfaces.C;
+
+package body Ortho_Jit is
+   --  Snap_Filename : GNAT.OS_Lib.String_Access := null;
+
+   Flag_Dump_Llvm : Boolean := False;
+
+   --  Name of the module.
+   Module_Name : String := "ortho" & Ascii.Nul;
+
+   --  procedure DisableLazyCompilation (EE : ExecutionEngineRef;
+   --                                    Disable : int);
+   --  pragma Import (C, DisableLazyCompilation,
+   --        "LLVMDisableLazyCompilation");
+
+   --  Initialize the whole engine.
+   procedure Init
+   is
+      Msg : aliased Cstring;
+   begin
+      InitializeNativeTarget;
+      InitializeNativeAsmPrinter;
+
+      LinkInJIT;
+
+      Module := ModuleCreateWithName (Module_Name'Address);
+
+      -- Now we going to create JIT
+      if CreateExecutionEngineForModule
+        (Ortho_LLVM.Jit.Engine'Access, Module, Msg'Access) /= 0
+      then
+         Put_Line (Standard_Error, "cannot create execution engine");
+         raise Program_Error;
+      end if;
+
+      Target_Data := GetExecutionEngineTargetData (Ortho_LLVM.Jit.Engine);
+      SetDataLayout (Module, CopyStringRepOfTargetData (Target_Data));
+
+      Ortho_LLVM.Init;
+   end Init;
+
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+     renames Ortho_LLVM.Jit.Set_Address;
+
+   function Get_Address (Decl : O_Dnode) return Address
+     renames Ortho_LLVM.Jit.Get_Address;
+
+   --  procedure InstallLazyFunctionCreator (EE : ExecutionEngineRef;
+   --                                        Func : Address);
+   --  pragma Import (C, InstallLazyFunctionCreator,
+   --                 "LLVMInstallLazyFunctionCreator");
+
+   --  Do link.
+   procedure Link (Status : out Boolean)
+   is
+      use LLVM.Analysis;
+      Msg : aliased Cstring;
+   begin
+      if Flag_Debug then
+         Ortho_LLVM.Finish_Debug;
+      end if;
+
+      if Flag_Dump_Llvm then
+         DumpModule (Module);
+      end if;
+
+      --  Verify module.
+      if LLVM.Analysis.VerifyModule
+        (Module, LLVM.Analysis.PrintMessageAction, Msg'Access) /= 0
+      then
+         DisposeMessage (Msg);
+         Status := False;
+         return;
+      end if;
+
+      --  FIXME: optim
+   end Link;
+
+   procedure Finish
+   is
+      --  F : ValueRef;
+      --  Addr : Address;
+      --  pragma Unreferenced (Addr);
+   begin
+      null;
+
+      --  if No_Lazy then
+      --     --  Be sure all functions code has been generated.
+      --     F := GetFirstFunction (Module);
+      --     while F /= Null_ValueRef loop
+      --        if GetFirstBasicBlock (F) /= Null_BasicBlockRef then
+      --           --  Only care about defined functions.
+      --           Addr := GetPointerToFunction (EE, F);
+      --        end if;
+      --        F := GetNextFunction (F);
+      --     end loop;
+      --  end if;
+   end Finish;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt = "--llvm-dump" then
+         Flag_Dump_Llvm := True;
+         return True;
+      end if;
+      return False;
+   end Decode_Option;
+
+   procedure Disp_Help is
+   begin
+      null;
+   end Disp_Help;
+
+   function Get_Jit_Name return String is
+   begin
+      return "LLVM";
+   end Get_Jit_Name;
+
+end Ortho_Jit;
diff --git a/src/ortho/llvm/ortho_llvm-jit.adb b/src/ortho/llvm/ortho_llvm-jit.adb
new file mode 100644
index 000000000..9155a02c7
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm-jit.adb
@@ -0,0 +1,55 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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.
+
+package body Ortho_LLVM.Jit is
+   --  procedure AddExternalFunction (Name : Cstring; Val : Address);
+   --  pragma Import (C, AddExternalFunction, "ortho_AddExternalFunction");
+
+   function GetPointerToFunction (EE : ExecutionEngineRef; Func : ValueRef)
+                                 return Address;
+   pragma Import (C, GetPointerToFunction, "LLVMGetPointerToFunction");
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address) is
+   begin
+      case Decl.Kind is
+         when ON_Var_Decl | ON_Const_Decl =>
+            AddGlobalMapping (Engine, Decl.LLVM, Addr);
+         when ON_Subprg_Decl =>
+            null;
+            --  AddExternalFunction (GetValueName (Decl.LLVM), Addr);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+   is
+   begin
+      case Decl.Kind is
+         when ON_Var_Decl | ON_Const_Decl =>
+            return GetPointerToGlobal (Engine, Decl.LLVM);
+         when ON_Subprg_Decl =>
+            return GetPointerToFunction (Engine, Decl.LLVM);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_Address;
+
+end Ortho_LLVM.Jit;
diff --git a/src/ortho/llvm/ortho_llvm-jit.ads b/src/ortho/llvm/ortho_llvm-jit.ads
new file mode 100644
index 000000000..5296e2ed8
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm-jit.ads
@@ -0,0 +1,31 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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; use System;
+with LLVM.ExecutionEngine; use LLVM.ExecutionEngine;
+
+package Ortho_LLVM.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+
+   --  Execution engine
+   Engine : aliased ExecutionEngineRef;
+
+end Ortho_LLVM.Jit;
diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb
new file mode 100644
index 000000000..dd8e64971
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.adb
@@ -0,0 +1,2881 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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 Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with LLVM.Target; use LLVM.Target;
+with GNAT.Directory_Operations;
+
+package body Ortho_LLVM is
+   --  The current function for LLVM (needed to add new basic blocks).
+   Cur_Func : ValueRef;
+
+   --  The current function node (needed for return type).
+   Cur_Func_Decl : O_Dnode;
+
+   --  Wether the code is currently unreachable.  LLVM doesn't accept basic
+   --  blocks that cannot be reached (using trivial rules).  So we need to
+   --  discard instructions after a return, a next or an exit statement.
+   Unreach : Boolean;
+
+   --  Builder for statements.
+   Builder : BuilderRef;
+
+   --  Builder for declarations (local variables).
+   Decl_Builder : BuilderRef;
+
+   --  Temporary builder.
+   Extra_Builder : BuilderRef;
+
+   --  Declaration of llvm.dbg.declare
+   Llvm_Dbg_Declare : ValueRef;
+
+   Debug_ID : unsigned;
+
+   Current_Directory : constant String :=
+     GNAT.Directory_Operations.Get_Current_Dir;
+
+   --  Additional data for declare blocks.
+   type Declare_Block_Type;
+   type Declare_Block_Acc is access Declare_Block_Type;
+
+   type Declare_Block_Type is record
+      --  First basic block of the declare.
+      Stmt_Bb : BasicBlockRef;
+
+      --  Stack pointer at entry of the block.  This value has to be restore
+      --  when leaving the block (either normally or via exit/next).  Set only
+      --  if New_Alloca was used.
+      --  FIXME: TODO: restore stack pointer on exit/next stmts.
+      Stack_Value : ValueRef;
+
+      --  Debug data for the scope of the declare block.
+      Dbg_Scope : ValueRef;
+
+      --  Previous element in the stack.
+      Prev : Declare_Block_Acc;
+   end record;
+
+   --  Current declare block.
+   Cur_Declare_Block : Declare_Block_Acc;
+
+   --  Chain of unused blocks to be recycled.
+   Old_Declare_Block : Declare_Block_Acc;
+
+   Stacksave_Fun : ValueRef;
+   Stacksave_Name : constant String := "llvm.stacksave" & ASCII.NUL;
+   Stackrestore_Fun : ValueRef;
+   Stackrestore_Name : constant String := "llvm.stackrestore" & ASCII.NUL;
+
+   --  For debugging
+
+   DW_Version : constant := 16#c_0000#;
+   DW_TAG_Array_Type       : constant := DW_Version + 16#01#;
+   DW_TAG_Enumeration_Type : constant := DW_Version + 16#04#;
+   DW_TAG_Lexical_Block    : constant := DW_Version + 16#0b#;
+   DW_TAG_Member           : constant := DW_Version + 16#0d#;
+   DW_TAG_Pointer_Type     : constant := DW_Version + 16#0f#;
+   DW_TAG_Compile_Unit     : constant := DW_Version + 16#11#;
+   DW_TAG_Structure_Type   : constant := DW_Version + 16#13#;
+   DW_TAG_Subroutine_Type  : constant := DW_Version + 16#15#;
+   DW_TAG_Subrange_Type    : constant := DW_Version + 16#21#;
+   DW_TAG_Base_Type        : constant := DW_Version + 16#24#;
+   DW_TAG_Enumerator       : constant := DW_Version + 16#28#;
+   DW_TAG_File_Type        : constant := DW_Version + 16#29#;
+   DW_TAG_Subprogram       : constant := DW_Version + 16#2e#;
+   DW_TAG_Variable         : constant := DW_Version + 16#34#;
+
+   DW_TAG_Auto_Variable    : constant := DW_Version + 16#100#;
+   DW_TAG_Arg_Variable     : constant := DW_Version + 16#101#;
+
+   DW_ATE_address  : constant := 16#01#;
+   DW_ATE_boolean  : constant := 16#02#;
+   DW_ATE_float    : constant := 16#04#;
+   DW_ATE_signed   : constant := 16#05#;
+   DW_ATE_unsigned : constant := 16#07#;
+   pragma Unreferenced (DW_ATE_address, DW_ATE_boolean);
+
+   --  File + Dir metadata
+   Dbg_Current_Filedir : ValueRef;
+   Dbg_Current_File : ValueRef; -- The DW_TAG_File_Type
+
+   Dbg_Current_Line : unsigned := 0;
+
+   Dbg_Current_Scope : ValueRef;
+   Scope_Uniq_Id : Unsigned_64 := 0;
+
+   --  Metadata for the instruction
+   Dbg_Insn_MD : ValueRef;
+   Dbg_Insn_MD_Line : unsigned := 0;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (ValueRefArray, ValueRefArray_Acc);
+
+   package Dbg_Utils is
+      type Dyn_MDNode is private;
+
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef);
+      function Get_Value (D : Dyn_MDNode) return ValueRef;
+
+      --  Reset D.  FIXME: should be done automatically within Get_Value.
+      procedure Clear (D : out Dyn_MDNode);
+   private
+      Chunk_Length : constant unsigned := 32;
+      type MD_Chunk;
+      type MD_Chunk_Acc is access MD_Chunk;
+
+      type MD_Chunk is record
+         Vals : ValueRefArray (1 .. Chunk_Length);
+         Next : MD_Chunk_Acc;
+      end record;
+
+      type Dyn_MDNode is record
+         First : MD_Chunk_Acc;
+         Last : MD_Chunk_Acc;
+         Nbr : unsigned := 0;
+      end record;
+   end Dbg_Utils;
+
+   package body Dbg_Utils is
+      procedure Append (D : in out Dyn_MDNode; Val : ValueRef) is
+         Chunk : MD_Chunk_Acc;
+         Pos : constant unsigned := D.Nbr rem Chunk_Length;
+      begin
+         if Pos = 0 then
+            Chunk := new MD_Chunk;
+            if D.First = null then
+               D.First := Chunk;
+            else
+               D.Last.Next := Chunk;
+            end if;
+            D.Last := Chunk;
+         else
+            Chunk := D.Last;
+         end if;
+         Chunk.Vals (Pos + 1) := Val;
+         D.Nbr := D.Nbr + 1;
+      end Append;
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (MD_Chunk, MD_Chunk_Acc);
+
+      function Get_Value (D : Dyn_MDNode) return ValueRef
+      is
+         Vals : ValueRefArray (1 .. D.Nbr);
+         Pos : unsigned;
+         Chunk : MD_Chunk_Acc := D.First;
+         Next_Chunk : MD_Chunk_Acc;
+         Nbr : constant unsigned := D.Nbr;
+      begin
+         Pos := 0;
+         --  Copy by chunks
+         while Pos + Chunk_Length < Nbr loop
+            Vals (Pos + 1 .. Pos + Chunk_Length) := Chunk.Vals;
+            Pos := Pos + Chunk_Length;
+            Next_Chunk := Chunk.Next;
+            Free (Chunk);
+            Chunk := Next_Chunk;
+         end loop;
+         --  Last chunk
+         if Pos < Nbr then
+            Vals (Pos + 1 .. Pos + Nbr - Pos) := Chunk.Vals (1 .. Nbr - Pos);
+            Free (Chunk);
+         end if;
+         return MDNode (Vals, Vals'Length);
+      end Get_Value;
+
+      procedure Clear (D : out Dyn_MDNode) is
+      begin
+         D := (null, null, 0);
+      end Clear;
+   end Dbg_Utils;
+
+   use Dbg_Utils;
+
+   --  List of debug info for subprograms.
+   Subprg_Nodes: Dyn_MDNode;
+
+   --  List of literals for enumerated type
+   Enum_Nodes : Dyn_MDNode;
+
+   --  List of global variables
+   Global_Nodes : Dyn_MDNode;
+
+   --  Create a MDString from an Ada string.
+   function MDString (Str : String) return ValueRef is
+   begin
+      return MDString (Str'Address, Str'Length);
+   end MDString;
+
+   function MDString (Id : O_Ident) return ValueRef is
+   begin
+      return MDString (Get_Cstring (Id), unsigned (Get_String_Length (Id)));
+   end MDString;
+
+   function Dbg_Size (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt (Int64Type, 8 * ABISizeOfType (Target_Data, Atype), 0);
+   end Dbg_Size;
+
+   function Dbg_Align (Atype : TypeRef) return ValueRef is
+   begin
+      return ConstInt
+        (Int64Type,
+         Unsigned_64 (8 * ABIAlignmentOfType (Target_Data, Atype)), 0);
+   end Dbg_Align;
+
+   function Dbg_Line return ValueRef is
+   begin
+      return ConstInt (Int32Type, Unsigned_64 (Dbg_Current_Line), 0);
+   end Dbg_Line;
+
+   --  Set debug metadata on instruction INSN.
+   --  FIXME: check if INSN is really an instruction
+   procedure Set_Insn_Dbg (Insn : ValueRef) is
+   begin
+      if Flag_Debug then
+         if Dbg_Current_Line /= Dbg_Insn_MD_Line then
+            declare
+               Vals : ValueRefArray (0 .. 3);
+            begin
+               Vals := (Dbg_Line,
+                        ConstInt (Int32Type, 0, 0), --  col
+                        Dbg_Current_Scope,          --  context
+                        Null_ValueRef);             --  inline
+               Dbg_Insn_MD := MDNode (Vals, Vals'Length);
+               Dbg_Insn_MD_Line := Dbg_Current_Line;
+            end;
+         end if;
+         SetMetadata (Insn, Debug_ID, Dbg_Insn_MD);
+      end if;
+   end Set_Insn_Dbg;
+
+   procedure Dbg_Create_Variable (Tag : Unsigned_32;
+                                  Ident : O_Ident;
+                                  Vtype : O_Tnode;
+                                  Argno : Natural;
+                                  Addr : ValueRef)
+   is
+      Vals : ValueRefArray (0 .. 7);
+      Str : constant ValueRef := MDString (Ident);
+      Call_Vals : ValueRefArray (0 .. 1);
+      Call : ValueRef;
+   begin
+      Vals := (ConstInt (Int32Type, Unsigned_64 (Tag), 0),
+               Dbg_Current_Scope,
+               Str,
+               Dbg_Current_File,
+               ConstInt (Int32Type,
+                         Unsigned_64 (Dbg_Current_Line)
+                           + Unsigned_64 (Argno) * 2 ** 24, 0),
+               Vtype.Dbg,
+               ConstInt (Int32Type, 0, 0), --  flags
+               ConstInt (Int32Type, 0, 0));
+
+      Call_Vals := (MDNode ((0 => Addr), 1),
+                    MDNode (Vals, Vals'Length));
+      Call := BuildCall (Decl_Builder, Llvm_Dbg_Declare,
+                         Call_Vals, Call_Vals'Length, Empty_Cstring);
+      Set_Insn_Dbg (Call);
+   end Dbg_Create_Variable;
+
+   procedure Create_Declare_Block
+   is
+      Res : Declare_Block_Acc;
+   begin
+      --  Try to recycle an unused record.
+      if Old_Declare_Block /= null then
+         Res := Old_Declare_Block;
+         Old_Declare_Block := Res.Prev;
+      else
+         --  Create a new one if no unused records.
+         Res := new Declare_Block_Type;
+      end if;
+
+      --  Chain.
+      Res.all := (Stmt_Bb => Null_BasicBlockRef,
+                  Stack_Value => Null_ValueRef,
+                  Dbg_Scope => Null_ValueRef,
+                  Prev => Cur_Declare_Block);
+      Cur_Declare_Block := Res;
+
+      if not Unreach then
+         Res.Stmt_Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      end if;
+   end Create_Declare_Block;
+
+   procedure Destroy_Declare_Block
+   is
+      Blk : constant Declare_Block_Acc := Cur_Declare_Block;
+   begin
+      --  Unchain.
+      Cur_Declare_Block := Blk.Prev;
+
+      --  Put on the recyle list.
+      Blk.Prev := Old_Declare_Block;
+      Old_Declare_Block := Blk;
+   end Destroy_Declare_Block;
+
+   -----------------------
+   -- Start_Record_Type --
+   -----------------------
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Record_Type;
+
+   ----------------------
+   -- New_Record_Field --
+   ----------------------
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      O_El : O_Element_Acc;
+   begin
+      El := (Kind => OF_Record,
+             Index => Elements.Nbr_Elements,
+             Ftype => Etype);
+      Elements.Nbr_Elements := Elements.Nbr_Elements + 1;
+      O_El := new O_Element'(Next => null,
+                             Etype => Etype,
+                             Ident => Ident);
+      if Elements.First_Elem = null then
+         Elements.First_Elem := O_El;
+      else
+         Elements.Last_Elem.Next := O_El;
+      end if;
+      Elements.Last_Elem := O_El;
+   end New_Record_Field;
+
+   ------------------------
+   -- Finish_Record_Type --
+   ------------------------
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (O_Element, O_Element_Acc);
+
+      Count : constant unsigned := unsigned (Elements.Nbr_Elements);
+      El : O_Element_Acc;
+      Next_El : O_Element_Acc;
+      Types : TypeRefArray (1 .. Count);
+   begin
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Types (I) := Get_LLVM_Type (El.Etype);
+         El := El.Next;
+      end loop;
+
+      if Elements.Rec_Type /= null then
+         --  Completion
+         StructSetBody (Elements.Rec_Type.LLVM, Types, Count, 0);
+         Res := Elements.Rec_Type;
+      else
+         Res := new O_Tnode_Type'(Kind => ON_Record_Type,
+                                  LLVM => StructType (Types, Count, 0),
+                                  Dbg => Null_ValueRef);
+      end if;
+
+      if Flag_Debug then
+         declare
+            Fields : ValueRefArray (1 .. Count);
+            Vals : ValueRefArray (0 .. 9);
+            Ftype : TypeRef;
+            Fields_Arr : ValueRef;
+         begin
+            El := Elements.First_Elem;
+            for I in Fields'Range loop
+               Ftype := Get_LLVM_Type (El.Etype);
+               Vals :=
+                 (ConstInt (Int32Type, DW_TAG_Member, 0),
+                  Dbg_Current_File,
+                  Null_ValueRef,
+                  MDString (El.Ident),
+                  ConstInt (Int32Type, 0, 0),    -- linenum
+                  Dbg_Size (Ftype),
+                  Dbg_Align (Ftype),
+                  ConstInt
+                    (Int32Type,
+                     8 * OffsetOfElement (Target_Data,
+                                          Res.LLVM, Unsigned_32 (I - 1)), 0),
+                  ConstInt (Int32Type, 0, 0),    --  Flags
+                  El.Etype.Dbg);
+               Fields (I) := MDNode (Vals, Vals'Length);
+               El := El.Next;
+            end loop;
+            Fields_Arr := MDNode (Fields, Fields'Length);
+            if Elements.Rec_Type /= null then
+               --  Completion
+               MDNodeReplaceOperandWith (Res.Dbg, 10, Fields_Arr);
+               MDNodeReplaceOperandWith (Res.Dbg, 5, Dbg_Size (Res.LLVM));
+               MDNodeReplaceOperandWith (Res.Dbg, 6, Dbg_Align (Res.LLVM));
+            else
+               --  Temporary borrowed.
+               Res.Dbg := Fields_Arr;
+            end if;
+         end;
+      end if;
+
+      --  Free elements
+      El := Elements.First_Elem;
+      for I in Types'Range loop
+         Next_El := El.Next;
+         Free (El);
+         El := Next_El;
+      end loop;
+   end Finish_Record_Type;
+
+   --------------------------------
+   -- New_Uncomplete_Record_Type --
+   --------------------------------
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      --  LLVM type will be created when the type is declared.
+      Res := new O_Tnode_Type'(Kind => ON_Incomplete_Record_Type,
+                               LLVM => Null_TypeRef,
+                               Dbg => Null_ValueRef);
+   end New_Uncomplete_Record_Type;
+
+   ----------------------------------
+   -- Start_Uncomplete_Record_Type --
+   ----------------------------------
+
+   procedure Start_Uncomplete_Record_Type
+     (Res : O_Tnode;
+      Elements : out O_Element_List)
+   is
+   begin
+      if Res.Kind /= ON_Incomplete_Record_Type then
+         raise Program_Error;
+      end if;
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => Res,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Uncomplete_Record_Type;
+
+   ----------------------
+   -- Start_Union_Type --
+   ----------------------
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Elements := (Nbr_Elements => 0,
+                   Rec_Type => O_Tnode_Null,
+                   Size => 0,
+                   Align => 0,
+                   Align_Type => Null_TypeRef,
+                   First_Elem => null,
+                   Last_Elem => null);
+   end Start_Union_Type;
+
+   ---------------------
+   -- New_Union_Field --
+   ---------------------
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      pragma Unreferenced (Ident);
+
+      El_Type : constant TypeRef := Get_LLVM_Type (Etype);
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, El_Type));
+      Align : constant Unsigned_32 :=
+        ABIAlignmentOfType (Target_Data, El_Type);
+   begin
+      El := (Kind => OF_Union, Utype => El_Type, Ftype => Etype);
+      if Size > Elements.Size then
+         Elements.Size := Size;
+      end if;
+      if Elements.Align_Type = Null_TypeRef or else Align > Elements.Align then
+         Elements.Align := Align;
+         Elements.Align_Type := El_Type;
+      end if;
+   end New_Union_Field;
+
+   -----------------------
+   -- Finish_Union_Type --
+   -----------------------
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List;
+      Res : out O_Tnode)
+   is
+      Count : unsigned;
+      Types : TypeRefArray (1 .. 2);
+      Pad : unsigned;
+   begin
+      if Elements.Align_Type = Null_TypeRef then
+         --  An empty union.  Is it allowed ?
+         Count := 0;
+      else
+         --  The first element is the field with the biggest alignment
+         Types (1) := Elements.Align_Type;
+         --  Possibly complete with an array of bytes.
+         Pad := Elements.Size
+           - unsigned (ABISizeOfType (Target_Data, Elements.Align_Type));
+         if Pad /= 0 then
+            Types (2) := ArrayType (Int8Type, Pad);
+            Count := 2;
+         else
+            Count := 1;
+         end if;
+      end if;
+      Res := new O_Tnode_Type'(Kind => ON_Union_Type,
+                               LLVM => StructType (Types, Count, 0),
+                               Dbg => Null_ValueRef,
+                               Un_Size => Elements.Size,
+                               Un_Main_Field => Elements.Align_Type);
+   end Finish_Union_Type;
+
+   ---------------------
+   -- New_Access_Type --
+   ---------------------
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode is
+   begin
+      if Dtype = O_Tnode_Null then
+         --  LLVM type will be built by New_Type_Decl, so that the name
+         --  can be used for the structure.
+         return new O_Tnode_Type'(Kind => ON_Incomplete_Access_Type,
+                                  LLVM => Null_TypeRef,
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => O_Tnode_Null);
+      else
+         return new O_Tnode_Type'(Kind => ON_Access_Type,
+                                  LLVM => PointerType (Get_LLVM_Type (Dtype)),
+                                  Dbg => Null_ValueRef,
+                                  Acc_Type => Dtype);
+      end if;
+   end New_Access_Type;
+
+   ------------------------
+   -- Finish_Access_Type --
+   ------------------------
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode)
+   is
+      Types : TypeRefArray (1 .. 1);
+   begin
+      if Atype.Kind /= ON_Incomplete_Access_Type then
+         --  Not an incomplete access type.
+         raise Program_Error;
+      end if;
+      if Atype.Acc_Type /= O_Tnode_Null then
+         --  Already completed.
+         raise Program_Error;
+      end if;
+      --  Completion
+      Types (1) := Get_LLVM_Type (Dtype);
+      StructSetBody (GetElementType (Atype.LLVM), Types, Types'Length, 0);
+      Atype.Acc_Type := Dtype;
+
+      --  Debug.
+      --  FIXME.
+   end Finish_Access_Type;
+
+   --------------------
+   -- New_Array_Type --
+   --------------------
+
+   function Dbg_Array (El_Type : O_Tnode; Len : ValueRef; Atype : O_Tnode)
+                      return ValueRef
+   is
+      Rng : ValueRefArray (0 .. 2);
+      Rng_Arr : ValueRefArray (0 .. 0);
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Rng := (ConstInt (Int32Type, DW_TAG_Subrange_Type, 0),
+              ConstInt (Int64Type, 0, 0), -- Lo
+              Len); -- Count
+      Rng_Arr := (0 => MDNode (Rng, Rng'Length));
+      Vals := (ConstInt (Int32Type, DW_TAG_Array_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,           --  context
+               Null_ValueRef,
+               ConstInt (Int32Type, 0, 0), -- line
+               Dbg_Size (Atype.LLVM),
+               Dbg_Align (Atype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               El_Type.Dbg, --  element type
+               MDNode (Rng_Arr, Rng_Arr'Length), -- subscript
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      return MDNode (Vals, Vals'Length);
+   end Dbg_Array;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode
+   is
+      pragma Unreferenced (Index_Type);
+      Res : O_Tnode;
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Type,
+         LLVM => ArrayType (Get_LLVM_Type (El_Type), 0),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (El_Type, ConstInt (Int64Type, Unsigned_64'Last, 1), Res);
+      end if;
+
+      return Res;
+   end New_Array_Type;
+
+   --------------------------------
+   -- New_Constrained_Array_Type --
+   --------------------------------
+
+   function New_Constrained_Array_Type
+     (Atype : O_Tnode; Length : O_Cnode) return O_Tnode
+   is
+      Res : O_Tnode;
+      Len : constant unsigned := unsigned (ConstIntGetZExtValue (Length.LLVM));
+   begin
+      Res := new O_Tnode_Type'
+        (Kind => ON_Array_Sub_Type,
+         LLVM => ArrayType (GetElementType (Get_LLVM_Type (Atype)), Len),
+         Dbg => Null_ValueRef,
+         Arr_El_Type => Atype.Arr_El_Type);
+
+      if Flag_Debug then
+         Res.Dbg := Dbg_Array
+           (Atype.Arr_El_Type,
+            ConstInt (Int64Type, Unsigned_64 (Len), 0), Res);
+      end if;
+
+      return Res;
+   end New_Constrained_Array_Type;
+
+   -----------------------
+   -- New_Unsigned_Type --
+   -----------------------
+
+   function Size_To_Llvm (Size : Natural) return TypeRef is
+      Llvm : TypeRef;
+   begin
+      case Size is
+         when 8 =>
+            Llvm := Int8Type;
+         when 32 =>
+            Llvm := Int32Type;
+         when 64 =>
+            Llvm := Int64Type;
+         when others =>
+            raise Program_Error;
+      end case;
+      return Llvm;
+   end Size_To_Llvm;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Unsigned_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Unsigned_Type;
+
+   ---------------------
+   -- New_Signed_Type --
+   ---------------------
+
+   function New_Signed_Type (Size : Natural) return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Signed_Type,
+                               LLVM => Size_To_Llvm (Size),
+                               Dbg => Null_ValueRef,
+                               Scal_Size => Size);
+   end New_Signed_Type;
+
+   --------------------
+   -- New_Float_Type --
+   --------------------
+
+   function New_Float_Type return O_Tnode is
+   begin
+      return new O_Tnode_Type'(Kind => ON_Float_Type,
+                               LLVM => DoubleType,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 64);
+   end New_Float_Type;
+
+   procedure Dbg_Add_Enumeration (Id : O_Ident; Val : Unsigned_64) is
+      Vals : ValueRefArray (0 .. 2);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumerator, 0),
+               MDString (Id),
+               ConstInt (Int64Type, Val, 0));
+      --  FIXME: make it local to List ?
+      Append (Enum_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Enumeration;
+
+   ----------------------
+   -- New_Boolean_Type --
+   ----------------------
+
+   procedure New_Boolean_Type
+     (Res : out O_Tnode;
+      False_Id : O_Ident; False_E : out O_Cnode;
+      True_Id : O_Ident; True_E : out O_Cnode)
+   is
+   begin
+      Res := new O_Tnode_Type'(Kind => ON_Boolean_Type,
+                               LLVM => Int1Type,
+                               Dbg => Null_ValueRef,
+                               Scal_Size => 1);
+      False_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 0, 0),
+                          Ctype => Res);
+      True_E := O_Cnode'(LLVM => ConstInt (Res.LLVM, 1, 0),
+                         Ctype => Res);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (False_Id, 0);
+         Dbg_Add_Enumeration (True_Id, 1);
+      end if;
+   end New_Boolean_Type;
+
+   ---------------------
+   -- Start_Enum_Type --
+   ---------------------
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      LLVM : constant TypeRef := Size_To_Llvm (Size);
+   begin
+      List := (LLVM => LLVM,
+               Num => 0,
+               Etype => new O_Tnode_Type'(Kind => ON_Enum_Type,
+                                          LLVM => LLVM,
+                                          Scal_Size => Size,
+                                          Dbg => Null_ValueRef));
+
+   end Start_Enum_Type;
+
+   ----------------------
+   -- New_Enum_Literal --
+   ----------------------
+
+   procedure New_Enum_Literal
+     (List : in out O_Enum_List; Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := O_Cnode'(LLVM => ConstInt (List.LLVM, Unsigned_64 (List.Num), 0),
+                      Ctype => List.Etype);
+      if Flag_Debug then
+         Dbg_Add_Enumeration (Ident, Unsigned_64 (List.Num));
+      end if;
+
+      List.Num := List.Num + 1;
+   end New_Enum_Literal;
+
+   ----------------------
+   -- Finish_Enum_Type --
+   ----------------------
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Etype;
+   end Finish_Enum_Type;
+
+   ------------------------
+   -- New_Signed_Literal --
+   ------------------------
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode
+   is
+      function To_Unsigned_64 is new Ada.Unchecked_Conversion
+        (Integer_64, Unsigned_64);
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype),
+                                        To_Unsigned_64 (Value), 1),
+                     Ctype => Ltype);
+   end New_Signed_Literal;
+
+   --------------------------
+   -- New_Unsigned_Literal --
+   --------------------------
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstInt (Get_LLVM_Type (Ltype), Value, 0),
+                      Ctype => Ltype);
+   end New_Unsigned_Literal;
+
+   -----------------------
+   -- New_Float_Literal --
+   -----------------------
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstReal (Get_LLVM_Type (Ltype),
+                                         Interfaces.C.double (Value)),
+                      Ctype => Ltype);
+   end New_Float_Literal;
+
+   ---------------------
+   -- New_Null_Access --
+   ---------------------
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstNull (Get_LLVM_Type (Ltype)),
+                      Ctype => Ltype);
+   end New_Null_Access;
+
+   -----------------------
+   -- Start_Record_Aggr --
+   -----------------------
+
+   procedure Start_Record_Aggr
+     (List : out O_Record_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List :=
+        (Len => 0,
+         Vals => new ValueRefArray (1 .. CountStructElementTypes (Llvm)),
+         Atype => Atype);
+   end Start_Record_Aggr;
+
+   ------------------------
+   -- New_Record_Aggr_El --
+   ------------------------
+
+   procedure New_Record_Aggr_El
+     (List : in out O_Record_Aggr_List; Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Record_Aggr_El;
+
+   ------------------------
+   -- Finish_Record_Aggr --
+   ------------------------
+
+   procedure Finish_Record_Aggr
+     (List : in out O_Record_Aggr_List;
+      Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstStruct (List.Vals.all, List.Len, 0),
+              Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Record_Aggr;
+
+   ----------------------
+   -- Start_Array_Aggr --
+   ----------------------
+
+   procedure Start_Array_Aggr
+     (List : out O_Array_Aggr_List;
+      Atype : O_Tnode)
+   is
+      Llvm : constant TypeRef := Get_LLVM_Type (Atype);
+   begin
+      List := (Len => 0,
+               Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)),
+               El_Type => GetElementType (Llvm),
+               Atype => Atype);
+   end Start_Array_Aggr;
+
+   -----------------------
+   -- New_Array_Aggr_El --
+   -----------------------
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+   begin
+      List.Len := List.Len + 1;
+      List.Vals (List.Len) := Value.LLVM;
+   end New_Array_Aggr_El;
+
+   -----------------------
+   -- Finish_Array_Aggr --
+   -----------------------
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode)
+   is
+   begin
+      Res := (LLVM => ConstArray (List.El_Type,
+                                  List.Vals.all, List.Len),
+             Ctype => List.Atype);
+      Free (List.Vals);
+   end Finish_Array_Aggr;
+
+   --------------------
+   -- New_Union_Aggr --
+   --------------------
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      Values : ValueRefArray (1 .. 2);
+      Count : unsigned;
+      Size : constant unsigned :=
+        unsigned (ABISizeOfType (Target_Data, Field.Utype));
+
+   begin
+      Values (1) := Value.LLVM;
+      if Size < Atype.Un_Size then
+         Values (2) := GetUndef (ArrayType (Int8Type, Atype.Un_Size - Size));
+         Count := 2;
+      else
+         Count := 1;
+      end if;
+
+      --  If `FIELD` is the main field of the union, create a struct using
+      --  the same type as the union (and possibly pad).
+      if Field.Utype = Atype.Un_Main_Field then
+         return O_Cnode'
+           (LLVM => ConstNamedStruct (Atype.LLVM, Values, Count),
+            Ctype => Atype);
+      else
+         --  Create an on-the-fly record.
+         return O_Cnode'(LLVM => ConstStruct (Values, Count, 0),
+                         Ctype => Atype);
+      end if;
+   end New_Union_Aggr;
+
+   ----------------
+   -- New_Sizeof --
+   ----------------
+
+   --  Return VAL with type RTYPE (either unsigned or access)
+   function Const_To_Cnode (Rtype : O_Tnode; Val : Unsigned_64) return O_Cnode
+   is
+      Tmp : ValueRef;
+   begin
+      case Rtype.Kind is
+         when ON_Scalar_Types =>
+            --  Well, unsigned in fact.
+            return O_Cnode'(LLVM => ConstInt (Rtype.LLVM, Val, 0),
+                            Ctype => Rtype);
+         when ON_Access_Type =>
+            Tmp := ConstInt (Int64Type, Val, 0);
+            return O_Cnode'(LLVM => ConstIntToPtr (Tmp, Rtype.LLVM),
+                            Ctype => Rtype);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Const_To_Cnode;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype, ABISizeOfType (Target_Data, Get_LLVM_Type (Atype)));
+   end New_Sizeof;
+
+   -----------------
+   -- New_Alignof --
+   -----------------
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         Unsigned_64
+           (ABIAlignmentOfType (Target_Data, Get_LLVM_Type (Atype))));
+   end New_Alignof;
+
+   ------------------
+   -- New_Offsetof --
+   ------------------
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      return Const_To_Cnode
+        (Rtype,
+         OffsetOfElement (Target_Data,
+                          Get_LLVM_Type (Atype),
+                          Unsigned_32 (Field.Index)));
+   end New_Offsetof;
+
+   ----------------------------
+   -- New_Subprogram_Address --
+   ----------------------------
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode is
+   begin
+      return O_Cnode'
+        (LLVM => ConstBitCast (Subprg.LLVM, Get_LLVM_Type (Atype)),
+         Ctype => Atype);
+   end New_Subprogram_Address;
+
+   ------------------------
+   -- New_Global_Address --
+   ------------------------
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Address;
+
+   ----------------------------------
+   -- New_Global_Unchecked_Address --
+   ----------------------------------
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+   begin
+      return O_Cnode'(LLVM => ConstBitCast (Decl.LLVM, Get_LLVM_Type (Atype)),
+                      Ctype => Atype);
+   end New_Global_Unchecked_Address;
+
+   -------------
+   -- New_Lit --
+   -------------
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode'(LLVM => Lit.LLVM,
+                      Etype => Lit.Ctype);
+   end New_Lit;
+
+   -------------------
+   -- New_Dyadic_Op --
+   -------------------
+
+   function New_Smod (L, R : ValueRef; Res_Type : TypeRef)
+                     return ValueRef
+   is
+      Cond : ValueRef;
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+
+      --  The result of 'L rem R'.
+      Rm : ValueRef;
+
+      --  Rm + R
+      Rm_Plus_R : ValueRef;
+
+      --  The result of 'L xor R'.
+      R_Xor : ValueRef;
+
+      Adj : ValueRef;
+      Phi : ValueRef;
+
+      --  Basic basic for the non-overflow branch
+      Normal_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Adjust_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      --  Basic block after the result
+      Next_Bb : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+      Vals : ValueRefArray (1 .. 3);
+      BBs  : BasicBlockRefArray (1 .. 3);
+   begin
+      --  Avoid overflow with -1:
+      --   if R = -1 then
+      --     result := 0;
+      --   else
+      --     ...
+      Cond := BuildICmp
+        (Builder, IntEQ, R, ConstAllOnes (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Normal_Bb);
+      Vals (1) := ConstNull (Res_Type);
+      BBs (1) := GetInsertBlock (Builder);
+
+      --  Rm := Left rem Right
+      PositionBuilderAtEnd (Builder, Normal_Bb);
+      Rm := BuildSRem (Builder, L, R, Empty_Cstring);
+
+      --  if R = 0 then
+      --    result := 0
+      --  else
+      Cond := BuildICmp
+        (Builder, IntEQ, Rm, ConstNull (Res_Type), Empty_Cstring);
+      Br := BuildCondBr (Builder, Cond, Next_Bb, Adjust_Bb);
+      Vals (2) := ConstNull (Res_Type);
+      BBs (2) := Normal_Bb;
+
+      --  if L xor R < 0 then
+      --    result := Rm + R
+      --  else
+      --    result := Rm;
+      --  end if;
+      PositionBuilderAtEnd (Builder, Adjust_Bb);
+      R_Xor := BuildXor (Builder, L, R, Empty_Cstring);
+      Cond := BuildICmp
+        (Builder, IntSLT, R_Xor, ConstNull (Res_Type), Empty_Cstring);
+      Rm_Plus_R := BuildAdd (Builder, Rm, R, Empty_Cstring);
+      Adj := BuildSelect (Builder, Cond, Rm_Plus_R, Rm, Empty_Cstring);
+      Br := BuildBr (Builder, Next_Bb);
+      Vals (3) := Adj;
+      BBs (3) := Adjust_Bb;
+
+      --  The Phi node
+      PositionBuilderAtEnd (Builder, Next_Bb);
+      Phi := BuildPhi (Builder, Res_Type, Empty_Cstring);
+      AddIncoming (Phi, Vals, BBs, Vals'Length);
+
+      return Phi;
+   end New_Smod;
+
+   type Dyadic_Builder_Acc is access
+     function (Builder : BuilderRef;
+               LHS : ValueRef; RHS : ValueRef; Name : Cstring)
+              return ValueRef;
+   pragma Convention (C, Dyadic_Builder_Acc);
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode
+   is
+      Build : Dyadic_Builder_Acc := null;
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Unreach then
+         return O_Enode'(LLVM => Null_ValueRef, Etype => Left.Etype);
+      end if;
+
+      case Left.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_And =>
+                  Build := BuildAnd'Access;
+               when ON_Or =>
+                  Build := BuildOr'Access;
+               when ON_Xor =>
+                  Build := BuildXor'Access;
+
+               when ON_Add_Ov =>
+                  Build := BuildAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildMul'Access;
+
+               when ON_Div_Ov =>
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildUDiv'Access;
+                     when ON_Signed_Type =>
+                        Build := BuildSDiv'Access;
+                     when others =>
+                        null;
+                  end case;
+
+               when ON_Mod_Ov
+                 | ON_Rem_Ov => -- FIXME...
+                  case Left.Etype.Kind is
+                     when ON_Unsigned_Type =>
+                        Build := BuildURem'Access;
+                     when ON_Signed_Type =>
+                        if Kind = ON_Rem_Ov then
+                           Build := BuildSRem'Access;
+                        else
+                           Res := New_Smod
+                             (Left.LLVM, Right.LLVM, Left.Etype.LLVM);
+                        end if;
+                     when others =>
+                        null;
+                  end case;
+            end case;
+
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Add_Ov =>
+                  Build := BuildFAdd'Access;
+               when ON_Sub_Ov =>
+                  Build := BuildFSub'Access;
+               when ON_Mul_Ov =>
+                  Build := BuildFMul'Access;
+               when ON_Div_Ov =>
+                  Build := BuildFDiv'Access;
+
+               when others =>
+                  null;
+            end case;
+
+         when others =>
+            null;
+      end case;
+
+      if Build /= null then
+         pragma Assert (Res = Null_ValueRef);
+         Res := Build.all (Builder,  Left.LLVM, Right.LLVM, Empty_Cstring);
+      end if;
+
+      if Res = Null_ValueRef then
+         raise Program_Error with "Unimplemented New_Dyadic_Op "
+           & ON_Dyadic_Op_Kind'Image (Kind)
+           & " for type "
+           & ON_Type_Kind'Image (Left.Etype.Kind);
+      end if;
+
+      Set_Insn_Dbg (Res);
+
+      return O_Enode'(LLVM => Res, Etype => Left.Etype);
+   end New_Dyadic_Op;
+
+   --------------------
+   -- New_Monadic_Op --
+   --------------------
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Operand.Etype.Kind is
+         when ON_Integer_Types =>
+            case Kind is
+               when ON_Not =>
+                  Res := BuildNot (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Neg_Ov =>
+                  Res := BuildNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  Res := BuildSelect
+                    (Builder,
+                     BuildICmp (Builder, IntSLT,
+                                Operand.LLVM,
+                                ConstInt (Get_LLVM_Type (Operand.Etype), 0, 0),
+                                Empty_Cstring),
+                     BuildNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when ON_Float_Type =>
+            case Kind is
+               when ON_Not =>
+                  raise Program_Error;
+               when ON_Neg_Ov =>
+                  Res := BuildFNeg (Builder, Operand.LLVM, Empty_Cstring);
+               when ON_Abs_Ov =>
+                  Res := BuildSelect
+                    (Builder,
+                     BuildFCmp (Builder, RealOLT,
+                                Operand.LLVM,
+                                ConstReal (Get_LLVM_Type (Operand.Etype), 0.0),
+                                Empty_Cstring),
+                     BuildFNeg (Builder, Operand.LLVM, Empty_Cstring),
+                     Operand.LLVM,
+                     Empty_Cstring);
+            end case;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      if IsAInstruction (Res) /= Null_ValueRef then
+         Set_Insn_Dbg (Res);
+      end if;
+
+      return O_Enode'(LLVM => Res, Etype => Operand.Etype);
+   end New_Monadic_Op;
+
+   --------------------
+   -- New_Compare_Op --
+   --------------------
+
+   type Compare_Op_Entry is record
+      Signed_Pred   : IntPredicate;
+      Unsigned_Pred : IntPredicate;
+      Real_Pred     : RealPredicate;
+   end record;
+
+   type Compare_Op_Table_Type is array (ON_Compare_Op_Kind) of
+     Compare_Op_Entry;
+
+   Compare_Op_Table : constant Compare_Op_Table_Type :=
+     (ON_Eq  => (IntEQ,  IntEQ,  RealOEQ),
+      ON_Neq => (IntNE,  IntNE,  RealONE),
+      ON_Le  => (IntSLE, IntULE, RealOLE),
+      ON_Lt  => (IntSLT, IntULT, RealOLT),
+      ON_Ge  => (IntSGE, IntUGE, RealOGE),
+      ON_Gt  => (IntSGT, IntUGT, RealOGT));
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind;
+      Left, Right : O_Enode;
+      Ntype : O_Tnode)
+      return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      case Left.Etype.Kind is
+         when ON_Unsigned_Type
+           | ON_Boolean_Type
+           | ON_Enum_Type
+           | ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Unsigned_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Signed_Type =>
+            Res := BuildICmp (Builder, Compare_Op_Table (Kind).Signed_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Float_Type =>
+            Res := BuildFCmp (Builder, Compare_Op_Table (Kind).Real_Pred,
+                              Left.LLVM, Right.LLVM, Empty_Cstring);
+         when ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type
+           | ON_Incomplete_Record_Type
+           | ON_Union_Type
+           | ON_No_Type =>
+            raise Program_Error;
+      end case;
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Ntype);
+   end New_Compare_Op;
+
+   -------------------------
+   -- New_Indexed_Element --
+   -------------------------
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+   begin
+      return O_Lnode'
+        (Direct => False,
+         LLVM => BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring),
+         Ltype => Arr.Ltype.Arr_El_Type);
+   end New_Indexed_Element;
+
+   ---------------
+   -- New_Slice --
+   ---------------
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+      return O_Lnode
+   is
+      Idx : constant ValueRefArray (1 .. 2) :=
+        (ConstInt (Int32Type, 0, 0),
+         Index.LLVM);
+      Tmp : ValueRef;
+   begin
+      Tmp := BuildGEP (Builder, Arr.LLVM, Idx, Idx'Length, Empty_Cstring);
+      Tmp := BuildBitCast
+        (Builder, Tmp, PointerType (Get_LLVM_Type (Res_Type)), Empty_Cstring);
+      return O_Lnode'(Direct => False, LLVM => Tmp, Ltype => Res_Type);
+   end New_Slice;
+
+   --------------------------
+   -- New_Selected_Element --
+   --------------------------
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         declare
+            Idx : constant ValueRefArray (1 .. 2) :=
+              (ConstInt (Int32Type, 0, 0),
+               ConstInt (Int32Type, Unsigned_64 (El.Index), 0));
+         begin
+            Res := BuildGEP (Builder, Rec.LLVM, Idx, 2, Empty_Cstring);
+         end;
+      end if;
+      return O_Lnode'(Direct => False, LLVM => Res, Ltype => El.Ftype);
+   end New_Selected_Element;
+
+   ------------------------
+   -- New_Access_Element --
+   ------------------------
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Res : ValueRef;
+   begin
+      case Acc.Etype.Kind is
+         when ON_Access_Type =>
+            Res := Acc.LLVM;
+         when ON_Incomplete_Access_Type =>
+            --  Unwrap the structure
+            declare
+               Idx : constant ValueRefArray (1 .. 2) :=
+                 (ConstInt (Int32Type, 0, 0), ConstInt (Int32Type, 0, 0));
+            begin
+               Res := BuildGEP (Builder, Acc.LLVM, Idx, 2, Empty_Cstring);
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+      return O_Lnode'(Direct => False,
+                      LLVM => Res,
+                      Ltype => Acc.Etype.Acc_Type);
+   end New_Access_Element;
+
+   --------------------
+   -- New_Convert_Ov --
+   --------------------
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode
+   is
+      Res : ValueRef := Null_ValueRef;
+   begin
+      if Rtype = Val.Etype then
+         --  Convertion to itself: nothing to do.
+         return Val;
+      end if;
+      if Rtype.LLVM = Val.Etype.LLVM then
+         --  Same underlying LLVM type: nothing to do.
+         return Val;
+      end if;
+
+      case Rtype.Kind is
+         when ON_Integer_Types =>
+            case Val.Etype.Kind is
+               when ON_Integer_Types =>
+                  --  Int to Int
+                  if Val.Etype.Scal_Size > Rtype.Scal_Size then
+                     --  Truncate
+                     Res := BuildTrunc
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  elsif Val.Etype.Scal_Size < Rtype.Scal_Size then
+                     if Val.Etype.Kind = ON_Signed_Type then
+                        Res := BuildSExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     else
+                        --  Unsigned, enum
+                        Res := BuildZExt
+                          (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                           Empty_Cstring);
+                     end if;
+                  else
+                     Res := BuildBitCast
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when ON_Float_Type =>
+                  --  Float to Int
+                  if Rtype.Kind = ON_Signed_Type then
+                     Res := BuildFPToSI
+                       (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                        Empty_Cstring);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+
+         when ON_Float_Type =>
+            if Val.Etype.Kind = ON_Signed_Type then
+               Res := BuildSIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            elsif Val.Etype.Kind = ON_Unsigned_Type then
+               Res := BuildUIToFP
+                 (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                  Empty_Cstring);
+            end if;
+
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            if GetTypeKind (TypeOf (Val.LLVM)) /= PointerTypeKind then
+               raise Program_Error;
+            end if;
+            Res := BuildBitCast (Builder, Val.LLVM, Get_LLVM_Type (Rtype),
+                                 Empty_Cstring);
+
+         when others =>
+            null;
+      end case;
+      if Res /= Null_ValueRef then
+         --  FIXME: only if insn was generated
+         --  Set_Insn_Dbg (Res);
+         return O_Enode'(LLVM => Res, Etype => Rtype);
+      else
+         raise Program_Error with "New_Convert_Ov: not implemented for "
+           & ON_Type_Kind'Image (Val.Etype.Kind)
+           & " -> "
+           & ON_Type_Kind'Image (Rtype.Kind);
+      end if;
+   end New_Convert_Ov;
+
+   -----------------
+   -- New_Address --
+   -----------------
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Address;
+
+   ---------------------------
+   -- New_Unchecked_Address --
+   ---------------------------
+
+   function New_Unchecked_Address  (Lvalue : O_Lnode; Atype : O_Tnode)
+                                   return O_Enode
+   is
+   begin
+      return O_Enode'
+        (LLVM => BuildBitCast (Builder, Lvalue.LLVM, Get_LLVM_Type (Atype),
+                               Empty_Cstring),
+         Etype => Atype);
+   end New_Unchecked_Address;
+
+   ---------------
+   -- New_Value --
+   ---------------
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         Res := Lvalue.LLVM;
+         if not Lvalue.Direct then
+            Res := BuildLoad (Builder, Res, Empty_Cstring);
+            Set_Insn_Dbg (Res);
+         end if;
+      end if;
+      return O_Enode'(LLVM => Res, Etype => Lvalue.Ltype);
+   end New_Value;
+
+   -------------------
+   -- New_Obj_Value --
+   -------------------
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   -------------
+   -- New_Obj --
+   -------------
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      case Obj.Kind is
+         when ON_Const_Decl
+           | ON_Var_Decl
+           | ON_Local_Decl =>
+            return O_Lnode'(Direct => False,
+                            LLVM => Obj.LLVM,
+                            Ltype => Obj.Dtype);
+
+         when ON_Interface_Decl =>
+            if Flag_Debug then
+               --  The argument was allocated.
+               return O_Lnode'(Direct => False,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            else
+               return O_Lnode'(Direct => True,
+                               LLVM => Obj.Inter.Ival,
+                               Ltype => Obj.Dtype);
+            end if;
+
+         when ON_Type_Decl
+           | ON_Completed_Type_Decl
+           | ON_Subprg_Decl
+           | ON_No_Decl =>
+            raise Program_Error;
+      end case;
+   end New_Obj;
+
+   ----------------
+   -- New_Alloca --
+   ----------------
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         Res := Null_ValueRef;
+      else
+         if Cur_Declare_Block.Stack_Value = Null_ValueRef
+           and then Cur_Declare_Block.Prev /= null
+         then
+            --  Save stack pointer at entry of block
+            PositionBuilderBefore
+              (Extra_Builder, GetFirstInstruction (Cur_Declare_Block.Stmt_Bb));
+            Cur_Declare_Block.Stack_Value :=
+              BuildCall (Extra_Builder, Stacksave_Fun,
+                         (1 .. 0 => Null_ValueRef), 0, Empty_Cstring);
+         end if;
+
+         Res := BuildArrayAlloca
+           (Builder, Int8Type, Size.LLVM, Empty_Cstring);
+         Set_Insn_Dbg (Res);
+
+         Res := BuildBitCast
+           (Builder, Res, Get_LLVM_Type (Rtype), Empty_Cstring);
+         Set_Insn_Dbg (Res);
+      end if;
+
+      return O_Enode'(LLVM => Res, Etype => Rtype);
+   end New_Alloca;
+
+   -------------------
+   -- New_Type_Decl --
+   -------------------
+
+   function Add_Dbg_Basic_Type (Id : O_Ident; Btype : O_Tnode; Enc : Natural)
+                               return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Base_Type, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               MDString (Id),
+               ConstInt (Int32Type, 0, 0),    -- linenum
+               Dbg_Size (Btype.LLVM),
+               Dbg_Align (Btype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               ConstInt (Int32Type, Unsigned_64 (Enc), 0)); --  Encoding
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Basic_Type;
+
+   function Add_Dbg_Enum_Type (Id : O_Ident; Etype : O_Tnode) return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Enumeration_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Etype.LLVM),
+               Dbg_Align (Etype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 0, 0),    --  Flags
+               Null_ValueRef,
+               Get_Value (Enum_Nodes),
+               ConstInt (Int32Type, 0, 0),
+               Null_ValueRef,
+               Null_ValueRef,
+               Null_ValueRef); --  Runtime lang
+      Clear (Enum_Nodes);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Enum_Type;
+
+   function Add_Dbg_Pointer_Type (Id : O_Ident; Ptype : O_Tnode)
+                                 return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 9);
+   begin
+      pragma Assert (Ptype.Acc_Type.Dbg /= Null_ValueRef);
+
+      Vals := (ConstInt (Int32Type, DW_TAG_Pointer_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Dbg_Size (Ptype.LLVM),
+               Dbg_Align (Ptype.LLVM),
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Ptype.Acc_Type.Dbg);
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Pointer_Type;
+
+   function Add_Dbg_Record_Type (Id : O_Ident; Rtype : O_Tnode)
+                                return ValueRef
+   is
+      Vals : ValueRefArray (0 .. 14);
+   begin
+      Vals := (ConstInt (Int32Type, DW_TAG_Structure_Type, 0),
+               Dbg_Current_Filedir,
+               Null_ValueRef,           --  context
+               MDString (Id),
+               Dbg_Line,
+               Null_ValueRef,  --  5: Size
+               Null_ValueRef,  --  6: Align
+               ConstInt (Int32Type, 0, 0),    --  Offset
+               ConstInt (Int32Type, 1024, 0),    --  Flags
+               Null_ValueRef,
+               Null_ValueRef, -- 10
+               ConstInt (Int32Type, 0, 0),    --  Runtime lang
+               Null_ValueRef, -- Vtable Holder
+               Null_ValueRef, -- ?
+               Null_ValueRef); -- Uniq Id
+      if Rtype /= O_Tnode_Null then
+         Vals (5) := Dbg_Size (Rtype.LLVM);
+         Vals (6) := Dbg_Align (Rtype.LLVM);
+         Vals (10) := Rtype.Dbg;
+      end if;
+
+      return MDNode (Vals, Vals'Length);
+   end Add_Dbg_Record_Type;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type =>
+            Atype.LLVM :=
+              StructCreateNamed (GetGlobalContext, Get_Cstring (Ident));
+         when ON_Incomplete_Access_Type =>
+            Atype.LLVM := PointerType
+              (StructCreateNamed (GetGlobalContext, Get_Cstring (Ident)));
+         when others =>
+            null;
+      end case;
+
+      --  Emit debug info
+      if Flag_Debug then
+         case Atype.Kind is
+            when ON_Unsigned_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_unsigned);
+            when ON_Signed_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_signed);
+            when ON_Float_Type =>
+               Atype.Dbg := Add_Dbg_Basic_Type (Ident, Atype, DW_ATE_float);
+            when ON_Enum_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Boolean_Type =>
+               Atype.Dbg := Add_Dbg_Enum_Type (Ident, Atype);
+            when ON_Access_Type =>
+               Atype.Dbg := Add_Dbg_Pointer_Type (Ident, Atype);
+            when ON_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, Atype);
+            when ON_Incomplete_Record_Type =>
+               Atype.Dbg := Add_Dbg_Record_Type (Ident, O_Tnode_Null);
+            when ON_Array_Type
+              | ON_Array_Sub_Type =>
+               --  FIXME: typedef
+               null;
+            when ON_Incomplete_Access_Type =>
+               --  FIXME: todo
+               null;
+            when ON_Union_Type =>
+               --  FIXME: todo
+               null;
+            when ON_No_Type =>
+               raise Program_Error;
+         end case;
+      end if;
+   end New_Type_Decl;
+
+   -----------------------------
+   -- New_Debug_Filename_Decl --
+   -----------------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String) is
+      Vals : ValueRefArray (1 .. 2);
+   begin
+      if Flag_Debug then
+         Vals := (MDString (Filename),
+                  MDString (Current_Directory));
+         Dbg_Current_Filedir := MDNode (Vals, 2);
+
+         Vals := (ConstInt (Int32Type, DW_TAG_File_Type, 0),
+                  Dbg_Current_Filedir);
+         Dbg_Current_File := MDNode (Vals, 2);
+      end if;
+   end New_Debug_Filename_Decl;
+
+   -------------------------
+   -- New_Debug_Line_Decl --
+   -------------------------
+
+   procedure New_Debug_Line_Decl (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Decl;
+
+   ----------------------------
+   -- New_Debug_Comment_Decl --
+   ----------------------------
+
+   procedure New_Debug_Comment_Decl (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   --------------------
+   -- New_Const_Decl --
+   --------------------
+
+   procedure Dbg_Add_Global_Var (Id : O_Ident;
+                                 Atype : O_Tnode;
+                                 Storage : O_Storage;
+                                 Decl : O_Dnode)
+   is
+      pragma Assert (Atype.Dbg /= Null_ValueRef);
+      Vals : ValueRefArray (0 .. 12);
+      Name : constant ValueRef := MDString (Id);
+      Is_Local : constant Boolean := Storage = O_Storage_Private;
+      Is_Def : constant Boolean := Storage /= O_Storage_External;
+   begin
+      Vals :=
+        (ConstInt (Int32Type, DW_TAG_Variable, 0),
+         Null_ValueRef,
+         Null_ValueRef, -- context
+         Name,
+         Name,
+         Null_ValueRef, -- linkageName
+         Dbg_Current_File,
+         Dbg_Line,
+         Atype.Dbg,
+         ConstInt (Int1Type, Boolean'Pos (Is_Local), 0), -- isLocal
+         ConstInt (Int1Type, Boolean'Pos (Is_Def), 0), -- isDef
+         Decl.LLVM,
+         Null_ValueRef);
+      Append (Global_Nodes, MDNode (Vals, Vals'Length));
+   end Dbg_Add_Global_Var;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_External then
+         Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddGlobal
+           (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+      end if;
+
+      Res := (Kind => ON_Const_Decl, LLVM => Decl, Dtype => Atype);
+      SetGlobalConstant (Res.LLVM, 1);
+      if Storage = O_Storage_Private then
+         SetLinkage (Res.LLVM, InternalLinkage);
+      end if;
+      if Flag_Debug then
+         Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+      end if;
+   end New_Const_Decl;
+
+   -----------------------
+   -- Start_Const_Value --
+   -----------------------
+
+   procedure Start_Const_Value (Const : in out O_Dnode) is
+   begin
+      null;
+   end Start_Const_Value;
+
+   ------------------------
+   -- Finish_Const_Value --
+   ------------------------
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) is
+   begin
+      SetInitializer (Const.LLVM, Val.LLVM);
+   end Finish_Const_Value;
+
+   ------------------
+   -- New_Var_Decl --
+   ------------------
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode; Ident : O_Ident; Storage : O_Storage; Atype : O_Tnode)
+   is
+      Decl : ValueRef;
+   begin
+      if Storage = O_Storage_Local then
+         Res := (Kind => ON_Local_Decl,
+                 LLVM => BuildAlloca
+                   (Decl_Builder, Get_LLVM_Type (Atype), Get_Cstring (Ident)),
+                 Dtype => Atype);
+         if Flag_Debug then
+            Dbg_Create_Variable (DW_TAG_Auto_Variable,
+                                 Ident, Atype, 0, Res.LLVM);
+         end if;
+      else
+         if Storage = O_Storage_External then
+            Decl := GetNamedGlobal (Module, Get_Cstring (Ident));
+         else
+            Decl := Null_ValueRef;
+         end if;
+         if Decl = Null_ValueRef then
+            Decl := AddGlobal
+              (Module, Get_LLVM_Type (Atype), Get_Cstring (Ident));
+         end if;
+
+         Res := (Kind => ON_Var_Decl, LLVM => Decl, Dtype => Atype);
+
+         --  Set linkage.
+         case Storage is
+            when O_Storage_Private =>
+               SetLinkage (Res.LLVM, InternalLinkage);
+            when O_Storage_Public
+              | O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         --  Set initializer.
+         case Storage is
+            when O_Storage_Private
+              | O_Storage_Public =>
+               SetInitializer (Res.LLVM, ConstNull (Get_LLVM_Type (Atype)));
+            when O_Storage_External =>
+               null;
+            when O_Storage_Local =>
+               raise Program_Error;
+         end case;
+
+         if Flag_Debug then
+            Dbg_Add_Global_Var (Ident, Atype, Storage, Res);
+         end if;
+      end if;
+   end New_Var_Decl;
+
+   -------------------------
+   -- Start_Function_Decl --
+   -------------------------
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => Rtype,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Function_Decl;
+
+   --------------------------
+   -- Start_Procedure_Decl --
+   --------------------------
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage)
+   is
+   begin
+      Interfaces := (Ident => Ident,
+                     Storage => Storage,
+                     Res_Type => O_Tnode_Null,
+                     Nbr_Inter => 0,
+                     First_Inter => null,
+                     Last_Inter => null);
+   end Start_Procedure_Decl;
+
+   ------------------------
+   -- New_Interface_Decl --
+   ------------------------
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+      Inter : constant O_Inter_Acc := new O_Inter'(Itype => Atype,
+                                                   Ival => Null_ValueRef,
+                                                   Ident => Ident,
+                                                   Next => null);
+   begin
+      Res := (Kind => ON_Interface_Decl,
+              Dtype => Atype,
+              LLVM => Null_ValueRef,
+              Inter => Inter);
+      Interfaces.Nbr_Inter := Interfaces.Nbr_Inter + 1;
+      if Interfaces.First_Inter = null then
+         Interfaces.First_Inter := Inter;
+      else
+         Interfaces.Last_Inter.Next := Inter;
+      end if;
+      Interfaces.Last_Inter := Inter;
+   end New_Interface_Decl;
+
+   ----------------------------
+   -- Finish_Subprogram_Decl --
+   ----------------------------
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode)
+   is
+      Count : constant unsigned := unsigned (Interfaces.Nbr_Inter);
+      Inter : O_Inter_Acc;
+      Types : TypeRefArray (1 .. Count);
+      Ftype : TypeRef;
+      Rtype : TypeRef;
+      Decl : ValueRef;
+      Id : constant Cstring := Get_Cstring (Interfaces.Ident);
+   begin
+      --  Fill Types (from interfaces list)
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Types (I) := Inter.Itype.LLVM;
+         Inter := Inter.Next;
+      end loop;
+
+      --  Build function type.
+      if Interfaces.Res_Type = O_Tnode_Null then
+         Rtype := VoidType;
+      else
+         Rtype := Interfaces.Res_Type.LLVM;
+      end if;
+      Ftype := FunctionType (Rtype, Types, Count, 0);
+
+      if Interfaces.Storage = O_Storage_External then
+         Decl := GetNamedFunction (Module, Id);
+      else
+         Decl := Null_ValueRef;
+      end if;
+      if Decl = Null_ValueRef then
+         Decl := AddFunction (Module, Id, Ftype);
+      end if;
+
+      Res := (Kind => ON_Subprg_Decl,
+              Dtype => Interfaces.Res_Type,
+              Subprg_Id => Interfaces.Ident,
+              Nbr_Args => Count,
+              Subprg_Inters => Interfaces.First_Inter,
+              LLVM => Decl);
+      SetFunctionCallConv (Res.LLVM, CCallConv);
+
+      --  Translate interfaces.
+      Inter := Interfaces.First_Inter;
+      for I in 1 .. Count loop
+         Inter.Ival := GetParam (Res.LLVM, I - 1);
+         SetValueName (Inter.Ival, Get_Cstring (Inter.Ident));
+         Inter := Inter.Next;
+      end loop;
+   end Finish_Subprogram_Decl;
+
+   ---------------------------
+   -- Start_Subprogram_Body --
+   ---------------------------
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      --  Basic block at function entry that contains all the declarations.
+      Decl_BB : BasicBlockRef;
+   begin
+      if Cur_Func /= Null_ValueRef then
+         --  No support for nested subprograms.
+         raise Program_Error;
+      end if;
+
+      Cur_Func := Func.LLVM;
+      Cur_Func_Decl := Func;
+      Unreach := False;
+
+      Decl_BB := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Decl_Builder, Decl_BB);
+
+      Create_Declare_Block;
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Type_Vals : ValueRefArray (0 .. Func.Nbr_Args);
+            Vals : ValueRefArray (0 .. 14);
+            Arg : O_Inter_Acc;
+            Subprg_Type : ValueRef;
+
+            Subprg_Vals : ValueRefArray (0 .. 19);
+            Name : ValueRef;
+         begin
+            Arg := Func.Subprg_Inters;
+            if Func.Dtype /= O_Tnode_Null then
+               Type_Vals (0) := Func.Dtype.Dbg;
+            else
+               --  Void
+               Type_Vals (0) := Null_ValueRef;
+            end if;
+            for I in 1 .. Type_Vals'Last loop
+               Type_Vals (I) := Arg.Itype.Dbg;
+               Arg := Arg.Next;
+            end loop;
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subroutine_Type, 0),
+               ConstInt (Int32Type, 0, 0),  --  1 ??
+               Null_ValueRef,               --  2 Context
+               MDString (Empty_Cstring, 0), --  3 name
+               ConstInt (Int32Type, 0, 0),  --  4 linenum
+               ConstInt (Int64Type, 0, 0),  --  5 size
+               ConstInt (Int64Type, 0, 0),  --  6 align
+               ConstInt (Int64Type, 0, 0),  --  7 offset
+               ConstInt (Int32Type, 0, 0),  --  8 flags
+               Null_ValueRef,               --  9 derived from
+               MDNode (Type_Vals, Type_Vals'Length), --  10 type
+               ConstInt (Int32Type, 0, 0),  --  11 runtime lang
+               Null_ValueRef,               --  12 containing type
+               Null_ValueRef,               --  13 template params
+               Null_ValueRef);              --  14 ??
+            Subprg_Type := MDNode (Vals, Vals'Length);
+
+            --  Create TAG_subprogram.
+            Name := MDString (Func.Subprg_Id);
+
+            Subprg_Vals :=
+              (ConstInt (Int32Type, DW_TAG_Subprogram, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_File,                --  2 context
+               Name,                            --  3 name
+               Name,                            --  4 display name
+               Null_ValueRef,                   --  5 linkage name
+               Dbg_Line,                        --  6 line num
+               Subprg_Type,                     --  7 type
+               ConstInt (Int1Type, 0, 0),       --  8 islocal (FIXME)
+               ConstInt (Int1Type, 1, 0),       --  9 isdef (FIXME)
+               ConstInt (Int32Type, 0, 0),      --  10 virtuality
+               ConstInt (Int32Type, 0, 0),      --  11 virtual index
+               Null_ValueRef,                   --  12 containing type
+               ConstInt (Int32Type, 256, 0),    --  13 flags: prototyped
+               ConstInt (Int1Type, 0, 0),       --  14 isOpt (FIXME)
+               Cur_Func,                        --  15 function
+               Null_ValueRef,                   --  16 template param
+               Null_ValueRef,                   --  17 function decl
+               Null_ValueRef,                   --  18 variables ???
+               Dbg_Line);                       --  19 scope ln
+            Cur_Declare_Block.Dbg_Scope :=
+              MDNode (Subprg_Vals, Subprg_Vals'Length);
+            Append (Subprg_Nodes, Cur_Declare_Block.Dbg_Scope);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+         end;
+
+         --  Create local variables for arguments.
+         declare
+            Arg : O_Inter_Acc;
+            Tmp : ValueRef;
+            St : ValueRef;
+            pragma Unreferenced (St);
+            Argno : Natural;
+         begin
+            Arg := Func.Subprg_Inters;
+            Argno := 1;
+            while Arg /= null loop
+               Tmp := BuildAlloca (Decl_Builder, Get_LLVM_Type (Arg.Itype),
+                                   Empty_Cstring);
+               Dbg_Create_Variable (DW_TAG_Arg_Variable,
+                                    Arg.Ident, Arg.Itype, Argno, Tmp);
+               St := BuildStore (Decl_Builder, Arg.Ival, Tmp);
+               Arg.Ival := Tmp;
+
+               Arg := Arg.Next;
+               Argno := Argno + 1;
+            end loop;
+         end;
+      end if;
+   end Start_Subprogram_Body;
+
+   ----------------------------
+   -- Finish_Subprogram_Body --
+   ----------------------------
+
+   procedure Finish_Subprogram_Body is
+      Ret : ValueRef;
+      pragma Unreferenced (Ret);
+   begin
+      --  Add a jump from the declare basic block to the first statement BB.
+      Ret := BuildBr (Decl_Builder, Cur_Declare_Block.Stmt_Bb);
+
+      --  Terminate the statement BB.
+      if not Unreach then
+         if Cur_Func_Decl.Dtype = O_Tnode_Null then
+            Ret := BuildRetVoid (Builder);
+         else
+            Ret := BuildUnreachable (Builder);
+         end if;
+      end if;
+
+      Destroy_Declare_Block;
+
+      Cur_Func := Null_ValueRef;
+      Dbg_Current_Scope := Null_ValueRef;
+   end Finish_Subprogram_Body;
+
+   -------------------------
+   -- New_Debug_Line_Stmt --
+   -------------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      Dbg_Current_Line := unsigned (Line);
+   end New_Debug_Line_Stmt;
+
+   ----------------------------
+   -- New_Debug_Comment_Stmt --
+   ----------------------------
+
+   procedure New_Debug_Comment_Stmt (Comment : String) is
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   ------------------------
+   -- Start_Declare_Stmt --
+   ------------------------
+
+   procedure Start_Declare_Stmt
+   is
+      Br : ValueRef;
+      pragma Unreferenced (Br);
+   begin
+      Create_Declare_Block;
+
+      if Unreach then
+         return;
+      end if;
+
+      --  Add a jump to the new BB.
+      Br := BuildBr (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      PositionBuilderAtEnd (Builder, Cur_Declare_Block.Stmt_Bb);
+
+      if Flag_Debug then
+         declare
+            Vals : ValueRefArray (0 .. 5);
+         begin
+            Vals :=
+              (ConstInt (Int32Type, DW_TAG_Lexical_Block, 0),
+               Dbg_Current_Filedir,             --  1 loc
+               Dbg_Current_Scope,               --  2 context
+               Dbg_Line,                        --  3 line num
+               ConstInt (Int32Type, 0, 0),       --  4 col
+               ConstInt (Int32Type, Scope_Uniq_Id, 0));
+            Cur_Declare_Block.Dbg_Scope := MDNode (Vals, Vals'Length);
+            Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+            Scope_Uniq_Id := Scope_Uniq_Id + 1;
+         end;
+      end if;
+   end Start_Declare_Stmt;
+
+   -------------------------
+   -- Finish_Declare_Stmt --
+   -------------------------
+
+   procedure Finish_Declare_Stmt
+   is
+      Bb : BasicBlockRef;
+      Br : ValueRef;
+      Tmp : ValueRef;
+      pragma Unreferenced (Br, Tmp);
+   begin
+      if not Unreach then
+         --  Create a basic block for the statements after the declare.
+         Bb := AppendBasicBlock (Cur_Func, Empty_Cstring);
+
+         if Cur_Declare_Block.Stack_Value /= Null_ValueRef then
+            --  Restore stack pointer.
+            Tmp := BuildCall (Builder, Stackrestore_Fun,
+                              (1 .. 1 => Cur_Declare_Block.Stack_Value), 1,
+                              Empty_Cstring);
+         end if;
+
+         --  Execution will continue on the next statement
+         Br := BuildBr (Builder, Bb);
+
+         PositionBuilderAtEnd (Builder, Bb);
+      end if;
+
+      --  Do not reset Unread.
+
+      Destroy_Declare_Block;
+
+      Dbg_Current_Scope := Cur_Declare_Block.Dbg_Scope;
+   end Finish_Declare_Stmt;
+
+   -----------------------
+   -- Start_Association --
+   -----------------------
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+   begin
+      Assocs := (Subprg => Subprg,
+                 Idx => 0,
+                 Vals => new ValueRefArray (1 .. Subprg.Nbr_Args));
+   end Start_Association;
+
+   ---------------------
+   -- New_Association --
+   ---------------------
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) is
+   begin
+      Assocs.Idx := Assocs.Idx + 1;
+      Assocs.Vals (Assocs.Idx) := Val.LLVM;
+   end New_Association;
+
+   -----------------------
+   -- New_Function_Call --
+   -----------------------
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      Res : ValueRef;
+      Old_Vals : ValueRefArray_Acc;
+   begin
+      Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                        Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+      Old_Vals := Assocs.Vals;
+      Free (Old_Vals);
+      Set_Insn_Dbg (Res);
+      return O_Enode'(LLVM => Res, Etype => Assocs.Subprg.Dtype);
+   end New_Function_Call;
+
+   ------------------------
+   -- New_Procedure_Call --
+   ------------------------
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List)
+   is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildCall (Builder, Assocs.Subprg.LLVM,
+                           Assocs.Vals.all, Assocs.Vals'Last, Empty_Cstring);
+         Set_Insn_Dbg (Res);
+      end if;
+      Free (Assocs.Vals);
+   end New_Procedure_Call;
+
+   ---------------------
+   -- New_Assign_Stmt --
+   ---------------------
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      Res : ValueRef;
+   begin
+      if Target.Direct then
+         raise Program_Error;
+      end if;
+      if not Unreach then
+         Res := BuildStore (Builder, Value.LLVM, Target.LLVM);
+         Set_Insn_Dbg (Res);
+      end if;
+   end New_Assign_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt (Value : O_Enode) is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRet (Builder, Value.LLVM);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   ---------------------
+   -- New_Return_Stmt --
+   ---------------------
+
+   procedure New_Return_Stmt is
+      Res : ValueRef;
+   begin
+      if Unreach then
+         return;
+      end if;
+      Res := BuildRetVoid (Builder);
+      Set_Insn_Dbg (Res);
+      Unreach := True;
+   end New_Return_Stmt;
+
+   -------------------
+   -- Start_If_Stmt --
+   -------------------
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) is
+      Res : ValueRef;
+      Bb_Then : BasicBlockRef;
+   begin
+      --  FIXME: check Unreach
+      Bb_Then := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Block := (Bb => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildCondBr (Builder, Cond.LLVM, Bb_Then, Block.Bb);
+      Set_Insn_Dbg (Res);
+
+      PositionBuilderAtEnd (Builder, Bb_Then);
+   end Start_If_Stmt;
+
+   -------------------
+   -- New_Else_Stmt --
+   -------------------
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         Res := BuildBr (Builder, Bb_Next);
+      else
+         Bb_Next := Null_BasicBlockRef;
+      end if;
+
+      PositionBuilderAtEnd (Builder, Block.Bb);
+
+      Block := (Bb => Bb_Next);
+      Unreach := False;
+   end New_Else_Stmt;
+
+   --------------------
+   -- Finish_If_Stmt --
+   --------------------
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+      Bb_Next : BasicBlockRef;
+   begin
+      if not Unreach then
+         --  The branch can continue.
+         if Block.Bb = Null_BasicBlockRef then
+            Bb_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         else
+            Bb_Next := Block.Bb;
+         end if;
+         Res := BuildBr (Builder, Bb_Next);
+         PositionBuilderAtEnd (Builder, Bb_Next);
+      else
+         --  The branch doesn't continue.
+         if Block.Bb /= Null_BasicBlockRef then
+            --  There is a fall-through (either from the then branch, or
+            --  there is no else).
+            Unreach := False;
+            PositionBuilderAtEnd (Builder, Block.Bb);
+         else
+            Unreach := True;
+         end if;
+      end if;
+   end Finish_If_Stmt;
+
+   ---------------------
+   -- Start_Loop_Stmt --
+   ---------------------
+
+   procedure Start_Loop_Stmt (Label : out O_Snode)
+   is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  FIXME: check Unreach
+      Label := (Bb_Entry => AppendBasicBlock (Cur_Func, Empty_Cstring),
+                Bb_Exit => AppendBasicBlock (Cur_Func, Empty_Cstring));
+      Res := BuildBr (Builder, Label.Bb_Entry);
+      PositionBuilderAtEnd (Builder, Label.Bb_Entry);
+   end Start_Loop_Stmt;
+
+   ----------------------
+   -- Finish_Loop_Stmt --
+   ----------------------
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, Label.Bb_Entry);
+      end if;
+      if Label.Bb_Exit /= Null_BasicBlockRef then
+         --  FIXME: always true...
+         PositionBuilderAtEnd (Builder, Label.Bb_Exit);
+         Unreach := False;
+      else
+         Unreach := True;
+      end if;
+   end Finish_Loop_Stmt;
+
+   -------------------
+   -- New_Exit_Stmt --
+   -------------------
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Exit);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Exit_Stmt;
+
+   -------------------
+   -- New_Next_Stmt --
+   -------------------
+
+   procedure New_Next_Stmt (L : O_Snode) is
+      Res : ValueRef;
+   begin
+      if not Unreach then
+         Res := BuildBr (Builder, L.Bb_Entry);
+         Set_Insn_Dbg (Res);
+         Unreach := True;
+      end if;
+   end New_Next_Stmt;
+
+   ---------------------
+   -- Start_Case_Stmt --
+   ---------------------
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) is
+   begin
+      Block := (BB_Prev => GetInsertBlock (Builder),
+                Value => Value.LLVM,
+                Vtype => Value.Etype,
+                BB_Next => Null_BasicBlockRef,
+                BB_Others => Null_BasicBlockRef,
+                BB_Choice => Null_BasicBlockRef,
+                Nbr_Choices => 0,
+                Choices => new O_Choice_Array (1 .. 8));
+   end Start_Case_Stmt;
+
+   ------------------
+   -- Start_Choice --
+   ------------------
+
+   procedure Finish_Branch (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      --  Close previous branch.
+      if not Unreach then
+         if Block.BB_Next = Null_BasicBlockRef then
+            Block.BB_Next := AppendBasicBlock (Cur_Func, Empty_Cstring);
+         end if;
+         Res := BuildBr (Builder, Block.BB_Next);
+      end if;
+   end Finish_Branch;
+
+   procedure Start_Choice (Block : in out O_Case_Block) is
+      Res : ValueRef;
+      pragma Unreferenced (Res);
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      Unreach := False;
+      Block.BB_Choice := AppendBasicBlock (Cur_Func, Empty_Cstring);
+      PositionBuilderAtEnd (Builder, Block.BB_Choice);
+   end Start_Choice;
+
+   ---------------------
+   -- New_Expr_Choice --
+   ---------------------
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (O_Choice_Array, O_Choice_Array_Acc);
+
+   procedure New_Choice (Block : in out O_Case_Block;
+                         Low, High : ValueRef)
+   is
+      Choices : O_Choice_Array_Acc;
+   begin
+      if Block.Nbr_Choices = Block.Choices'Last then
+         Choices := new O_Choice_Array (1 .. Block.Choices'Last * 2);
+         Choices (1 .. Block.Choices'Last) := Block.Choices.all;
+         Free (Block.Choices);
+         Block.Choices := Choices;
+      end if;
+      Block.Nbr_Choices := Block.Nbr_Choices + 1;
+      Block.Choices (Block.Nbr_Choices) := (Low => Low,
+                                            High => High,
+                                            Bb => Block.BB_Choice);
+   end New_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) is
+   begin
+      New_Choice (Block, Expr.LLVM, Null_ValueRef);
+   end New_Expr_Choice;
+
+   ----------------------
+   -- New_Range_Choice --
+   ----------------------
+
+   procedure New_Range_Choice
+     (Block : in out O_Case_Block; Low, High : O_Cnode)
+   is
+   begin
+      New_Choice (Block, Low.LLVM, High.LLVM);
+   end New_Range_Choice;
+
+   ------------------------
+   -- New_Default_Choice --
+   ------------------------
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      Block.BB_Others := Block.BB_Choice;
+   end New_Default_Choice;
+
+   -------------------
+   -- Finish_Choice --
+   -------------------
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      null;
+   end Finish_Choice;
+
+   ----------------------
+   -- Finish_Case_Stmt --
+   ----------------------
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block)
+   is
+      Bb_Default : constant BasicBlockRef :=
+        AppendBasicBlock (Cur_Func, Empty_Cstring);
+      Bb_Default_Last : BasicBlockRef;
+      Nbr_Cases : unsigned := 0;
+      GE, LE : IntPredicate;
+      Res : ValueRef;
+   begin
+      if Block.BB_Choice /= Null_BasicBlockRef then
+         --  Close previous branch.
+         Finish_Branch (Block);
+      end if;
+
+      --  Strategy: use a switch instruction for simple choices, put range
+      --   choices in the default using if statements.
+      case Block.Vtype.Kind is
+         when ON_Unsigned_Type
+           | ON_Enum_Type
+           | ON_Boolean_Type =>
+            GE := IntUGE;
+            LE := IntULE;
+         when ON_Signed_Type =>
+            GE := IntSGE;
+            LE := IntSLE;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  BB for the default case of the LLVM switch.
+      PositionBuilderAtEnd (Builder, Bb_Default);
+      Bb_Default_Last := Bb_Default;
+
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High /= Null_ValueRef then
+               Bb_Default_Last := AppendBasicBlock (Cur_Func, Empty_Cstring);
+               Res := BuildCondBr (Builder,
+                                   BuildAnd (Builder,
+                                             BuildICmp (Builder, GE,
+                                                        Block.Value, C.Low,
+                                                        Empty_Cstring),
+                                             BuildICmp (Builder, LE,
+                                                        Block.Value, C.High,
+                                                        Empty_Cstring),
+                                             Empty_Cstring),
+                                   C.Bb, Bb_Default_Last);
+               PositionBuilderAtEnd (Builder, Bb_Default_Last);
+            else
+               Nbr_Cases := Nbr_Cases + 1;
+            end if;
+         end;
+      end loop;
+
+      --  Insert the switch
+      PositionBuilderAtEnd (Builder, Block.BB_Prev);
+      Res := BuildSwitch (Builder, Block.Value, Bb_Default, Nbr_Cases);
+      for I in 1 .. Block.Nbr_Choices loop
+         declare
+            C : O_Choice_Type renames Block.Choices (I);
+         begin
+            if C.High = Null_ValueRef then
+               AddCase (Res, C.Low, C.Bb);
+            end if;
+         end;
+      end loop;
+
+      --  Insert the others.
+      PositionBuilderAtEnd (Builder, Bb_Default_Last);
+      if Block.BB_Others /= Null_BasicBlockRef then
+         Res := BuildBr (Builder, Block.BB_Others);
+      else
+         Res := BuildUnreachable (Builder);
+      end if;
+
+      if Block.BB_Next /= Null_BasicBlockRef then
+         Unreach := False;
+         PositionBuilderAtEnd (Builder, Block.BB_Next);
+      else
+         Unreach := True;
+      end if;
+
+      Free (Block.Choices);
+   end Finish_Case_Stmt;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef is
+   begin
+      case Atype.Kind is
+         when ON_Incomplete_Record_Type
+           | ON_Incomplete_Access_Type =>
+            if Atype.LLVM = Null_TypeRef then
+               raise Program_Error with "early use of incomplete type";
+            end if;
+            return Atype.LLVM;
+         when ON_Union_Type
+           | ON_Scalar_Types
+           | ON_Access_Type
+           | ON_Array_Type
+           | ON_Array_Sub_Type
+           | ON_Record_Type =>
+            return Atype.LLVM;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Get_LLVM_Type;
+
+   procedure Finish_Debug is
+   begin
+      declare
+         Dbg_Cu : constant String := "llvm.dbg.cu" & ASCII.NUL;
+         Producer : constant String := "ortho llvm";
+         Vals : ValueRefArray (0 .. 12);
+      begin
+         Vals :=
+           (ConstInt (Int32Type, DW_TAG_Compile_Unit, 0),
+            Dbg_Current_Filedir,         --  1 file+dir
+            ConstInt (Int32Type, 1, 0),  --  2 language (C)
+            MDString (Producer),         --  3 producer
+            ConstInt (Int1Type, 0, 0),   --  4 isOpt
+            MDString (""),               --  5 flags
+            ConstInt (Int32Type, 0, 0),  --  6 runtime version
+            Null_ValueRef,               --  7 enum types
+            Null_ValueRef,               --  8 retained types
+            Get_Value (Subprg_Nodes),    --  9 subprograms
+            Get_Value (Global_Nodes),    --  10 global var
+            Null_ValueRef,               --  11 imported entities
+            Null_ValueRef);              --  12 split debug
+
+         AddNamedMetadataOperand
+           (Module, Dbg_Cu'Address, MDNode (Vals, Vals'Length));
+      end;
+
+      declare
+         Module_Flags : constant String := "llvm.module.flags" & ASCII.NUL;
+         Flags1 : ValueRefArray (0 .. 2);
+         Flags2 : ValueRefArray (0 .. 2);
+      begin
+         Flags1 := (ConstInt (Int32Type, 1, 0),
+                    MDString ("Debug Info Version"),
+                    ConstInt (Int32Type, 1, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags1, Flags1'Length));
+         Flags2 := (ConstInt (Int32Type, 2, 0),
+                    MDString ("Dwarf Version"),
+                    ConstInt (Int32Type, 2, 0));
+         AddNamedMetadataOperand
+           (Module, Module_Flags'Address, MDNode (Flags2, Flags2'Length));
+      end;
+   end Finish_Debug;
+
+   Dbg_Str : constant String := "dbg";
+
+   procedure Init is
+      --  Some predefined types and functions.
+      I8_Ptr_Type : TypeRef;
+   begin
+      Builder := CreateBuilder;
+      Decl_Builder := CreateBuilder;
+      Extra_Builder := CreateBuilder;
+
+      --  Create type i8 *.
+      I8_Ptr_Type := PointerType (Int8Type);
+
+      --  Create intrinsic 'i8 *stacksave (void)'.
+      Stacksave_Fun := AddFunction
+        (Module, Stacksave_Name'Address,
+         FunctionType (I8_Ptr_Type, (1 .. 0 => Null_TypeRef), 0, 0));
+
+      --  Create intrinsic 'void stackrestore (i8 *)'.
+      Stackrestore_Fun := AddFunction
+        (Module, Stackrestore_Name'Address,
+         FunctionType (VoidType, (1 => I8_Ptr_Type), 1, 0));
+
+      if Flag_Debug then
+         Debug_ID := GetMDKindID (Dbg_Str, Dbg_Str'Length);
+
+         declare
+            Atypes : TypeRefArray (1 .. 2);
+            Ftype : TypeRef;
+            Name : String := "llvm.dbg.declare" & ASCII.NUL;
+         begin
+            Atypes := (MetadataType, MetadataType);
+            Ftype := FunctionType (VoidType, Atypes, Atypes'Length, 0);
+            Llvm_Dbg_Declare := AddFunction (Module, Name'Address, Ftype);
+            AddFunctionAttr (Llvm_Dbg_Declare,
+                             NoUnwindAttribute + ReadNoneAttribute);
+         end;
+      end if;
+   end Init;
+
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_llvm.ads b/src/ortho/llvm/ortho_llvm.ads
new file mode 100644
index 000000000..8e68eb139
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.ads
@@ -0,0 +1,737 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_llvm.private.ads
+--
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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 Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
+
+--  Interface to create nodes.
+package Ortho_LLVM is
+   procedure Init;
+   procedure Finish_Debug;
+
+   --  LLVM specific: the module.
+   Module : ModuleRef;
+
+   --  Descriptor for the layout.
+   Target_Data : LLVM.Target.TargetDataRef;
+
+   Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+   --  Optimization level
+   Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+     LLVM.TargetMachine.CodeGenLevelDefault;
+
+   --  Set by -g to generate debug info.
+   Flag_Debug : Boolean := False;
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  No support for nested subprograms in LLVM.
+   Has_Nested_Subprograms : constant Boolean := False;
+
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+   O_Tnode_Null : constant O_Tnode := null;
+
+   type ON_Type_Kind is
+     (ON_No_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Enum_Type, ON_Boolean_Type,
+      ON_Float_Type,
+      ON_Array_Type, ON_Array_Sub_Type,
+      ON_Incomplete_Record_Type,
+      ON_Record_Type, ON_Union_Type,
+      ON_Incomplete_Access_Type, ON_Access_Type);
+
+   subtype ON_Scalar_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Float_Type;
+
+   subtype ON_Integer_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Boolean_Type;
+
+   type O_Tnode_Type (Kind : ON_Type_Kind := ON_No_Type) is record
+      LLVM : TypeRef;
+      Dbg : ValueRef;
+      case Kind is
+         when ON_No_Type =>
+            null;
+         when ON_Union_Type =>
+            Un_Size : unsigned;
+            Un_Main_Field : TypeRef;
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Acc_Type : O_Tnode;
+         when ON_Scalar_Types =>
+            Scal_Size : Natural;
+         when ON_Array_Type
+           | ON_Array_Sub_Type =>
+            --  Type of the element
+            Arr_El_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Incomplete_Record_Type =>
+            null;
+      end case;
+   end record;
+
+   type O_Inter;
+   type O_Inter_Acc is access O_Inter;
+   type O_Inter is record
+      Itype : O_Tnode;
+      Ival : ValueRef;
+      Ident : O_Ident;
+      Next : O_Inter_Acc;
+   end record;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl,
+      ON_Var_Decl, ON_Local_Decl, ON_Interface_Decl,
+      ON_Subprg_Decl,
+      ON_No_Decl);
+
+   type O_Dnode (Kind : On_Decl_Kind := ON_No_Decl) is record
+      Dtype : O_Tnode;
+      LLVM : ValueRef;
+      case Kind is
+         when ON_Var_Decl
+           | ON_Const_Decl
+           | ON_Local_Decl =>
+            null;
+         when ON_Subprg_Decl =>
+            Subprg_Id : O_Ident;
+            Nbr_Args : unsigned;
+            Subprg_Inters : O_Inter_Acc;
+         when ON_Interface_Decl =>
+            Inter : O_Inter_Acc;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   O_Dnode_Null : constant O_Dnode := (Kind => ON_No_Decl,
+                                       Dtype => O_Tnode_Null,
+                                       LLVM => Null_ValueRef);
+
+   type OF_Kind is (OF_None, OF_Record, OF_Union);
+   type O_Fnode (Kind : OF_Kind := OF_None) is record
+      Ftype : O_Tnode;
+      case Kind is
+         when OF_None =>
+            null;
+         when OF_Record =>
+            Index : Natural;
+         when OF_Union =>
+            Utype : TypeRef;
+      end case;
+   end record;
+
+   O_Fnode_Null : constant O_Fnode := (Kind => OF_None,
+                                       Ftype => O_Tnode_Null);
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type O_Cnode is record
+      LLVM : ValueRef;
+      Ctype : O_Tnode;
+   end record;
+   O_Cnode_Null : constant O_Cnode := (LLVM => Null_ValueRef,
+                                       Ctype => O_Tnode_Null);
+
+   type O_Enode is record
+      LLVM : ValueRef;
+      Etype : O_Tnode;
+   end record;
+   O_Enode_Null : constant O_Enode := (LLVM => Null_ValueRef,
+                                       Etype => O_Tnode_Null);
+
+
+   type O_Lnode is record
+      --  If True, the LLVM component is the value (used for arguments).
+      --  If False, the LLVM component is the address of the value (used
+      --   for everything else).
+      Direct : Boolean;
+      LLVM : ValueRef;
+      Ltype : O_Tnode;
+   end record;
+
+   O_Lnode_Null : constant O_Lnode := (False, Null_ValueRef, O_Tnode_Null);
+
+   type O_Snode is record
+      --  First BB in the loop body.
+      Bb_Entry : BasicBlockRef;
+
+      --  BB after the loop.
+      Bb_Exit : BasicBlockRef;
+   end record;
+
+   O_Snode_Null : constant O_Snode := (Null_BasicBlockRef,
+                                       Null_BasicBlockRef);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Res_Type : O_Tnode;
+      Nbr_Inter : Natural;
+      First_Inter, Last_Inter : O_Inter_Acc;
+   end record;
+
+   type O_Element;
+   type O_Element_Acc is access O_Element;
+   type O_Element is record
+      --  Identifier for the element
+      Ident : O_Ident;
+
+      --  Type of the element
+      Etype : O_Tnode;
+
+      --  Next element (in the linked list)
+      Next : O_Element_Acc;
+   end record;
+
+   --  Record and union builder.
+   type O_Element_List is record
+      Nbr_Elements : Natural;
+
+      --  For record: the access to the incomplete (but named) type.
+      Rec_Type : O_Tnode;
+
+      --  For unions: biggest for size and alignment
+      Size : unsigned;
+      Align : Unsigned_32;
+      Align_Type : TypeRef;
+
+      First_Elem, Last_Elem : O_Element_Acc;
+   end record;
+
+   type ValueRefArray_Acc is access ValueRefArray;
+
+   type O_Record_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+      El_Type : TypeRef;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Idx : unsigned;
+      Vals : ValueRefArray_Acc;
+   end record;
+
+   type O_Enum_List is record
+      LLVM : TypeRef;
+      Num : Natural;
+      Etype : O_Tnode;
+   end record;
+
+   type O_Choice_Type is record
+      Low, High : ValueRef;
+      Bb : BasicBlockRef;
+   end record;
+
+   type O_Choice_Array is array (Natural range <>) of O_Choice_Type;
+   type O_Choice_Array_Acc is access O_Choice_Array;
+
+   type O_Case_Block is record
+      --  BB before the case.
+      BB_Prev : BasicBlockRef;
+
+      --  Select expression
+      Value : ValueRef;
+      Vtype : O_Tnode;
+
+      --  BB after the case statement.
+      BB_Next : BasicBlockRef;
+
+      --  BB for others
+      BB_Others : BasicBlockRef;
+
+      --  BB for the current choice
+      BB_Choice : BasicBlockRef;
+
+      --  List of choices.
+      Nbr_Choices : Natural;
+      Choices : O_Choice_Array_Acc;
+   end record;
+
+   type O_If_Block is record
+      --  The next basic block.
+      --  After the 'If', this is the BB for the else part.  If there is no
+      --   else part, this is the BB for statements after the if.
+      --  After the 'else', this is the BB for statements after the if.
+      Bb : BasicBlockRef;
+   end record;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_llvm.private.ads b/src/ortho/llvm/ortho_llvm.private.ads
new file mode 100644
index 000000000..842a119b5
--- /dev/null
+++ b/src/ortho/llvm/ortho_llvm.private.ads
@@ -0,0 +1,305 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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 Interfaces; use Interfaces;
+with Interfaces.C; use Interfaces.C;
+with Ortho_Ident; use Ortho_Ident;
+with LLVM.Core; use LLVM.Core;
+with LLVM.TargetMachine;
+with LLVM.Target;
+
+--  Interface to create nodes.
+package Ortho_LLVM is
+   procedure Init;
+   procedure Finish_Debug;
+
+   --  LLVM specific: the module.
+   Module : ModuleRef;
+
+   --  Descriptor for the layout.
+   Target_Data : LLVM.Target.TargetDataRef;
+
+   Target_Machine : LLVM.TargetMachine.TargetMachineRef;
+
+   --  Optimization level
+   Optimization : LLVM.TargetMachine.CodeGenOptLevel :=
+     LLVM.TargetMachine.CodeGenLevelDefault;
+
+   --  Set by -g to generate debug info.
+   Flag_Debug : Boolean := False;
+
+private
+   --  No support for nested subprograms in LLVM.
+   Has_Nested_Subprograms : constant Boolean := False;
+
+   type O_Tnode_Type (<>);
+   type O_Tnode is access O_Tnode_Type;
+   O_Tnode_Null : constant O_Tnode := null;
+
+   type ON_Type_Kind is
+     (ON_No_Type,
+      ON_Unsigned_Type, ON_Signed_Type, ON_Enum_Type, ON_Boolean_Type,
+      ON_Float_Type,
+      ON_Array_Type, ON_Array_Sub_Type,
+      ON_Incomplete_Record_Type,
+      ON_Record_Type, ON_Union_Type,
+      ON_Incomplete_Access_Type, ON_Access_Type);
+
+   subtype ON_Scalar_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Float_Type;
+
+   subtype ON_Integer_Types is ON_Type_Kind range
+     ON_Unsigned_Type .. ON_Boolean_Type;
+
+   type O_Tnode_Type (Kind : ON_Type_Kind := ON_No_Type) is record
+      LLVM : TypeRef;
+      Dbg : ValueRef;
+      case Kind is
+         when ON_No_Type =>
+            null;
+         when ON_Union_Type =>
+            Un_Size : unsigned;
+            Un_Main_Field : TypeRef;
+         when ON_Access_Type
+           | ON_Incomplete_Access_Type =>
+            Acc_Type : O_Tnode;
+         when ON_Scalar_Types =>
+            Scal_Size : Natural;
+         when ON_Array_Type
+           | ON_Array_Sub_Type =>
+            --  Type of the element
+            Arr_El_Type : O_Tnode;
+         when ON_Record_Type
+           | ON_Incomplete_Record_Type =>
+            null;
+      end case;
+   end record;
+
+   type O_Inter;
+   type O_Inter_Acc is access O_Inter;
+   type O_Inter is record
+      Itype : O_Tnode;
+      Ival : ValueRef;
+      Ident : O_Ident;
+      Next : O_Inter_Acc;
+   end record;
+
+   type On_Decl_Kind is
+     (ON_Type_Decl, ON_Completed_Type_Decl,
+      ON_Const_Decl,
+      ON_Var_Decl, ON_Local_Decl, ON_Interface_Decl,
+      ON_Subprg_Decl,
+      ON_No_Decl);
+
+   type O_Dnode (Kind : On_Decl_Kind := ON_No_Decl) is record
+      Dtype : O_Tnode;
+      LLVM : ValueRef;
+      case Kind is
+         when ON_Var_Decl
+           | ON_Const_Decl
+           | ON_Local_Decl =>
+            null;
+         when ON_Subprg_Decl =>
+            Subprg_Id : O_Ident;
+            Nbr_Args : unsigned;
+            Subprg_Inters : O_Inter_Acc;
+         when ON_Interface_Decl =>
+            Inter : O_Inter_Acc;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   O_Dnode_Null : constant O_Dnode := (Kind => ON_No_Decl,
+                                       Dtype => O_Tnode_Null,
+                                       LLVM => Null_ValueRef);
+
+   type OF_Kind is (OF_None, OF_Record, OF_Union);
+   type O_Fnode (Kind : OF_Kind := OF_None) is record
+      Ftype : O_Tnode;
+      case Kind is
+         when OF_None =>
+            null;
+         when OF_Record =>
+            Index : Natural;
+         when OF_Union =>
+            Utype : TypeRef;
+      end case;
+   end record;
+
+   O_Fnode_Null : constant O_Fnode := (Kind => OF_None,
+                                       Ftype => O_Tnode_Null);
+
+   type O_Anode_Type;
+   type O_Anode is access O_Anode_Type;
+   type O_Anode_Type is record
+      Next : O_Anode;
+      Formal : O_Dnode;
+      Actual : O_Enode;
+   end record;
+
+   type O_Cnode is record
+      LLVM : ValueRef;
+      Ctype : O_Tnode;
+   end record;
+   O_Cnode_Null : constant O_Cnode := (LLVM => Null_ValueRef,
+                                       Ctype => O_Tnode_Null);
+
+   type O_Enode is record
+      LLVM : ValueRef;
+      Etype : O_Tnode;
+   end record;
+   O_Enode_Null : constant O_Enode := (LLVM => Null_ValueRef,
+                                       Etype => O_Tnode_Null);
+
+
+   type O_Lnode is record
+      --  If True, the LLVM component is the value (used for arguments).
+      --  If False, the LLVM component is the address of the value (used
+      --   for everything else).
+      Direct : Boolean;
+      LLVM : ValueRef;
+      Ltype : O_Tnode;
+   end record;
+
+   O_Lnode_Null : constant O_Lnode := (False, Null_ValueRef, O_Tnode_Null);
+
+   type O_Snode is record
+      --  First BB in the loop body.
+      Bb_Entry : BasicBlockRef;
+
+      --  BB after the loop.
+      Bb_Exit : BasicBlockRef;
+   end record;
+
+   O_Snode_Null : constant O_Snode := (Null_BasicBlockRef,
+                                       Null_BasicBlockRef);
+
+   type O_Inter_List is record
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Res_Type : O_Tnode;
+      Nbr_Inter : Natural;
+      First_Inter, Last_Inter : O_Inter_Acc;
+   end record;
+
+   type O_Element;
+   type O_Element_Acc is access O_Element;
+   type O_Element is record
+      --  Identifier for the element
+      Ident : O_Ident;
+
+      --  Type of the element
+      Etype : O_Tnode;
+
+      --  Next element (in the linked list)
+      Next : O_Element_Acc;
+   end record;
+
+   --  Record and union builder.
+   type O_Element_List is record
+      Nbr_Elements : Natural;
+
+      --  For record: the access to the incomplete (but named) type.
+      Rec_Type : O_Tnode;
+
+      --  For unions: biggest for size and alignment
+      Size : unsigned;
+      Align : Unsigned_32;
+      Align_Type : TypeRef;
+
+      First_Elem, Last_Elem : O_Element_Acc;
+   end record;
+
+   type ValueRefArray_Acc is access ValueRefArray;
+
+   type O_Record_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Array_Aggr_List is record
+      --  Current number of elements in Vals.
+      Len : unsigned;
+
+      --  Value of elements.
+      Vals : ValueRefArray_Acc;
+      El_Type : TypeRef;
+
+      --  Type of the aggregate.
+      Atype : O_Tnode;
+   end record;
+
+   type O_Assoc_List is record
+      Subprg : O_Dnode;
+      Idx : unsigned;
+      Vals : ValueRefArray_Acc;
+   end record;
+
+   type O_Enum_List is record
+      LLVM : TypeRef;
+      Num : Natural;
+      Etype : O_Tnode;
+   end record;
+
+   type O_Choice_Type is record
+      Low, High : ValueRef;
+      Bb : BasicBlockRef;
+   end record;
+
+   type O_Choice_Array is array (Natural range <>) of O_Choice_Type;
+   type O_Choice_Array_Acc is access O_Choice_Array;
+
+   type O_Case_Block is record
+      --  BB before the case.
+      BB_Prev : BasicBlockRef;
+
+      --  Select expression
+      Value : ValueRef;
+      Vtype : O_Tnode;
+
+      --  BB after the case statement.
+      BB_Next : BasicBlockRef;
+
+      --  BB for others
+      BB_Others : BasicBlockRef;
+
+      --  BB for the current choice
+      BB_Choice : BasicBlockRef;
+
+      --  List of choices.
+      Nbr_Choices : Natural;
+      Choices : O_Choice_Array_Acc;
+   end record;
+
+   type O_If_Block is record
+      --  The next basic block.
+      --  After the 'If', this is the BB for the else part.  If there is no
+      --   else part, this is the BB for statements after the if.
+      --  After the 'else', this is the BB for statements after the if.
+      Bb : BasicBlockRef;
+   end record;
+
+   function Get_LLVM_Type (Atype : O_Tnode) return TypeRef;
+end Ortho_LLVM;
diff --git a/src/ortho/llvm/ortho_nodes.ads b/src/ortho/llvm/ortho_nodes.ads
new file mode 100644
index 000000000..34d1dbbc9
--- /dev/null
+++ b/src/ortho/llvm/ortho_nodes.ads
@@ -0,0 +1,20 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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 Ortho_LLVM;
+package Ortho_Nodes renames Ortho_LLVM;
diff --git a/src/ortho/mcode/Makefile b/src/ortho/mcode/Makefile
new file mode 100644
index 000000000..19d5d26aa
--- /dev/null
+++ b/src/ortho/mcode/Makefile
@@ -0,0 +1,37 @@
+ortho_srcdir=..
+GNAT_FLAGS=-gnaty3befhkmr -gnata -gnatf -gnatwlcru -gnat05
+CC=gcc
+BE=mcode
+SED=sed
+
+all: $(ortho_exec)
+
+$(ortho_exec): $(ortho_srcdir)/mcode/ortho_mcode.ads memsegs_c.o force
+	gnatmake -m -o $@ -g -aI$(ortho_srcdir)/mcode -aI$(ortho_srcdir) \
+	$(GNAT_FLAGS) ortho_code_main -bargs -E -largs memsegs_c.o #-static
+
+memsegs_c.o: $(ortho_srcdir)/mcode/memsegs_c.c
+	$(CC) -c $(CFLAGS) -o $@ $<
+
+oread: force
+	gnatmake -m -o $@ -g $(GNAT_FLAGS) -aI../oread ortho_code_main -aI.. -largs memsegs_c.o
+
+elfdump: force
+	gnatmake -m -g $(GNAT_FLAGS) $@
+
+coffdump: force
+	gnatmake -m $(GNAT_FLAGS) $@
+
+clean:
+	$(RM) -f *.o *.ali ortho_code_main elfdump
+	$(RM) b~*.ad? *~
+
+distclean: clean
+
+
+force:
+
+.PHONY: force all clean
+
+ORTHO_BASENAME=ortho_mcode
+include $(ortho_srcdir)/Makefile.inc
diff --git a/src/ortho/mcode/binary_file-coff.adb b/src/ortho/mcode/binary_file-coff.adb
new file mode 100644
index 000000000..cf3cba3f4
--- /dev/null
+++ b/src/ortho/mcode/binary_file-coff.adb
@@ -0,0 +1,407 @@
+--  Binary file COFF writer.
+--  Copyright (C) 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 Ada.Characters.Latin_1;
+with Coff; use Coff;
+
+package body Binary_File.Coff is
+   NUL : Character renames Ada.Characters.Latin_1.NUL;
+
+   procedure Write_Coff (Fd : GNAT.OS_Lib.File_Descriptor)
+   is
+      use GNAT.OS_Lib;
+
+      procedure Xwrite (Data : System.Address; Len : Natural) is
+      begin
+         if Write (Fd, Data, Len) /= Len then
+            raise Write_Error;
+         end if;
+      end Xwrite;
+
+      type Section_Info_Type is record
+         Sect : Section_Acc;
+         --  File offset for the data.
+         Data_Offset : Natural;
+         --  File offset for the relocs.
+         Reloc_Offset : Natural;
+         --  Number of relocs to write.
+         Nbr_Relocs : Natural;
+      end record;
+      type Section_Info_Array is array (Natural range <>) of Section_Info_Type;
+      Sections : Section_Info_Array (1 .. Nbr_Sections + 3);
+      Nbr_Sect : Natural;
+      Sect_Text : constant Natural := 1;
+      Sect_Data : constant Natural := 2;
+      Sect_Bss : constant Natural := 3;
+      Sect : Section_Acc;
+
+      --Section_Align : constant Natural := 2;
+
+      Offset : Natural;
+      Symtab_Offset : Natural;
+      --  Number of symtab entries.
+      Nbr_Symbols : Natural;
+      Strtab_Offset : Natural;
+
+      function Gen_String (Str : String) return Sym_Name
+      is
+         Res : Sym_Name;
+      begin
+         if Str'Length <= 8 then
+            Res.E_Name := (others => NUL);
+            Res.E_Name (1 .. Str'Length) := Str;
+         else
+            Res.E := (E_Zeroes => 0, E_Offset => Unsigned_32 (Offset));
+            Offset := Offset + Str'Length + 1;
+         end if;
+         return Res;
+      end Gen_String;
+
+      --  Well known sections name.
+      type String_Array is array (Sect_Text .. Sect_Bss) of String (1 .. 8);
+      Sect_Name : constant String_Array :=
+        (Sect_Text => ".text" & NUL & NUL & NUL,
+         Sect_Data => ".data" & NUL & NUL & NUL,
+         Sect_Bss => ".bss" & NUL & NUL & NUL & NUL);
+      type Unsigned32_Array is array (Sect_Text .. Sect_Bss) of Unsigned_32;
+      Sect_Flags : constant Unsigned32_Array :=
+        (Sect_Text => STYP_TEXT,
+         Sect_Data => STYP_DATA,
+         Sect_Bss => STYP_BSS);
+
+      --  If true, do local relocs.
+      Flag_Reloc : constant Boolean := True;
+      --  If true, discard local symbols;
+      Flag_Discard_Local : Boolean := True;
+   begin
+      --  If relocations are not performs, then local symbols cannot be
+      --  discarded.
+      if not Flag_Reloc then
+         Flag_Discard_Local := False;
+      end if;
+
+      --  Fill sections.
+      Sect := Section_Chain;
+      Nbr_Sect := 3;
+      declare
+         N : Natural;
+      begin
+         while Sect /= null loop
+            if Sect.Name.all = ".text" then
+               N := Sect_Text;
+            elsif Sect.Name.all = ".data" then
+               N := Sect_Data;
+            elsif Sect.Name.all = ".bss" then
+               N := Sect_Bss;
+            else
+               Nbr_Sect := Nbr_Sect + 1;
+               N := Nbr_Sect;
+            end if;
+            Sections (N).Sect := Sect;
+            Sect.Number := N;
+            Sect := Sect.Next;
+         end loop;
+      end;
+
+      --  Set data offset.
+      Offset := Filehdr_Size + Nbr_Sect * Scnhdr_Size;
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null
+           and then Sections (I).Sect.Data /= null
+         then
+            Sections (I).Data_Offset := Offset;
+            Offset := Offset + Natural (Sections (I).Sect.Pc);
+         else
+            Sections (I).Data_Offset := 0;
+         end if;
+      end loop;
+
+      --  Set relocs offset.
+      declare
+         Rel : Reloc_Acc;
+      begin
+         for I in 1 .. Nbr_Sect loop
+            Sections (I).Nbr_Relocs := 0;
+            if Sections (I).Sect /= null then
+               Sections (I).Reloc_Offset := Offset;
+               if not Flag_Reloc then
+                  --  Do local relocations.
+                  Rel := Sections (I).Sect.First_Reloc;
+                  while Rel /= null loop
+                     if S_Local (Rel.Sym) then
+                        if Get_Section (Rel.Sym) = Sections (I).Sect
+                        then
+                           --  Intra section local reloc.
+                           Apply_Reloc (Sections (I).Sect, Rel);
+                        else
+                           --  Inter section local reloc.
+                           --  A relocation is still required.
+                           Sections (I).Nbr_Relocs :=
+                             Sections (I).Nbr_Relocs + 1;
+                           --  FIXME: todo.
+                           raise Program_Error;
+                        end if;
+                     else
+                        Sections (I).Nbr_Relocs := Sections (I).Nbr_Relocs + 1;
+                     end if;
+                     Rel := Rel.Sect_Next;
+                  end loop;
+               else
+                  Sections (I).Nbr_Relocs := Sections (I).Sect.Nbr_Relocs;
+               end if;
+               Offset := Offset + Sections (I).Nbr_Relocs * Relsz;
+            else
+               Sections (I).Reloc_Offset := 0;
+            end if;
+         end loop;
+      end;
+
+      Symtab_Offset := Offset;
+      Nbr_Symbols := 2 + Nbr_Sect * 2; --  2 for file.
+      for I in Symbols.First .. Symbols.Last loop
+         Set_Number (I, Nbr_Symbols);
+         Nbr_Symbols := Nbr_Symbols + 1;
+      end loop;
+      Offset := Offset + Nbr_Symbols * Symesz;
+      Strtab_Offset := Offset;
+      Offset := Offset + 4;
+
+      --  Write file header.
+      declare
+         Hdr : Filehdr;
+      begin
+         Hdr.F_Magic := I386magic;
+         Hdr.F_Nscns := Unsigned_16 (Nbr_Sect);
+         Hdr.F_Timdat := 0;
+         Hdr.F_Symptr := Unsigned_32 (Symtab_Offset);
+         Hdr.F_Nsyms := Unsigned_32 (Nbr_Symbols);
+         Hdr.F_Opthdr := 0;
+         Hdr.F_Flags := F_Lnno;
+         Xwrite (Hdr'Address, Filehdr_Size);
+      end;
+
+      --  Write sections header.
+      for I in 1 .. Nbr_Sect loop
+         declare
+            Hdr : Scnhdr;
+            L : Natural;
+         begin
+            case I is
+               when Sect_Text
+                 | Sect_Data
+                 | Sect_Bss =>
+                  Hdr.S_Name := Sect_Name (I);
+                  Hdr.S_Flags := Sect_Flags (I);
+               when others =>
+                  Hdr.S_Flags := 0;
+                  L := Sections (I).Sect.Name'Length;
+                  if L > Hdr.S_Name'Length then
+                     Hdr.S_Name := Sections (I).Sect.Name
+                       (Sections (I).Sect.Name'First ..
+                        Sections (I).Sect.Name'First + Hdr.S_Name'Length - 1);
+                  else
+                     Hdr.S_Name (1 .. L) := Sections (I).Sect.Name.all;
+                     Hdr.S_Name (L + 1 .. Hdr.S_Name'Last) := (others => NUL);
+                  end if;
+            end case;
+            Hdr.S_Paddr := 0;
+            Hdr.S_Vaddr := 0;
+            Hdr.S_Scnptr := Unsigned_32 (Sections (I).Data_Offset);
+            Hdr.S_Relptr := Unsigned_32 (Sections (I).Reloc_Offset);
+            Hdr.S_Lnnoptr := 0;
+            Hdr.S_Nreloc := Unsigned_16 (Sections (I).Nbr_Relocs);
+            if Sections (I).Sect /= null then
+               Hdr.S_Size := Unsigned_32 (Sections (I).Sect.Pc);
+            else
+               Hdr.S_Size := 0;
+            end if;
+            Hdr.S_Nlnno := 0;
+            Xwrite (Hdr'Address, Scnhdr_Size);
+         end;
+      end loop;
+
+      --  Write sections content.
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null
+           and then Sections (I).Sect.Data /= null
+         then
+            Xwrite (Sections (I).Sect.Data (0)'Address,
+                    Natural (Sections (I).Sect.Pc));
+         end if;
+      end loop;
+
+      --  Write sections reloc.
+      for I in 1 .. Nbr_Sect loop
+         if Sections (I).Sect /= null then
+            declare
+               R : Reloc_Acc;
+               Rel : Reloc;
+            begin
+               R := Sections (I).Sect.First_Reloc;
+               while R /= null loop
+                  case R.Kind is
+                     when Reloc_32 =>
+                        Rel.R_Type := Reloc_Addr32;
+                     when Reloc_Pc32 =>
+                        Rel.R_Type := Reloc_Rel32;
+                     when others =>
+                        raise Program_Error;
+                  end case;
+                  Rel.R_Vaddr := Unsigned_32 (R.Addr);
+                  Rel.R_Symndx := Unsigned_32 (Get_Number (R.Sym));
+                  Xwrite (Rel'Address, Relsz);
+                  R := R.Sect_Next;
+               end loop;
+            end;
+         end if;
+      end loop;
+
+      --  Write symtab.
+      --   Write file symbol + aux
+      declare
+         Sym : Syment;
+         A_File : Auxent_File;
+      begin
+         Sym := (E => (Inline => True,
+                       E_Name => ".file" & NUL & NUL & NUL),
+                 E_Value => 0,
+                 E_Scnum => N_DEBUG,
+                 E_Type => 0,
+                 E_Sclass => C_FILE,
+                 E_Numaux => 1);
+         Xwrite (Sym'Address, Symesz);
+         A_File := (Inline => True,
+                    X_Fname => "testfile.xxxxx");
+         Xwrite (A_File'Address, Symesz);
+      end;
+      --   Write sections symbol + aux
+      for I in 1 .. Nbr_Sect loop
+         declare
+            A_Scn : Auxent_Scn;
+            Sym : Syment;
+         begin
+            Sym := (E => (Inline => True, E_Name => (others => NUL)),
+                    E_Value => 0,
+                    E_Scnum => Unsigned_16 (I),
+                    E_Type => 0,
+                    E_Sclass => C_STAT,
+                    E_Numaux => 1);
+            if I <= Sect_Bss then
+               Sym.E.E_Name := Sect_Name (I);
+            else
+               Sym.E := Gen_String (Sections (I).Sect.Name.all);
+            end if;
+            Xwrite (Sym'Address, Symesz);
+            if Sections (I).Sect /= null
+              and then Sections (I).Sect.Data /= null
+            then
+               A_Scn :=
+                 (X_Scnlen => Unsigned_32 (Sections (I).Sect.Pc),
+                  X_Nreloc => Unsigned_16 (Sections (I).Nbr_Relocs),
+                  X_Nlinno => 0);
+            else
+               A_Scn := (X_Scnlen => 0, X_Nreloc => 0, X_Nlinno => 0);
+            end if;
+            Xwrite (A_Scn'Address, Symesz);
+         end;
+      end loop;
+
+      --   Write symbols.
+      declare
+         procedure Write_Symbol (S : Symbol)
+         is
+            Sym : Syment;
+         begin
+            Sym := (E => Gen_String (Get_Symbol_Name (S)),
+                    E_Value => Unsigned_32 (Get_Symbol_Value (S)),
+                    E_Scnum => 0,
+                    E_Type => 0,
+                    E_Sclass => C_EXT,
+                    E_Numaux => 0);
+            case Get_Scope (S) is
+               when Sym_Local
+                 | Sym_Private =>
+                  Sym.E_Sclass := C_STAT;
+               when Sym_Undef
+                 | Sym_Global =>
+                  Sym.E_Sclass := C_EXT;
+            end case;
+            if Get_Section (S) /= null then
+               Sym.E_Scnum := Unsigned_16 (Get_Section (S).Number);
+            end if;
+            Xwrite (Sym'Address, Symesz);
+         end Write_Symbol;
+      begin
+         --  First the non-local symbols (1).
+         for I in Symbols.First .. Symbols.Last loop
+            if Get_Scope (I) in Symbol_Scope_External then
+               Write_Symbol (I);
+            end if;
+         end loop;
+         --  Then the local symbols (2).
+         if not Flag_Discard_Local then
+            for I in Symbols.First .. Symbols.Last loop
+               if Get_Scope (I) not in Symbol_Scope_External then
+                  Write_Symbol (I);
+               end if;
+            end loop;
+         end if;
+      end;
+
+      --  Write strtab.
+      --    Write strtab length.
+      declare
+         L : Unsigned_32;
+
+         procedure Write_String (Str : String) is
+         begin
+            if Str (Str'Last) /= NUL then
+               raise Program_Error;
+            end if;
+            if Str'Length <= 9 then
+               return;
+            end if;
+            Xwrite (Str'Address, Str'Length);
+            Strtab_Offset := Strtab_Offset + Str'Length;
+         end Write_String;
+      begin
+         L := Unsigned_32 (Offset - Strtab_Offset);
+         Xwrite (L'Address, 4);
+
+         --  Write section name string.
+         for I in Sect_Bss + 1 .. Nbr_Sect loop
+            if Sections (I).Sect /= null
+              and then Sections (I).Sect.Name'Length > 8
+            then
+               Write_String (Sections (I).Sect.Name.all & NUL);
+            end if;
+         end loop;
+
+         for I in Symbols.First .. Symbols.Last loop
+            declare
+               Str : constant String := Get_Symbol_Name (I);
+            begin
+               Write_String (Str & NUL);
+            end;
+         end loop;
+         if Strtab_Offset + 4 /= Offset then
+            raise Program_Error;
+         end if;
+      end;
+   end Write_Coff;
+
+end Binary_File.Coff;
diff --git a/src/ortho/mcode/binary_file-coff.ads b/src/ortho/mcode/binary_file-coff.ads
new file mode 100644
index 000000000..e671555ea
--- /dev/null
+++ b/src/ortho/mcode/binary_file-coff.ads
@@ -0,0 +1,23 @@
+--  Binary file COFF writer.
+--  Copyright (C) 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 GNAT.OS_Lib;
+
+package Binary_File.Coff is
+   procedure Write_Coff (Fd : GNAT.OS_Lib.File_Descriptor);
+end Binary_File.Coff;
+
diff --git a/src/ortho/mcode/binary_file-elf.adb b/src/ortho/mcode/binary_file-elf.adb
new file mode 100644
index 000000000..329dbacd3
--- /dev/null
+++ b/src/ortho/mcode/binary_file-elf.adb
@@ -0,0 +1,679 @@
+--  Binary file ELF writer.
+--  Copyright (C) 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 Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with Elf_Common;
+with Elf32;
+
+package body Binary_File.Elf is
+   NUL : Character renames Ada.Characters.Latin_1.NUL;
+
+   type Arch_Bool is array (Arch_Kind) of Boolean;
+   Is_Rela : constant Arch_Bool := (Arch_Unknown => False,
+                                    Arch_X86 => False,
+                                    Arch_Sparc => True,
+                                    Arch_Ppc => True);
+
+   procedure Write_Elf (Fd : GNAT.OS_Lib.File_Descriptor)
+   is
+      use Elf_Common;
+      use Elf32;
+      use GNAT.OS_Lib;
+
+      procedure Xwrite (Data : System.Address; Len : Natural) is
+      begin
+         if Write (Fd, Data, Len) /= Len then
+            raise Write_Error;
+         end if;
+      end Xwrite;
+
+      procedure Check_File_Pos (Off : Elf32_Off)
+      is
+         L : Long_Integer;
+      begin
+         L := File_Length (Fd);
+         if L /= Long_Integer (Off) then
+            Put_Line (Standard_Error, "check_file_pos error: expect "
+                      & Elf32_Off'Image (Off) & ", found "
+                      & Long_Integer'Image (L));
+            raise Write_Error;
+         end if;
+      end Check_File_Pos;
+
+      function Sect_Align (V : Elf32_Off) return Elf32_Off
+      is
+         Tmp : Elf32_Off;
+      begin
+         Tmp := V + 2 ** 2 - 1;
+         return Tmp - (Tmp mod 2 ** 2);
+      end Sect_Align;
+
+      type Section_Info_Type is record
+         Sect : Section_Acc;
+         --  Index of the section symbol (in symtab).
+         Sym : Elf32_Word;
+         --  Number of relocs to write.
+         --Nbr_Relocs : Natural;
+      end record;
+      type Section_Info_Array is array (Natural range <>) of Section_Info_Type;
+      Sections : Section_Info_Array (0 .. 3 + 2 * Nbr_Sections);
+      type Elf32_Shdr_Array is array (Natural range <>) of Elf32_Shdr;
+      Shdr : Elf32_Shdr_Array (0 .. 3 + 2 * Nbr_Sections);
+      Nbr_Sect : Natural;
+      Sect : Section_Acc;
+
+      --  The first 4 sections are always present.
+      Sect_Null : constant Natural := 0;
+      Sect_Shstrtab : constant Natural := 1;
+      Sect_Symtab : constant Natural := 2;
+      Sect_Strtab : constant Natural := 3;
+      Sect_First : constant Natural := 4;
+
+      Offset : Elf32_Off;
+
+      --  Size of a relocation entry.
+      Rel_Size : Natural;
+
+      --  If true, do local relocs.
+      Flag_Reloc : constant Boolean := True;
+      --  If true, discard local symbols;
+      Flag_Discard_Local : Boolean := True;
+
+      --  Number of symbols.
+      Nbr_Symbols : Natural := 0;
+   begin
+      --  If relocations are not performs, then local symbols cannot be
+      --  discarded.
+      if not Flag_Reloc then
+         Flag_Discard_Local := False;
+      end if;
+
+      --  Set size of a relocation entry.  This avoids severals conditionnal.
+      if Is_Rela (Arch) then
+         Rel_Size := Elf32_Rela_Size;
+      else
+         Rel_Size := Elf32_Rel_Size;
+      end if;
+
+      --  Set section header.
+
+      --  SHT_NULL.
+      Shdr (Sect_Null) :=
+        Elf32_Shdr'(Sh_Name => 0,
+                    Sh_Type => SHT_NULL,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 0,
+                    Sh_Entsize => 0);
+
+      --  shstrtab.
+      Shdr (Sect_Shstrtab) :=
+        Elf32_Shdr'(Sh_Name => 1,
+                    Sh_Type => SHT_STRTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,     --  Filled latter.
+      --  NUL: 1, .symtab: 8, .strtab: 8 and .shstrtab: 10.
+                    Sh_Size => 1 + 10 + 8 + 8,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 1,
+                    Sh_Entsize => 0);
+
+      --  Symtab
+      Shdr (Sect_Symtab) :=
+        Elf32_Shdr'(Sh_Name => 11,
+                    Sh_Type => SHT_SYMTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => Elf32_Word (Sect_Strtab),
+                    Sh_Info => 0, --  FIXME
+                    Sh_Addralign => 4,
+                    Sh_Entsize => Elf32_Word (Elf32_Sym_Size));
+
+      --  strtab.
+      Shdr (Sect_Strtab) :=
+        Elf32_Shdr'(Sh_Name => 19,
+                    Sh_Type => SHT_STRTAB,
+                    Sh_Flags => 0,
+                    Sh_Addr => 0,
+                    Sh_Offset => 0,
+                    Sh_Size => 0,
+                    Sh_Link => 0,
+                    Sh_Info => 0,
+                    Sh_Addralign => 1,
+                    Sh_Entsize => 0);
+
+      --  Fill sections.
+      Sect := Section_Chain;
+      Nbr_Sect := Sect_First;
+      Nbr_Symbols := 1;
+      while Sect /= null loop
+         Sections (Nbr_Sect) := (Sect => Sect,
+                                 Sym => Elf32_Word (Nbr_Symbols));
+         Nbr_Symbols := Nbr_Symbols + 1;
+         Sect.Number := Nbr_Sect;
+
+         Shdr (Nbr_Sect) :=
+           Elf32_Shdr'(Sh_Name => Shdr (Sect_Shstrtab).Sh_Size,
+                       Sh_Type => SHT_PROGBITS,
+                       Sh_Flags => 0,
+                       Sh_Addr => Elf32_Addr (Sect.Vaddr),
+                       Sh_Offset => 0,
+                       Sh_Size => 0,
+                       Sh_Link => 0,
+                       Sh_Info => 0,
+                       Sh_Addralign => 2 ** Sect.Align,
+                       Sh_Entsize => Elf32_Word (Sect.Esize));
+         if Sect.Data = null then
+            Shdr (Nbr_Sect).Sh_Type := SHT_NOBITS;
+         end if;
+         if (Sect.Flags and Section_Read) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_ALLOC;
+         end if;
+         if (Sect.Flags and Section_Exec) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_EXECINSTR;
+         end if;
+         if (Sect.Flags and Section_Write) /= 0 then
+            Shdr (Nbr_Sect).Sh_Flags :=
+              Shdr (Nbr_Sect).Sh_Flags or SHF_WRITE;
+         end if;
+         if Sect.Flags = Section_Strtab then
+            Shdr (Nbr_Sect).Sh_Type := SHT_STRTAB;
+            Shdr (Nbr_Sect).Sh_Addralign := 1;
+            Shdr (Nbr_Sect).Sh_Entsize := 0;
+         end if;
+
+         Shdr (Sect_Shstrtab).Sh_Size := Shdr (Sect_Shstrtab).Sh_Size
+           + Sect.Name'Length + 1;      -- 1 for Nul.
+
+         Nbr_Sect := Nbr_Sect + 1;
+         if Flag_Reloc then
+            if Sect.First_Reloc /= null then
+               Do_Intra_Section_Reloc (Sect);
+            end if;
+         end if;
+         if Sect.First_Reloc /= null then
+            --  Add a section for the relocs.
+            Shdr (Nbr_Sect) := Elf32_Shdr'
+              (Sh_Name => Shdr (Sect_Shstrtab).Sh_Size,
+               Sh_Type => SHT_NULL,
+               Sh_Flags => 0,
+               Sh_Addr => 0,
+               Sh_Offset => 0,
+               Sh_Size => 0,
+               Sh_Link => Elf32_Word (Sect_Symtab),
+               Sh_Info => Elf32_Word (Nbr_Sect - 1),
+               Sh_Addralign => 4,
+               Sh_Entsize => Elf32_Word (Rel_Size));
+
+            if Is_Rela (Arch) then
+               Shdr (Nbr_Sect).Sh_Type := SHT_RELA;
+            else
+               Shdr (Nbr_Sect).Sh_Type := SHT_REL;
+            end if;
+            Shdr (Sect_Shstrtab).Sh_Size := Shdr (Sect_Shstrtab).Sh_Size
+              + Sect.Name'Length + 4        --  4 for ".rel"
+              + Boolean'Pos (Is_Rela (Arch)) + 1; -- 1 for 'a', 1 for Nul.
+
+            Nbr_Sect := Nbr_Sect + 1;
+         end if;
+         Sect := Sect.Next;
+      end loop;
+
+      --  Lay-out sections.
+      Offset := Elf32_Off (Elf32_Ehdr_Size);
+
+      --  Section table
+      Offset := Offset + Elf32_Off (Nbr_Sect * Elf32_Shdr_Size);
+
+      --  shstrtab.
+      Shdr (Sect_Shstrtab).Sh_Offset := Offset;
+
+      Offset := Sect_Align (Offset + Shdr (Sect_Shstrtab).Sh_Size);
+
+      --  user-sections and relocation.
+      for I in Sect_First .. Nbr_Sect - 1 loop
+         Sect := Sections (I).Sect;
+         if Sect /= null then
+            Sect.Pc := Pow_Align (Sect.Pc, Sect.Align);
+            Shdr (Sect.Number).Sh_Size := Elf32_Word (Sect.Pc);
+            if Sect.Data /= null then
+               --  Set data offset.
+               Shdr (Sect.Number).Sh_Offset := Offset;
+               Offset := Offset + Shdr (Sect.Number).Sh_Size;
+
+               --  Set relocs offset.
+               if Sect.First_Reloc /= null then
+                  Shdr (Sect.Number + 1).Sh_Offset := Offset;
+                  Shdr (Sect.Number + 1).Sh_Size :=
+                    Elf32_Word (Sect.Nbr_Relocs * Rel_Size);
+                  Offset := Offset + Shdr (Sect.Number + 1).Sh_Size;
+               end if;
+            end if;
+            --  Set link.
+            if Sect.Link /= null then
+               Shdr (Sect.Number).Sh_Link := Elf32_Word (Sect.Link.Number);
+            end if;
+         end if;
+      end loop;
+
+      --  Number symbols, put local before globals.
+      Nbr_Symbols := 1 + Nbr_Sections;
+
+      --  First local symbols.
+      for I in Symbols.First .. Symbols.Last loop
+         case Get_Scope (I) is
+            when Sym_Private =>
+               Set_Number (I, Nbr_Symbols);
+               Nbr_Symbols := Nbr_Symbols + 1;
+            when Sym_Local =>
+               if not Flag_Discard_Local then
+                  Set_Number (I, Nbr_Symbols);
+                  Nbr_Symbols := Nbr_Symbols + 1;
+               end if;
+            when Sym_Undef
+              | Sym_Global =>
+               null;
+         end case;
+      end loop;
+
+      Shdr (Sect_Symtab).Sh_Info := Elf32_Word (Nbr_Symbols);
+
+      --  Then globals.
+      for I in Symbols.First .. Symbols.Last loop
+         case Get_Scope (I) is
+            when Sym_Private
+              | Sym_Local =>
+               null;
+            when Sym_Undef =>
+               if Get_Used (I) then
+                  Set_Number (I, Nbr_Symbols);
+                  Nbr_Symbols := Nbr_Symbols + 1;
+               end if;
+            when Sym_Global =>
+               Set_Number (I, Nbr_Symbols);
+               Nbr_Symbols := Nbr_Symbols + 1;
+         end case;
+      end loop;
+
+      --  Symtab.
+      Shdr (Sect_Symtab).Sh_Offset := Offset;
+      --  1 for nul.
+      Shdr (Sect_Symtab).Sh_Size := Elf32_Word (Nbr_Symbols * Elf32_Sym_Size);
+
+      Offset := Offset + Shdr (Sect_Symtab).Sh_Size;
+
+      --  Strtab offset.
+      Shdr (Sect_Strtab).Sh_Offset := Offset;
+      Shdr (Sect_Strtab).Sh_Size := 1;
+
+      --  Compute length of strtab.
+      --    First, sections names.
+      Sect := Section_Chain;
+--       while Sect /= null loop
+--          Shdr (Sect_Strtab).Sh_Size :=
+--            Shdr (Sect_Strtab).Sh_Size + Sect.Name'Length + 1;
+--          Sect := Sect.Prev;
+--       end loop;
+      --   Then symbols.
+      declare
+         Len : Natural;
+         L : Natural;
+      begin
+         Len := 0;
+         for I in Symbols.First .. Symbols.Last loop
+            L := Get_Symbol_Name_Length (I) + 1;
+            case Get_Scope (I) is
+               when Sym_Local =>
+                  if Flag_Discard_Local then
+                     L := 0;
+                  end if;
+               when Sym_Private =>
+                  null;
+               when Sym_Global =>
+                  null;
+               when Sym_Undef =>
+                  if not Get_Used (I) then
+                     L := 0;
+                  end if;
+            end case;
+            Len := Len + L;
+         end loop;
+
+         Shdr (Sect_Strtab).Sh_Size :=
+           Shdr (Sect_Strtab).Sh_Size + Elf32_Word (Len);
+      end;
+
+      --  Write file header.
+      declare
+         Ehdr : Elf32_Ehdr;
+      begin
+         Ehdr := (E_Ident => (EI_MAG0 => ELFMAG0,
+                              EI_MAG1 => ELFMAG1,
+                              EI_MAG2 => ELFMAG2,
+                              EI_MAG3 => ELFMAG3,
+                              EI_CLASS => ELFCLASS32,
+                              EI_DATA => ELFDATANONE,
+                              EI_VERSION => EV_CURRENT,
+                              EI_PAD .. 15 => 0),
+                  E_Type => ET_REL,
+                  E_Machine => EM_NONE,
+                  E_Version => Elf32_Word (EV_CURRENT),
+                  E_Entry => 0,
+                  E_Phoff => 0,
+                  E_Shoff => Elf32_Off (Elf32_Ehdr_Size),
+                  E_Flags => 0,
+                  E_Ehsize => Elf32_Half (Elf32_Ehdr_Size),
+                  E_Phentsize => 0,
+                  E_Phnum => 0,
+                  E_Shentsize => Elf32_Half (Elf32_Shdr_Size),
+                  E_Shnum => Elf32_Half (Nbr_Sect),
+                  E_Shstrndx => 1);
+         case Arch is
+            when Arch_X86 =>
+               Ehdr.E_Ident (EI_DATA) := ELFDATA2LSB;
+               Ehdr.E_Machine := EM_386;
+            when Arch_Sparc =>
+               Ehdr.E_Ident (EI_DATA) := ELFDATA2MSB;
+               Ehdr.E_Machine := EM_SPARC;
+            when others =>
+               raise Program_Error;
+         end case;
+         Xwrite (Ehdr'Address, Elf32_Ehdr_Size);
+      end;
+
+      -- Write shdr.
+      Xwrite (Shdr'Address, Nbr_Sect * Elf32_Shdr_Size);
+
+      -- Write shstrtab
+      Check_File_Pos (Shdr (Sect_Shstrtab).Sh_Offset);
+      declare
+         Str : String :=
+           NUL & ".shstrtab" & NUL & ".symtab" & NUL & ".strtab" & NUL;
+         Rela : String := NUL & ".rela";
+      begin
+         Xwrite (Str'Address, Str'Length);
+         Sect := Section_Chain;
+         while Sect /= null loop
+            Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+            if Sect.First_Reloc /= null then
+               if Is_Rela (Arch) then
+                  Xwrite (Rela'Address, Rela'Length);
+               else
+                  Xwrite (Rela'Address, Rela'Length - 1);
+               end if;
+               Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+            end if;
+            Xwrite (NUL'Address, 1);
+            Sect := Sect.Next;
+         end loop;
+      end;
+      --  Pad.
+      declare
+         Delt : Elf32_Word;
+         Nul_Str : String (1 .. 4) := (others => NUL);
+      begin
+         Delt := Shdr (Sect_Shstrtab).Sh_Size and 3;
+         if Delt /= 0 then
+            Xwrite (Nul_Str'Address, Natural (4 - Delt));
+         end if;
+      end;
+
+      --  Write sections content and reloc.
+      for I in 1 .. Nbr_Sect loop
+         Sect := Sections (I).Sect;
+         if Sect /= null then
+            if Sect.Data /= null then
+               Check_File_Pos (Shdr (Sect.Number).Sh_Offset);
+               Xwrite (Sect.Data (0)'Address, Natural (Sect.Pc));
+            end if;
+            declare
+               R : Reloc_Acc;
+               Rel : Elf32_Rel;
+               Rela : Elf32_Rela;
+               S : Elf32_Word;
+               Nbr_Reloc : Natural;
+            begin
+               R := Sect.First_Reloc;
+               Nbr_Reloc := 0;
+               while R /= null loop
+                  if R.Done then
+                     S := Sections (Get_Section (R.Sym).Number).Sym;
+                  else
+                     S := Elf32_Word (Get_Number (R.Sym));
+                  end if;
+
+                  if Is_Rela (Arch) then
+                     case R.Kind is
+                        when Reloc_Disp22 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_WDISP22);
+                        when Reloc_Disp30 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_WDISP30);
+                        when Reloc_Hi22 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_HI22);
+                        when Reloc_Lo10 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_LO10);
+                        when Reloc_32 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_32);
+                        when Reloc_Ua_32 =>
+                           Rela.R_Info := Elf32_R_Info (S, R_SPARC_UA32);
+                        when others =>
+                           raise Program_Error;
+                     end case;
+                     Rela.R_Addend := 0;
+                     Rela.R_Offset := Elf32_Addr (R.Addr);
+                     Xwrite (Rela'Address, Elf32_Rela_Size);
+                  else
+                     case R.Kind is
+                        when Reloc_32 =>
+                           Rel.R_Info := Elf32_R_Info (S, R_386_32);
+                        when Reloc_Pc32 =>
+                           Rel.R_Info := Elf32_R_Info (S, R_386_PC32);
+                        when others =>
+                           raise Program_Error;
+                     end case;
+                     Rel.R_Offset := Elf32_Addr (R.Addr);
+                     Xwrite (Rel'Address, Elf32_Rel_Size);
+                  end if;
+                  Nbr_Reloc := Nbr_Reloc + 1;
+                  R := R.Sect_Next;
+               end loop;
+               if Nbr_Reloc /= Sect.Nbr_Relocs then
+                  raise Program_Error;
+               end if;
+            end;
+         end if;
+      end loop;
+
+      --  Write symbol table.
+      Check_File_Pos (Shdr (Sect_Symtab).Sh_Offset);
+      declare
+         Str_Off : Elf32_Word;
+
+         procedure Gen_Sym (S : Symbol)
+         is
+            Sym : Elf32_Sym;
+            Bind : Elf32_Uchar;
+            Typ : Elf32_Uchar;
+         begin
+            Sym := Elf32_Sym'(St_Name => Str_Off,
+                              St_Value => Elf32_Addr (Get_Symbol_Value (S)),
+                              St_Size => 0,
+                              St_Info => 0,
+                              St_Other => 0,
+                              St_Shndx => SHN_UNDEF);
+            if Get_Section (S) /= null then
+               Sym.St_Shndx := Elf32_Half (Get_Section (S).Number);
+            end if;
+            case Get_Scope (S) is
+               when Sym_Private
+                 | Sym_Local =>
+                  Bind := STB_LOCAL;
+                  Typ := STT_NOTYPE;
+               when Sym_Global =>
+                  Bind := STB_GLOBAL;
+                  if Get_Section (S) /= null
+                    and then (Get_Section (S).Flags and Section_Exec) /= 0
+                  then
+                     Typ := STT_FUNC;
+                  else
+                     Typ := STT_OBJECT;
+                  end if;
+               when Sym_Undef =>
+                  Bind := STB_GLOBAL;
+                  Typ := STT_NOTYPE;
+            end case;
+            Sym.St_Info := Elf32_St_Info (Bind, Typ);
+
+            Xwrite (Sym'Address, Elf32_Sym_Size);
+
+            Str_Off := Str_Off + Elf32_Off (Get_Symbol_Name_Length (S) + 1);
+         end Gen_Sym;
+
+         Sym : Elf32_Sym;
+      begin
+
+         Str_Off := 1;
+
+         --   write null entry
+         Sym := Elf32_Sym'(St_Name => 0,
+                           St_Value => 0,
+                           St_Size => 0,
+                           St_Info => 0,
+                           St_Other => 0,
+                           St_Shndx => SHN_UNDEF);
+         Xwrite (Sym'Address, Elf32_Sym_Size);
+
+         --   write section entries
+         Sect := Section_Chain;
+         while Sect /= null loop
+--             Sym := Elf32_Sym'(St_Name => Str_Off,
+--                               St_Value => 0,
+--                               St_Size => 0,
+--                               St_Info => Elf32_St_Info (STB_LOCAL,
+--                                                      STT_NOTYPE),
+--                               St_Other => 0,
+--                               St_Shndx => Elf32_Half (Sect.Number));
+--             Xwrite (Sym'Address, Elf32_Sym_Size);
+--             Str_Off := Str_Off + Sect.Name'Length + 1;
+
+            Sym := Elf32_Sym'(St_Name => 0,
+                              St_Value => 0,
+                              St_Size => 0,
+                              St_Info => Elf32_St_Info (STB_LOCAL,
+                                                        STT_SECTION),
+                              St_Other => 0,
+                              St_Shndx => Elf32_Half (Sect.Number));
+            Xwrite (Sym'Address, Elf32_Sym_Size);
+            Sect := Sect.Next;
+         end loop;
+
+         --  First local symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Private =>
+                  Gen_Sym (I);
+               when Sym_Local =>
+                  if not Flag_Discard_Local then
+                     Gen_Sym (I);
+                  end if;
+               when Sym_Global
+                 | Sym_Undef =>
+                  null;
+            end case;
+         end loop;
+
+         --  Then global symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Global =>
+                  Gen_Sym (I);
+               when Sym_Undef =>
+                  if Get_Used (I) then
+                     Gen_Sym (I);
+                  end if;
+               when Sym_Private
+                 | Sym_Local =>
+                  null;
+            end case;
+         end loop;
+      end;
+
+      -- Write strtab.
+      Check_File_Pos (Shdr (Sect_Strtab).Sh_Offset);
+      --  First is NUL.
+      Xwrite (NUL'Address, 1);
+      --  Then the sections name.
+--       Sect := Section_List;
+--       while Sect /= null loop
+--          Xwrite (Sect.Name.all'Address, Sect.Name'Length);
+--          Xwrite (NUL'Address, 1);
+--          Sect := Sect.Prev;
+--       end loop;
+
+      --  Then the symbols name.
+      declare
+         procedure Write_Sym_Name (S : Symbol)
+         is
+            Str : String := Get_Symbol_Name (S) & NUL;
+         begin
+            Xwrite (Str'Address, Str'Length);
+         end Write_Sym_Name;
+      begin
+         --  First locals.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Private =>
+                  Write_Sym_Name (I);
+               when Sym_Local =>
+                  if not Flag_Discard_Local then
+                     Write_Sym_Name (I);
+                  end if;
+               when Sym_Global
+                 | Sym_Undef =>
+                  null;
+            end case;
+         end loop;
+
+         --  Then global symbols.
+         for I in Symbols.First .. Symbols.Last loop
+            case Get_Scope (I) is
+               when Sym_Global =>
+                  Write_Sym_Name (I);
+               when Sym_Undef =>
+                  if Get_Used (I) then
+                     Write_Sym_Name (I);
+                  end if;
+               when Sym_Private
+                 | Sym_Local =>
+                  null;
+            end case;
+         end loop;
+      end;
+   end Write_Elf;
+
+end Binary_File.Elf;
diff --git a/src/ortho/mcode/binary_file-elf.ads b/src/ortho/mcode/binary_file-elf.ads
new file mode 100644
index 000000000..e0d3a4d2a
--- /dev/null
+++ b/src/ortho/mcode/binary_file-elf.ads
@@ -0,0 +1,22 @@
+--  Binary file ELF writer.
+--  Copyright (C) 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 GNAT.OS_Lib;
+
+package Binary_File.Elf is
+   procedure Write_Elf (Fd : GNAT.OS_Lib.File_Descriptor);
+end Binary_File.Elf;
diff --git a/src/ortho/mcode/binary_file-memory.adb b/src/ortho/mcode/binary_file-memory.adb
new file mode 100644
index 000000000..a37af9cb7
--- /dev/null
+++ b/src/ortho/mcode/binary_file-memory.adb
@@ -0,0 +1,101 @@
+--  Binary file execute in memory handler.
+--  Copyright (C) 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 Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Conversion;
+
+package body Binary_File.Memory is
+   --  Absolute section.
+   Sect_Abs : Section_Acc;
+
+   function To_Pc_Type is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Pc_Type);
+
+   procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address)
+   is
+   begin
+      Set_Symbol_Value (Sym, To_Pc_Type (Addr));
+      Set_Scope (Sym, Sym_Global);
+      Set_Section (Sym, Sect_Abs);
+   end Set_Symbol_Address;
+
+   procedure Write_Memory_Init is
+   begin
+      Create_Section (Sect_Abs, "*ABS*", Section_Exec);
+      Sect_Abs.Vaddr := 0;
+   end Write_Memory_Init;
+
+   procedure Write_Memory_Relocate (Error : out Boolean)
+   is
+      Sect : Section_Acc;
+      Rel : Reloc_Acc;
+      N_Rel : Reloc_Acc;
+   begin
+      --  Relocate section in memory.
+      Sect := Section_Chain;
+      while Sect /= null loop
+         if Sect.Data = null then
+            if Sect.Pc > 0 then
+               Resize (Sect, Sect.Pc);
+               Sect.Data (0 .. Sect.Pc - 1) := (others => 0);
+            else
+               null;
+               --Sect.Data := new Byte_Array (1 .. 0);
+            end if;
+         end if;
+         if Sect.Data_Max > 0
+           and (Sect /= Sect_Abs and Sect.Flags /= Section_Debug)
+         then
+            Sect.Vaddr := To_Pc_Type (Sect.Data (0)'Address);
+         end if;
+         Sect := Sect.Next;
+      end loop;
+
+      --  Do all relocations.
+      Sect := Section_Chain;
+      Error := False;
+      while Sect /= null loop
+--           Put_Line ("Section: " & Sect.Name.all & ", Flags:"
+--                     & Section_Flags'Image (Sect.Flags));
+         Rel := Sect.First_Reloc;
+         while Rel /= null loop
+            N_Rel := Rel.Sect_Next;
+            if Get_Scope (Rel.Sym) = Sym_Undef then
+               Put_Line ("symbol " & Get_Symbol_Name (Rel.Sym)
+                         & " is undefined");
+               Error := True;
+            else
+               Apply_Reloc (Sect, Rel);
+            end if;
+            Free (Rel);
+            Rel := N_Rel;
+         end loop;
+
+         Sect.First_Reloc := null;
+         Sect.Last_Reloc := null;
+         Sect.Nbr_Relocs := 0;
+
+         if (Sect.Flags and Section_Exec) /= 0
+           and (Sect.Flags and Section_Write) = 0
+         then
+            Memsegs.Set_Rx (Sect.Seg);
+         end if;
+
+         Sect := Sect.Next;
+      end loop;
+   end Write_Memory_Relocate;
+end Binary_File.Memory;
diff --git a/src/ortho/mcode/binary_file-memory.ads b/src/ortho/mcode/binary_file-memory.ads
new file mode 100644
index 000000000..a205da527
--- /dev/null
+++ b/src/ortho/mcode/binary_file-memory.ads
@@ -0,0 +1,25 @@
+--  Binary file execute in memory handler.
+--  Copyright (C) 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.
+package Binary_File.Memory is
+
+   --  Must be called before set_symbol_address.
+   procedure Write_Memory_Init;
+   procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address);
+
+   procedure Write_Memory_Relocate (Error : out Boolean);
+end Binary_File.Memory;
diff --git a/src/ortho/mcode/binary_file.adb b/src/ortho/mcode/binary_file.adb
new file mode 100644
index 000000000..6043d7319
--- /dev/null
+++ b/src/ortho/mcode/binary_file.adb
@@ -0,0 +1,977 @@
+--  Binary file handling.
+--  Copyright (C) 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.Storage_Elements;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Conversion;
+with Hex_Images; use Hex_Images;
+with Disassemble;
+
+package body Binary_File is
+   Cur_Sect : Section_Acc := null;
+
+   HT : Character renames Ada.Characters.Latin_1.HT;
+
+   function To_Byte_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Byte_Array_Acc);
+
+   --  Resize a section to SIZE bytes.
+   procedure Resize (Sect : Section_Acc; Size : Pc_Type)
+   is
+   begin
+      Sect.Data_Max := Size;
+      Memsegs.Resize (Sect.Seg, Natural (Size));
+      Sect.Data := To_Byte_Array_Acc (Memsegs.Get_Address (Sect.Seg));
+   end Resize;
+
+   function Get_Scope (Sym : Symbol) return Symbol_Scope is
+   begin
+      return Symbols.Table (Sym).Scope;
+   end Get_Scope;
+
+   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope) is
+   begin
+      Symbols.Table (Sym).Scope := Scope;
+   end Set_Scope;
+
+   function Get_Section (Sym : Symbol) return Section_Acc is
+   begin
+      return Symbols.Table (Sym).Section;
+   end Get_Section;
+
+   procedure Set_Section (Sym : Symbol; Sect : Section_Acc) is
+   begin
+      Symbols.Table (Sym).Section := Sect;
+   end Set_Section;
+
+   function Get_Number (Sym : Symbol) return Natural is
+   begin
+      return Symbols.Table (Sym).Number;
+   end Get_Number;
+
+   procedure Set_Number (Sym : Symbol; Num : Natural) is
+   begin
+      Symbols.Table (Sym).Number := Num;
+   end Set_Number;
+
+   function Get_Relocs (Sym : Symbol) return Reloc_Acc is
+   begin
+      return Symbols.Table (Sym).Relocs;
+   end Get_Relocs;
+
+   procedure Set_Relocs (Sym : Symbol; Reloc : Reloc_Acc) is
+   begin
+      Symbols.Table (Sym).Relocs := Reloc;
+   end Set_Relocs;
+
+   function Get_Name (Sym : Symbol) return O_Ident is
+   begin
+      return Symbols.Table (Sym).Name;
+   end Get_Name;
+
+   function Get_Used (Sym : Symbol) return Boolean is
+   begin
+      return Symbols.Table (Sym).Used;
+   end Get_Used;
+
+   procedure Set_Used (Sym : Symbol; Val : Boolean) is
+   begin
+      Symbols.Table (Sym).Used := Val;
+   end Set_Used;
+
+   function Get_Symbol_Value (Sym : Symbol) return Pc_Type is
+   begin
+      return Symbols.Table (Sym).Value;
+   end Get_Symbol_Value;
+
+   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type) is
+   begin
+      Symbols.Table (Sym).Value := Val;
+   end Set_Symbol_Value;
+
+   function S_Defined (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) /= Sym_Undef;
+   end S_Defined;
+   pragma Unreferenced (S_Defined);
+
+   function S_Local (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) = Sym_Local;
+   end S_Local;
+
+   procedure Create_Section (Sect : out Section_Acc;
+                             Name : String; Flags : Section_Flags)
+   is
+   begin
+      Sect := new Section_Type'(Next => null,
+                                Flags => Flags,
+                                Name => new String'(Name),
+                                Link => null,
+                                Align => 2,
+                                Esize => 0,
+                                Pc => 0,
+                                Insn_Pc => 0,
+                                Data => null,
+                                Data_Max => 0,
+                                First_Reloc => null,
+                                Last_Reloc => null,
+                                Nbr_Relocs => 0,
+                                Number => 0,
+                                Seg => Memsegs.Create,
+                                Vaddr => 0);
+      if (Flags and Section_Zero) = 0 then
+         --  Allocate memory for the segment, unless BSS.
+         Resize (Sect, 8192);
+      end if;
+      if (Flags and Section_Strtab) /= 0 then
+         Sect.Align := 0;
+      end if;
+      if Section_Chain = null then
+         Section_Chain := Sect;
+      else
+         Section_Last.Next := Sect;
+      end if;
+      Section_Last := Sect;
+      Nbr_Sections := Nbr_Sections + 1;
+   end Create_Section;
+
+   procedure Sect_Prealloc (Sect : Section_Acc; L : Pc_Type)
+   is
+      New_Max : Pc_Type;
+   begin
+      if Sect.Pc + L < Sect.Data_Max then
+         return;
+      end if;
+      New_Max := Sect.Data_Max;
+      loop
+         New_Max := New_Max * 2;
+         exit when Sect.Pc + L < New_Max;
+      end loop;
+      Resize (Sect, New_Max);
+   end Sect_Prealloc;
+
+   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc)
+   is
+      Rel : Reloc_Acc;
+   begin
+      --  Sanity checks.
+      if Src = null or else Dest = Src then
+         raise Program_Error;
+      end if;
+
+      Rel := Src.First_Reloc;
+
+      if Rel /= null then
+         --  Move relocs.
+         if Dest.Last_Reloc = null then
+            Dest.First_Reloc := Rel;
+            Dest.Last_Reloc := Rel;
+         else
+            Dest.Last_Reloc.Sect_Next := Rel;
+            Dest.Last_Reloc := Rel;
+         end if;
+         Dest.Nbr_Relocs := Dest.Nbr_Relocs + Src.Nbr_Relocs;
+
+
+         --  Reloc reloc, since the pc has changed.
+         while Rel /= null loop
+            Rel.Addr := Rel.Addr + Dest.Pc;
+            Rel := Rel.Sect_Next;
+         end loop;
+      end if;
+
+      if Src.Pc > 0 then
+         Sect_Prealloc (Dest, Src.Pc);
+         Dest.Data (Dest.Pc .. Dest.Pc + Src.Pc - 1) :=
+           Src.Data (0 .. Src.Pc - 1);
+         Dest.Pc := Dest.Pc + Src.Pc;
+      end if;
+
+      Memsegs.Delete (Src.Seg);
+      Src.Pc := 0;
+      Src.Data_Max := 0;
+      Src.Data := null;
+      Src.First_Reloc := null;
+      Src.Last_Reloc := null;
+      Src.Nbr_Relocs := 0;
+
+      --  Remove from section_chain.
+      if Section_Chain = Src then
+         Section_Chain := Src.Next;
+      else
+         declare
+            Sect : Section_Acc;
+         begin
+            Sect := Section_Chain;
+            while Sect.Next /= Src loop
+               Sect := Sect.Next;
+            end loop;
+            Sect.Next := Src.Next;
+            if Section_Last = Src then
+               Section_Last := Sect;
+            end if;
+         end;
+      end if;
+      Nbr_Sections := Nbr_Sections - 1;
+   end Merge_Section;
+
+   procedure Set_Section_Info (Sect : Section_Acc;
+                               Link : Section_Acc;
+                               Align : Natural;
+                               Esize : Natural)
+   is
+   begin
+      Sect.Link := Link;
+      Sect.Align := Align;
+      Sect.Esize := Esize;
+   end Set_Section_Info;
+
+   procedure Set_Current_Section (Sect : Section_Acc) is
+   begin
+      --  If the current section does not change, this is a no-op.
+      if Cur_Sect = Sect then
+         return;
+      end if;
+
+      if Dump_Asm then
+         Put_Line (HT & ".section """ & Sect.Name.all & """");
+      end if;
+      Cur_Sect := Sect;
+   end Set_Current_Section;
+
+   function Get_Current_Pc return Pc_Type is
+   begin
+      return Cur_Sect.Pc;
+   end Get_Current_Pc;
+
+   function Get_Pc (Sect : Section_Acc) return Pc_Type is
+   begin
+      return Sect.Pc;
+   end Get_Pc;
+
+
+   procedure Prealloc (L : Pc_Type) is
+   begin
+      Sect_Prealloc (Cur_Sect, L);
+   end Prealloc;
+
+   procedure Start_Insn is
+   begin
+      --  Check there is enough memory for the next instruction.
+      Sect_Prealloc (Cur_Sect, 16);
+      if Cur_Sect.Insn_Pc /= 0 then
+         --  end_insn was not called.
+         raise Program_Error;
+      end if;
+      Cur_Sect.Insn_Pc := Cur_Sect.Pc;
+   end Start_Insn;
+
+   procedure Get_Symbol_At_Addr (Addr : System.Address;
+                                 Line : in out String;
+                                 Line_Len : in out Natural)
+   is
+      use System;
+      use System.Storage_Elements;
+      Off : Pc_Type;
+      Reloc : Reloc_Acc;
+   begin
+      --  Check if addr is in the current section.
+      if Addr < Cur_Sect.Data (0)'Address
+        or else Addr > Cur_Sect.Data (Cur_Sect.Pc)'Address
+      then
+         raise Program_Error;
+         --return;
+      end if;
+      Off := Pc_Type
+        (To_Integer (Addr) - To_Integer (Cur_Sect.Data (0)'Address));
+
+      --  Find a relocation at OFF.
+      Reloc := Cur_Sect.First_Reloc;
+      while Reloc /= null loop
+         if Reloc.Addr = Off then
+            declare
+               Str : constant String := Get_Symbol_Name (Reloc.Sym);
+            begin
+               Line (Line'First .. Line'First + Str'Length - 1) := Str;
+               Line_Len := Line_Len + Str'Length;
+               return;
+            end;
+         end if;
+         Reloc := Reloc.Sect_Next;
+      end loop;
+   end Get_Symbol_At_Addr;
+
+   procedure End_Insn
+   is
+      Str : String (1 .. 256);
+      Len : Natural;
+      Insn_Len : Natural;
+   begin
+      --if Insn_Pc = 0 then
+      --   --  start_insn was not called.
+      --   raise Program_Error;
+      --end if;
+      if Debug_Hex then
+         Put (HT);
+         Put ('#');
+         for I in Cur_Sect.Insn_Pc .. Cur_Sect.Pc - 1 loop
+            Put (' ');
+            Put (Hex_Image (Unsigned_8 (Cur_Sect.Data (I))));
+         end loop;
+         New_Line;
+      end if;
+
+      if Dump_Asm then
+         Disassemble.Disassemble_Insn
+           (Cur_Sect.Data (Cur_Sect.Insn_Pc)'Address,
+            Unsigned_32 (Cur_Sect.Insn_Pc),
+            Str, Len, Insn_Len,
+            Get_Symbol_At_Addr'Access);
+         Put (HT);
+         Put_Line (Str (1 .. Len));
+      end if;
+      --if Natural (Cur_Pc - Insn_Pc) /= Insn_Len then
+      --   raise Program_Error;
+      --end if;
+      Cur_Sect.Insn_Pc := 0;
+   end End_Insn;
+
+   procedure Gen_B8 (B : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := B;
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_B8;
+
+   procedure Gen_B16 (B0, B1 : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := B0;
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := B1;
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_B16;
+
+   procedure Gen_Le8 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := Byte (B and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_Le8;
+
+   procedure Gen_Le16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Le16;
+
+   procedure Gen_Be16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Be16;
+
+   procedure Write_B8 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      Sect.Data (Pc) := Byte (V);
+   end Write_B8;
+
+   procedure Write_Be16 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be16;
+
+   procedure Write_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 0) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 24) and 16#Ff#);
+   end Write_Le32;
+
+   procedure Write_Be32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 24) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be32;
+
+   procedure Write_16 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B2 is Byte_Array_Base (0 .. 1);
+      function To_B2 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_16, Target => B2);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 1) := To_B2 (Unsigned_16 (B));
+   end Write_16;
+
+   procedure Write_32 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B4 is Byte_Array_Base (0 .. 3);
+      function To_B4 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_32, Target => B4);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 3) := To_B4 (B);
+   end Write_32;
+
+   procedure Gen_16 (B : Unsigned_32) is
+   begin
+      Write_16 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_16;
+
+   procedure Gen_32 (B : Unsigned_32) is
+   begin
+      Write_32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_32;
+
+   function Read_Le32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 0)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 24);
+   end Read_Le32;
+
+   function Read_Be32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 24)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 0);
+   end Read_Be32;
+
+   procedure Add_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Write_Le32 (Sect, Pc, V + Read_Le32 (Sect, Pc));
+   end Add_Le32;
+
+   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Le32 (Cur_Sect, Pc, V);
+   end Patch_Le32;
+
+   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be32 (Cur_Sect, Pc, V);
+   end Patch_Be32;
+
+   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 2 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be16 (Cur_Sect, Pc, V);
+   end Patch_Be16;
+
+   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      if Pc >= Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_B8 (Cur_Sect, Pc, V);
+   end Patch_B8;
+
+   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_32 (Cur_Sect, Pc, V);
+   end Patch_32;
+
+   procedure Gen_Le32 (B : Unsigned_32) is
+   begin
+      Write_Le32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Le32;
+
+   procedure Gen_Be32 (B : Unsigned_32) is
+   begin
+      Write_Be32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Be32;
+
+   procedure Gen_Data_Le8 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".byte 0x" & Hex_Image (Unsigned_8 (B)));
+      end if;
+      Gen_Le8 (B);
+   end Gen_Data_Le8;
+
+   procedure Gen_Data_Le16 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".half 0x" & Hex_Image (Unsigned_16 (B)));
+      end if;
+      Gen_Le16 (B);
+   end Gen_Data_Le16;
+
+   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Dump_Asm then
+         if Sym = Null_Symbol then
+            Put_Line (HT & ".word 0x" & Hex_Image (Offset));
+         else
+            if Offset = 0 then
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym));
+            else
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym) & " + "
+                         & Hex_Image (Offset));
+            end if;
+         end if;
+      end if;
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Data_32;
+
+   function Create_Symbol (Name : O_Ident) return Symbol
+   is
+   begin
+      Symbols.Append (Symbol_Type'(Section => null,
+                                   Value => 0,
+                                   Scope => Sym_Undef,
+                                   Used => False,
+                                   Name => Name,
+                                   Relocs => null,
+                                   Number => 0));
+      return Symbols.Last;
+   end Create_Symbol;
+
+   Last_Label : Natural := 1;
+
+   function Create_Local_Symbol return Symbol is
+   begin
+      Symbols.Append (Symbol_Type'(Section => Cur_Sect,
+                                   Value => 0,
+                                   Scope => Sym_Local,
+                                   Used => False,
+                                   Name => O_Ident_Nul,
+                                   Relocs => null,
+                                   Number => Last_Label));
+
+      Last_Label := Last_Label + 1;
+
+      return Symbols.Last;
+   end Create_Local_Symbol;
+
+   function Get_Symbol_Name (Sym : Symbol) return String
+   is
+      Res : String (1 .. 10);
+      N : Natural;
+      P : Natural;
+   begin
+      if S_Local (Sym) then
+         N := Get_Number (Sym);
+         P := Res'Last;
+         loop
+            Res (P) := Character'Val ((N mod 10) + Character'Pos ('0'));
+            N := N / 10;
+            P := P - 1;
+            exit when N = 0;
+         end loop;
+         Res (P) := 'L';
+         Res (P - 1) := '.';
+         return Res (P - 1 .. Res'Last);
+      else
+         if Is_Nul (Get_Name (Sym)) then
+            return "ANON";
+         else
+            return Get_String (Get_Name (Sym));
+         end if;
+      end if;
+   end Get_Symbol_Name;
+
+   function Get_Symbol_Name_Length (Sym : Symbol) return Natural
+   is
+      N : Natural;
+   begin
+      if S_Local (Sym) then
+         N := 10;
+         for I in 3 .. 8 loop
+            if Get_Number (Sym) < N then
+               return I;
+            end if;
+            N := N * 10;
+         end loop;
+         raise Program_Error;
+      else
+         return Get_String_Length (Get_Name (Sym));
+      end if;
+   end Get_Symbol_Name_Length;
+
+   function Get_Symbol (Name : String) return Symbol is
+   begin
+      for I in Symbols.First .. Symbols.Last loop
+         if Get_Symbol_Name (I) = Name then
+            return I;
+         end if;
+      end loop;
+      return Null_Symbol;
+   end Get_Symbol;
+
+   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type
+   is
+      Tmp : Pc_Type;
+   begin
+      Tmp := V + 2 ** Align - 1;
+      return Tmp - (Tmp mod Pc_Type (2 ** Align));
+   end Pow_Align;
+
+   procedure Gen_Pow_Align (Align : Natural) is
+   begin
+      if Align = 0 then
+         return;
+      end if;
+      if Dump_Asm then
+         Put_Line (HT & ".align" & Natural'Image (Align));
+      end if;
+      Cur_Sect.Pc := Pow_Align (Cur_Sect.Pc, Align);
+   end Gen_Pow_Align;
+
+   --  Generate LENGTH bytes set to 0.
+   procedure Gen_Space (Length : Integer_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".space" & Integer_32'Image (Length));
+      end if;
+      Cur_Sect.Pc := Cur_Sect.Pc + Pc_Type (Length);
+   end Gen_Space;
+
+   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean) is
+   begin
+      case Get_Scope (Sym) is
+         when Sym_Local =>
+            if Export then
+               raise Program_Error;
+            end if;
+         when Sym_Private
+           | Sym_Global =>
+            raise Program_Error;
+         when Sym_Undef =>
+            if Export then
+               Set_Scope (Sym, Sym_Global);
+            else
+               Set_Scope (Sym, Sym_Private);
+            end if;
+      end case;
+      --  Set value/section.
+      Set_Symbol_Value (Sym, Cur_Sect.Pc);
+      Set_Section (Sym, Cur_Sect);
+
+      if Dump_Asm then
+         if Export then
+            Put_Line (HT & ".globl " & Get_Symbol_Name (Sym));
+         end if;
+         Put (Get_Symbol_Name (Sym));
+         Put_Line (":");
+      end if;
+   end Set_Symbol_Pc;
+
+   procedure Add_Reloc (Sym : Symbol; Kind : Reloc_Kind)
+   is
+      Reloc : Reloc_Acc;
+   begin
+      Reloc := new Reloc_Type'(Kind => Kind,
+                               Done => False,
+                               Sym_Next => Get_Relocs (Sym),
+                               Sect_Next => null,
+                               Addr => Cur_Sect.Pc,
+                               Sym => Sym);
+      Set_Relocs (Sym, Reloc);
+      if Cur_Sect.First_Reloc = null then
+         Cur_Sect.First_Reloc := Reloc;
+      else
+         Cur_Sect.Last_Reloc.Sect_Next := Reloc;
+      end if;
+      Cur_Sect.Last_Reloc := Reloc;
+      Cur_Sect.Nbr_Relocs := Cur_Sect.Nbr_Relocs + 1;
+   end Add_Reloc;
+
+   procedure Gen_X86_Pc32 (Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Pc32);
+      Gen_Le32 (16#ff_ff_ff_fc#);
+   end Gen_X86_Pc32;
+
+   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp22;
+
+   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp30);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp30;
+
+   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Hi22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Hi22;
+
+   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Lo10);
+      Gen_Be32 (W);
+   end Gen_Sparc_Lo10;
+
+   function Conv is new Ada.Unchecked_Conversion
+     (Source => Integer_32, Target => Unsigned_32);
+
+   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Le32 (Conv (Offset));
+   end Gen_X86_32;
+
+   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Be32 (Conv (Offset));
+   end Gen_Sparc_32;
+
+   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32)
+   is
+      pragma Unreferenced (Offset);
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_Ua_32);
+      end if;
+      Gen_Be32 (0);
+   end Gen_Sparc_Ua_32;
+
+   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_Ua_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Ua_32;
+
+   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Ppc_Addr24);
+      Gen_32 (V);
+   end Gen_Ppc_24;
+
+   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type is
+   begin
+      return Get_Section (Sym).Vaddr + Get_Symbol_Value (Sym);
+   end Get_Symbol_Vaddr;
+
+   procedure Write_Left_Be32 (Sect : Section_Acc;
+                              Addr : Pc_Type;
+                              Size : Natural;
+                              Val : Unsigned_32)
+   is
+      W : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      --  Write value.
+      Mask := Shift_Left (1, Size) - 1;
+      W := Read_Be32 (Sect, Addr);
+      Write_Be32 (Sect, Addr, (W and not Mask) or (Val and Mask));
+   end Write_Left_Be32;
+
+   procedure Set_Wdisp (Sect : Section_Acc;
+                        Addr : Pc_Type;
+                        Sym : Symbol;
+                        Size : Natural)
+   is
+      D : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      D := Unsigned_32 (Get_Symbol_Vaddr (Sym) - (Sect.Vaddr + Addr));
+      --  Check overflow.
+      Mask := Shift_Left (1, Size + 2) - 1;
+      if (D and Shift_Left (1, Size + 1)) = 0 then
+         if (D and not Mask) /= 0 then
+            raise Program_Error;
+         end if;
+      else
+         if (D and not Mask) /= not Mask then
+            raise Program_Error;
+         end if;
+      end if;
+      --  Write value.
+      Write_Left_Be32 (Sect, Addr, Size, D / 4);
+   end Set_Wdisp;
+
+   procedure Do_Reloc (Kind : Reloc_Kind;
+                       Sect : Section_Acc; Addr : Pc_Type; Sym : Symbol)
+   is
+   begin
+      if Get_Scope (Sym) = Sym_Undef then
+         raise Program_Error;
+      end if;
+
+      case Kind is
+         when Reloc_32 =>
+            Add_Le32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+
+         when Reloc_Pc32 =>
+            Add_Le32 (Sect, Addr,
+                      Unsigned_32 (Get_Symbol_Vaddr (Sym)
+                                     - (Sect.Vaddr + Addr)));
+         when Reloc_Disp22 =>
+            Set_Wdisp (Sect, Addr, Sym, 22);
+         when Reloc_Disp30 =>
+            Set_Wdisp (Sect, Addr, Sym, 30);
+         when Reloc_Hi22 =>
+            Write_Left_Be32 (Sect, Addr, 22,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym) / 1024));
+         when Reloc_Lo10 =>
+            Write_Left_Be32 (Sect, Addr, 10,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ua_32 =>
+            Write_Be32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ppc_Addr24 =>
+            raise Program_Error;
+      end case;
+   end Do_Reloc;
+
+   function Is_Reloc_Relative (Reloc : Reloc_Acc) return Boolean is
+   begin
+      case Reloc.Kind is
+         when Reloc_Pc32
+           | Reloc_Disp22
+           | Reloc_Disp30 =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Reloc_Relative;
+
+   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc) is
+   begin
+      Do_Reloc (Reloc.Kind, Sect, Reloc.Addr, Reloc.Sym);
+   end Apply_Reloc;
+
+   procedure Do_Intra_Section_Reloc (Sect : Section_Acc)
+   is
+      Prev : Reloc_Acc;
+      Rel : Reloc_Acc;
+      Next : Reloc_Acc;
+   begin
+      Rel := Sect.First_Reloc;
+      Prev := null;
+      while Rel /= null loop
+         Next := Rel.Sect_Next;
+         if Get_Scope (Rel.Sym) /= Sym_Undef then
+            Do_Reloc (Rel.Kind, Sect, Rel.Addr, Rel.Sym);
+            Rel.Done := True;
+
+            if Get_Section (Rel.Sym) = Sect
+              and then Is_Reloc_Relative (Rel)
+            then
+               --  Remove reloc.
+               Sect.Nbr_Relocs := Sect.Nbr_Relocs - 1;
+               if Prev = null then
+                  Sect.First_Reloc := Next;
+               else
+                  Prev.Sect_Next := Next;
+               end if;
+               if Next = null then
+                  Sect.Last_Reloc := Prev;
+               end if;
+               Free (Rel);
+            else
+               Prev := Rel;
+            end if;
+         else
+            Set_Used (Rel.Sym, True);
+            Prev := Rel;
+         end if;
+         Rel := Next;
+      end loop;
+   end Do_Intra_Section_Reloc;
+
+   --  Return VAL rounded up to 2 ^ POW.
+--    function Align_Pow (Val : Integer; Pow : Natural) return Integer
+--    is
+--       N : Integer;
+--       Tmp : Integer;
+--    begin
+--       N := 2 ** Pow;
+--       Tmp := Val + N - 1;
+--       return Tmp - (Tmp mod N);
+--    end Align_Pow;
+
+   procedure Disp_Stats is
+   begin
+      Put_Line ("Number of Symbols: " & Symbol'Image (Symbols.Last));
+   end Disp_Stats;
+
+   procedure Finish
+   is
+      Sect : Section_Acc;
+      Rel, N_Rel : Reloc_Acc;
+   begin
+      Symbols.Free;
+      Sect := Section_Chain;
+      while Sect /= null loop
+         --  Free relocs.
+         Rel := Sect.First_Reloc;
+         while Rel /= null loop
+            N_Rel := Rel.Sect_Next;
+            Free (Rel);
+            Rel := N_Rel;
+         end loop;
+         Sect.First_Reloc := null;
+         Sect.Last_Reloc := null;
+
+         Sect := Sect.Next;
+      end loop;
+   end Finish;
+end Binary_File;
diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
new file mode 100644
index 000000000..1a2bf588d
--- /dev/null
+++ b/src/ortho/mcode/binary_file.ads
@@ -0,0 +1,305 @@
+--  Binary file handling.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with Ada.Unchecked_Deallocation;
+with Ortho_Ident; use Ortho_Ident;
+with GNAT.Table;
+with Memsegs;
+
+package Binary_File is
+   type Section_Type is limited private;
+   type Section_Acc is access Section_Type;
+
+   type Section_Flags is new Unsigned_32;
+   Section_None   : constant Section_Flags;
+   Section_Exec   : constant Section_Flags;
+   Section_Read   : constant Section_Flags;
+   Section_Write  : constant Section_Flags;
+   Section_Zero   : constant Section_Flags;
+   Section_Strtab : constant Section_Flags;
+   Section_Debug  : constant Section_Flags;
+
+   type Byte is new Unsigned_8;
+
+   type Symbol is range -2 ** 31 .. 2 ** 31 - 1;
+   for Symbol'Size use 32;
+   Null_Symbol : constant Symbol := 0;
+
+   type Pc_Type is mod System.Memory_Size;
+   Null_Pc : constant Pc_Type := 0;
+
+   type Arch_Kind is (Arch_Unknown, Arch_X86, Arch_Sparc, Arch_Ppc);
+   Arch : Arch_Kind := Arch_Unknown;
+
+   --  Dump assembly when generated.
+   Dump_Asm : Boolean := False;
+
+   Debug_Hex : Boolean := False;
+
+   --  Create a section.
+   procedure Create_Section (Sect : out Section_Acc;
+                             Name : String; Flags : Section_Flags);
+   procedure Set_Section_Info (Sect : Section_Acc;
+                               Link : Section_Acc;
+                               Align : Natural;
+                               Esize : Natural);
+
+   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc);
+
+   --  Set the current section.
+   procedure Set_Current_Section (Sect : Section_Acc);
+
+   --  Create an undefined local (anonymous) symbol in the  current section.
+   function Create_Local_Symbol return Symbol;
+   function Create_Symbol (Name : O_Ident) return Symbol;
+
+   --  Research symbol NAME, very expansive call.
+   --  Return NULL_Symbol if not found.
+   function Get_Symbol (Name : String) return Symbol;
+
+   --  Get the virtual address of a symbol.
+   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type;
+   pragma Inline (Get_Symbol_Vaddr);
+
+   --  Set the value of a symbol.
+   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean);
+   function Get_Symbol_Value (Sym : Symbol) return Pc_Type;
+
+   --  Get the current PC.
+   function Get_Current_Pc return Pc_Type;
+   pragma Inline (Get_Current_Pc);
+
+   function Get_Pc (Sect : Section_Acc) return Pc_Type;
+   pragma Inline (Get_Pc);
+
+   --  Align the current section of 2 ** ALIGN.
+   procedure Gen_Pow_Align (Align : Natural);
+
+   --  Generate LENGTH times 0.
+   procedure Gen_Space (Length : Integer_32);
+
+   --  Add a reloc in the current section at the current address.
+   procedure Gen_X86_Pc32 (Sym : Symbol);
+   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol);
+   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol);
+   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32);
+   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32);
+
+   --  Add a 32 bits value with a symbol relocation in the current section at
+   --  the current address.
+   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32);
+   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32);
+   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32);
+
+   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol);
+
+   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32);
+
+   --  Start/finish an instruction in the current section.
+   procedure Start_Insn;
+   procedure End_Insn;
+   --  Pre allocate L bytes.
+   procedure Prealloc (L : Pc_Type);
+
+   --  Add bits in the current section.
+   procedure Gen_B8 (B : Byte);
+   procedure Gen_B16 (B0, B1 : Byte);
+   procedure Gen_Le8 (B : Unsigned_32);
+   procedure Gen_Le16 (B : Unsigned_32);
+   procedure Gen_Be16 (B : Unsigned_32);
+   procedure Gen_Le32 (B : Unsigned_32);
+   procedure Gen_Be32 (B : Unsigned_32);
+
+   procedure Gen_16 (B : Unsigned_32);
+   procedure Gen_32 (B : Unsigned_32);
+
+   --  Add bits in the current section, but as stand-alone data.
+   procedure Gen_Data_Le8 (B : Unsigned_32);
+   procedure Gen_Data_Le16 (B : Unsigned_32);
+   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32);
+
+   --  Modify already generated code.
+   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8);
+   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32);
+   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32);
+
+   --  Binary writers:
+
+   --  Set ERROR in case of error (undefined symbol).
+   --procedure Write_Memory (Error : out Boolean);
+
+   procedure Disp_Stats;
+   procedure Finish;
+private
+   type Byte_Array_Base is array (Pc_Type range <>) of Byte;
+   subtype Byte_Array is Byte_Array_Base (Pc_Type);
+   type Byte_Array_Acc is access Byte_Array;
+   type String_Acc is access String;
+   --type Section_Flags is new Unsigned_32;
+
+   --  Relocations.
+   type Reloc_Kind is (Reloc_32, Reloc_Pc32,
+                       Reloc_Ua_32,
+                       Reloc_Disp22, Reloc_Disp30,
+                       Reloc_Hi22, Reloc_Lo10,
+                       Reloc_Ppc_Addr24);
+   type Reloc_Type;
+   type Reloc_Acc is access Reloc_Type;
+   type Reloc_Type is record
+      Kind : Reloc_Kind;
+      --  If true, the reloc was already applied.
+      Done : Boolean;
+      --  Next in simply linked list.
+      --  next reloc in the section.
+      Sect_Next : Reloc_Acc;
+      --  next reloc for the symbol.
+      Sym_Next : Reloc_Acc;
+      --  Address that must be relocated.
+      Addr : Pc_Type;
+      --  Symbol.
+      Sym : Symbol;
+   end record;
+
+   type Section_Type is record
+      --  Simply linked list of sections.
+      Next : Section_Acc;
+      --  Flags.
+      Flags : Section_Flags;
+      --  Name of the section.
+      Name : String_Acc;
+      --  Link to another section (used by ELF).
+      Link : Section_Acc;
+      --  Alignment (in power of 2).
+      Align : Natural;
+      --  Entry size (if any).
+      Esize : Natural;
+      --  Offset of the next data in DATA.
+      Pc : Pc_Type;
+      --  Offset of the current instruction.
+      Insn_Pc : Pc_Type;
+      --  Data for this section.
+      Data : Byte_Array_Acc;
+      --  Max address for data (before extending the area).
+      Data_Max : Pc_Type;
+      --  Chain of relocs defined in this section.
+      First_Reloc : Reloc_Acc;
+      Last_Reloc : Reloc_Acc;
+      --  Number of relocs in this section.
+      Nbr_Relocs : Natural;
+      --  Section number (set and used by binary writer).
+      Number : Natural;
+      --  Virtual address, if set.
+      Vaddr : Pc_Type; -- SSE.Integer_Address;
+      --  Memory for this segment.
+      Seg : Memsegs.Memseg_Type;
+   end record;
+
+   Section_Exec   : constant Section_Flags := 2#0000_0001#;
+   Section_Read   : constant Section_Flags := 2#0000_0010#;
+   Section_Write  : constant Section_Flags := 2#0000_0100#;
+   Section_Zero   : constant Section_Flags := 2#0000_1000#;
+   Section_Strtab : constant Section_Flags := 2#0001_0000#;
+   Section_Debug  : constant Section_Flags := 2#0010_0000#;
+   Section_None   : constant Section_Flags := 2#0000_0000#;
+
+   --  Scope of a symbol:
+   --  SYM_PRIVATE: not visible outside of the file.
+   --  SYM_UNDEF: not (yet) defined, unresolved.
+   --  SYM_GLOBAL: visible to all files.
+   --  SYM_LOCAL: locally generated symbol.
+   type Symbol_Scope is (Sym_Undef, Sym_Global, Sym_Private, Sym_Local);
+   subtype Symbol_Scope_External is Symbol_Scope range Sym_Undef .. Sym_Global;
+   type Symbol_Type is record
+      Section : Section_Acc;
+      Value : Pc_Type;
+      Scope : Symbol_Scope;
+      --  True if the symbol is referenced/used.
+      Used : Boolean;
+      --  Name of the symbol.
+      Name : O_Ident;
+      --  List of relocation made with this symbol.
+      Relocs : Reloc_Acc;
+      --  Symbol number, from 0.
+      Number : Natural;
+   end record;
+
+   --  Number of sections.
+   Nbr_Sections : Natural := 0;
+   --  Simply linked list of sections.
+   Section_Chain : Section_Acc := null;
+   Section_Last : Section_Acc := null;
+
+   package Symbols is new GNAT.Table
+     (Table_Component_Type => Symbol_Type,
+      Table_Index_Type => Symbol,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type;
+
+   function Get_Symbol_Name (Sym : Symbol) return String;
+   function Get_Symbol_Name_Length (Sym : Symbol) return Natural;
+
+   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type);
+   pragma Inline (Set_Symbol_Value);
+
+   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope);
+   pragma Inline (Set_Scope);
+
+   function Get_Scope (Sym : Symbol) return Symbol_Scope;
+   pragma Inline (Get_Scope);
+
+   function Get_Section (Sym : Symbol) return Section_Acc;
+   pragma Inline (Get_Section);
+
+   procedure Set_Section (Sym : Symbol; Sect : Section_Acc);
+   pragma Inline (Set_Section);
+
+   function Get_Name (Sym : Symbol) return O_Ident;
+   pragma Inline (Get_Name);
+
+   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc);
+   pragma Inline (Apply_Reloc);
+
+   procedure Set_Number (Sym : Symbol; Num : Natural);
+   pragma Inline (Set_Number);
+
+   function Get_Number (Sym : Symbol) return Natural;
+   pragma Inline (Get_Number);
+
+   function Get_Used (Sym : Symbol) return Boolean;
+   pragma Inline (Get_Used);
+
+   procedure Do_Intra_Section_Reloc (Sect : Section_Acc);
+
+   function S_Local (Sym : Symbol) return Boolean;
+   pragma Inline (S_Local);
+
+   procedure Resize (Sect : Section_Acc; Size : Pc_Type);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Reloc_Acc, Object => Reloc_Type);
+
+   Write_Error : exception;
+end Binary_File;
diff --git a/src/ortho/mcode/coff.ads b/src/ortho/mcode/coff.ads
new file mode 100644
index 000000000..6ef9cdde9
--- /dev/null
+++ b/src/ortho/mcode/coff.ads
@@ -0,0 +1,208 @@
+--  COFF definitions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with System; use System;
+
+package Coff is
+   type Filehdr is record
+      F_Magic : Unsigned_16;    --  Magic number.
+      F_Nscns : Unsigned_16;    --  Number of sections.
+      F_Timdat : Unsigned_32;   --  Time and date stamp.
+      F_Symptr : Unsigned_32;   --  File pointer to symtab.
+      F_Nsyms : Unsigned_32;    --  Number of symtab entries.
+      F_Opthdr : Unsigned_16;   --  Size of optionnal header.
+      F_Flags : Unsigned_16;    --  Flags;
+   end record;
+
+   --  Size of Filehdr.
+   Filehdr_Size : constant Natural := Filehdr'Size / Storage_Unit;
+
+   --  Magic numbers.
+   I386magic : constant Unsigned_16 := 16#014c#;
+
+   --  Flags of file header.
+   --  Relocation info stripped from file.
+   F_Relflg : constant Unsigned_16 := 16#0001#;
+
+   --  File is executable (no unresolved symbols).
+   F_Exec : constant Unsigned_16 := 16#0002#;
+
+   --  Line numbers stripped from file.
+   F_Lnno : constant Unsigned_16 := 16#0004#;
+
+   --  Local symbols stripped from file.
+   F_Lsyms : constant Unsigned_16 := 16#0008#;
+
+   type Scnhdr is record
+      S_Name : String (1 .. 8); --  Section name.
+      S_Paddr : Unsigned_32;    --  Physical address.
+      S_Vaddr : Unsigned_32;    --  Virtual address.
+      S_Size : Unsigned_32;     --  Section size.
+      S_Scnptr : Unsigned_32;   --  File pointer to raw section data.
+      S_Relptr : Unsigned_32;   --  File pointer to relocation data.
+      S_Lnnoptr : Unsigned_32;  --  File pointer to line number data.
+      S_Nreloc : Unsigned_16;   --  Number of relocation entries.
+      S_Nlnno : Unsigned_16;    --  Number of line number entries.
+      S_Flags : Unsigned_32;    --  Flags.
+   end record;
+   Scnhdr_Size : constant Natural := Scnhdr'Size / Storage_Unit;
+
+   -- section contains text only.
+   STYP_TEXT : constant Unsigned_32 := 16#0020#;
+   -- section contains data only.
+   STYP_DATA : constant Unsigned_32 := 16#0040#;
+   -- section contains bss only.
+   STYP_BSS  : constant Unsigned_32 := 16#0080#;
+
+   type Strent_Type is record
+      E_Zeroes : Unsigned_32;
+      E_Offset : Unsigned_32;
+   end record;
+
+   type Sym_Name (Inline : Boolean := True) is record
+      case Inline is
+         when True =>
+            E_Name : String (1 .. 8);
+         when False =>
+            E : Strent_Type;
+      end case;
+   end record;
+   pragma Unchecked_Union (Sym_Name);
+   for Sym_Name'Size use 64;
+
+   type Syment is record
+      E : Sym_Name;             --  Name of the symbol
+      E_Value : Unsigned_32;    --  Value
+      E_Scnum : Unsigned_16;    --  Section
+      E_Type : Unsigned_16;
+      E_Sclass : Unsigned_8;
+      E_Numaux : Unsigned_8;
+   end record;
+   Symesz : constant Natural := 18;
+   for Syment'Size use Symesz * Storage_Unit;
+
+   --  An undefined (extern) symbol.
+   N_UNDEF : constant Unsigned_16 := 16#00_00#;
+   --  An absolute symbol (e_value is a constant, not an address).
+   N_ABS   : constant Unsigned_16 := 16#Ff_Ff#;
+   --  A debugging symbol.
+   N_DEBUG : constant Unsigned_16 := 16#Ff_Fe#;
+
+   C_NULL    : constant Unsigned_8 := 0;
+   C_AUTO    : constant Unsigned_8 := 1;
+   C_EXT     : constant Unsigned_8 := 2;
+   C_STAT    : constant Unsigned_8 := 3;
+   C_REG     : constant Unsigned_8 := 4;
+   C_EXTDEF  : constant Unsigned_8 := 5;
+   C_LABEL   : constant Unsigned_8 := 6;
+   C_ULABEL  : constant Unsigned_8 := 7;
+   C_MOS     : constant Unsigned_8 := 8;
+   C_ARG     : constant Unsigned_8 := 9;
+   C_STRTAG  : constant Unsigned_8 := 10;
+   C_MOU     : constant Unsigned_8 := 11;
+   C_UNTAG   : constant Unsigned_8 := 12;
+   C_TPDEF   : constant Unsigned_8 := 13;
+   C_USTATIC : constant Unsigned_8 := 14;
+   C_ENTAG   : constant Unsigned_8 := 15;
+   C_MOE     : constant Unsigned_8 := 16;
+   C_REGPARM : constant Unsigned_8 := 17;
+   C_FIELD   : constant Unsigned_8 := 18;
+   C_AUTOARG : constant Unsigned_8 := 19;
+   C_LASTENT : constant Unsigned_8 := 20;
+   C_BLOCK   : constant Unsigned_8 := 100;
+   C_FCN     : constant Unsigned_8 := 101;
+   C_EOS     : constant Unsigned_8 := 102;
+   C_FILE    : constant Unsigned_8 := 103;
+   C_LINE    : constant Unsigned_8 := 104;
+   C_ALIAS   : constant Unsigned_8 := 105;
+   C_HIDDEN  : constant Unsigned_8 := 106;
+   C_EFCN    : constant Unsigned_8 := 255;
+
+   --  Textual description of sclass.
+   type Const_String_Acc is access constant String;
+   type Sclass_Desc_Type is record
+      Name : Const_String_Acc;
+      Meaning : Const_String_Acc;
+   end record;
+   type Sclass_Desc_Array_Type is array (Unsigned_8) of Sclass_Desc_Type;
+   Sclass_Desc : constant Sclass_Desc_Array_Type;
+
+   type Auxent_File (Inline : Boolean := True) is record
+      case Inline is
+         when True =>
+            X_Fname : String (1 .. 14);
+         when False =>
+            X_N : Strent_Type;
+      end case;
+   end record;
+   pragma Unchecked_Union (Auxent_File);
+
+   type Auxent_Scn is record
+      X_Scnlen : Unsigned_32;
+      X_Nreloc : Unsigned_16;
+      X_Nlinno : Unsigned_16;
+   end record;
+
+   --  Relocation.
+   type Reloc is record
+      R_Vaddr : Unsigned_32;
+      R_Symndx : Unsigned_32;
+      R_Type : Unsigned_16;
+   end record;
+   Relsz : constant Natural := Reloc'Size / Storage_Unit;
+
+   Reloc_Rel32  : constant Unsigned_16 := 20;
+   Reloc_Addr32 : constant Unsigned_16 := 6;
+
+private
+   subtype S is String;
+   Sclass_Desc : constant Sclass_Desc_Array_Type :=
+     (C_NULL => (new S'("C_NULL"), new S'("No entry")),
+      C_AUTO => (new S'("C_AUTO"), new S'("Automatic variable")),
+      C_EXT => (new S'("C_EXT"), new S'("External/public symbol")),
+      C_STAT => (new S'("C_STAT"), new S'("static (private) symbol")),
+      C_REG => (new S'("C_REG"), new S'("register variable")),
+      C_EXTDEF => (new S'("C_EXTDEF"), new S'("External definition")),
+      C_LABEL => (new S'("C_LABEL"), new S'("label")),
+      C_ULABEL => (new S'("C_ULABEL"), new S'("undefined label")),
+      C_MOS => (new S'("C_MOS"), new S'("member of structure")),
+      C_ARG => (new S'("C_ARG"), new S'("function argument")),
+      C_STRTAG => (new S'("C_STRTAG"), new S'("structure tag")),
+      C_MOU => (new S'("C_MOU"), new S'("member of union")),
+      C_UNTAG => (new S'("C_UNTAG"), new S'("union tag")),
+      C_TPDEF => (new S'("C_TPDEF"), new S'("type definition")),
+      C_USTATIC => (new S'("C_USTATIC"), new S'("undefined static")),
+      C_ENTAG => (new S'("C_ENTAG"), new S'("enumaration tag")),
+      C_MOE => (new S'("C_MOE"), new S'("member of enumeration")),
+      C_REGPARM => (new S'("C_REGPARM"), new S'("register parameter")),
+      C_FIELD => (new S'("C_FIELD"), new S'("bit field")),
+      C_AUTOARG => (new S'("C_AUTOARG"), new S'("auto argument")),
+      C_LASTENT => (new S'("C_LASTENT"), new S'("dummy entry (end of block)")),
+      C_BLOCK => (new S'("C_BLOCK"), new S'("beginning or end of block")),
+      C_FCN => (new S'("C_FCN"), new S'("beginning or end of function")),
+      C_EOS => (new S'("C_EOS"), new S'("end of structure")),
+      C_FILE => (new S'("C_FILE"), new S'("file name")),
+      C_LINE => (new S'("C_LINE"),
+                 new S'("line number, reformatted as symbol")),
+      C_ALIAS => (new S'("C_ALIAS"), new S'("duplicate tag")),
+      C_HIDDEN => (new S'("C_HIDDEN"),
+                   new S'("ext symbol in dmert public lib")),
+      C_EFCN => (new S'("C_EFCN"), new S'("physical end of function")),
+      others => (null, null));
+
+end Coff;
diff --git a/src/ortho/mcode/coffdump.adb b/src/ortho/mcode/coffdump.adb
new file mode 100644
index 000000000..6384b6c27
--- /dev/null
+++ b/src/ortho/mcode/coffdump.adb
@@ -0,0 +1,274 @@
+--  COFF dumper.
+--  Copyright (C) 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 Coff; use Coff;
+with Interfaces; use Interfaces;
+with System;
+with Ada.Unchecked_Conversion;
+with Ada.Command_Line; use Ada.Command_Line;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO; use Ada.Text_IO;
+with Hex_Images; use Hex_Images;
+
+procedure Coffdump is
+   type Cstring is array (Unsigned_32 range <>) of Character;
+   type Cstring_Acc is access Cstring;
+   type Section_Array is array (Unsigned_16 range <>) of Scnhdr;
+   type Section_Array_Acc is access Section_Array;
+   --  Array of sections.
+   Sections : Section_Array_Acc;
+
+   type External_Symbol is array (0 .. Symesz - 1) of Character;
+   type External_Symbol_Array is array (Unsigned_32 range <>)
+     of External_Symbol;
+   type Symbol_Array_Acc is access External_Symbol_Array;
+   --  Symbols table.
+   External_Symbols : Symbol_Array_Acc;
+
+   --  String table.
+   Str : Cstring_Acc;
+   Str_Size : Natural;
+
+   Hdr : Filehdr;
+   --Sym : Syment;
+   Fd : File_Descriptor;
+   Skip : Natural;
+   Skip_Kind : Unsigned_8;
+   Aux_File : Auxent_File;
+   Aux_Scn : Auxent_Scn;
+   Rel : Reloc;
+   Len : Natural;
+
+   Nul : constant Character := Character'Val (0);
+
+   function Find_Nul (S : String) return String is
+   begin
+      for I in S'Range loop
+         if S (I) = Nul then
+            return S (S'First .. I - 1);
+         end if;
+      end loop;
+      return S;
+   end Find_Nul;
+
+   function Get_String (N : Strent_Type; S : String) return String
+   is
+   begin
+      if N.E_Zeroes /= 0 then
+         return Find_Nul (S);
+      else
+         for I in N.E_Offset .. Str'Last loop
+            if Str (I) = Nul then
+               return String (Str (N.E_Offset .. I - 1));
+            end if;
+         end loop;
+         raise Program_Error;
+      end if;
+   end Get_String;
+
+   procedure Memcpy
+     (Dst : System.Address; Src : System.Address; Size : Natural);
+   pragma Import (C, Memcpy);
+
+   function Get_Section_Name (N : Unsigned_16) return String is
+   begin
+      if N = N_UNDEF then
+         return "UNDEF";
+      elsif N = N_ABS then
+         return "ABS";
+      elsif N = N_DEBUG then
+         return "DEBUG";
+      elsif N > Hdr.F_Nscns then
+         return "???";
+      else
+         return Find_Nul (Sections (N).S_Name);
+      end if;
+   end Get_Section_Name;
+
+   function Get_Symbol (N : Unsigned_32) return Syment is
+      function Unchecked_Conv is new Ada.Unchecked_Conversion
+        (Source => External_Symbol, Target => Syment);
+   begin
+      if N > Hdr.F_Nsyms then
+         raise Constraint_Error;
+      end if;
+      return Unchecked_Conv (External_Symbols (N));
+   end Get_Symbol;
+
+   function Get_Symbol_Name (N : Unsigned_32) return String
+   is
+      S : Syment := Get_Symbol (N);
+   begin
+      return Get_String (S.E.E, S.E.E_Name);
+   end Get_Symbol_Name;
+begin
+   for I in 1 .. Argument_Count loop
+      Fd := Open_Read (Argument (I), Binary);
+      if Fd = Invalid_FD then
+         Put_Line ("cannot open " & Argument (I));
+         return;
+      end if;
+      --  Read file header.
+      if Read (Fd, Hdr'Address, Filehdr_Size) /= Filehdr_Size then
+         Put_Line ("cannot read header");
+         return;
+      end if;
+      Put_Line ("File: " & Argument (I));
+      Put_Line ("magic:               " & Hex_Image (Hdr.F_Magic));
+      Put_Line ("number of sections:  " & Hex_Image (Hdr.F_Nscns));
+      Put_Line ("time and date stamp: " & Hex_Image (Hdr.F_Timdat));
+      Put_Line ("symtab file pointer: " & Hex_Image (Hdr.F_Symptr));
+      Put_Line ("nbr symtab entries:  " & Hex_Image (Hdr.F_Nsyms));
+      Put_Line ("opt header size:     " & Hex_Image (Hdr.F_Opthdr));
+      Put_Line ("flags:               " & Hex_Image (Hdr.F_Flags));
+
+      --  Read sections header.
+      Lseek (Fd, Long_Integer (Hdr.F_Opthdr), Seek_Cur);
+      Sections := new Section_Array (1 .. Hdr.F_Nscns);
+      Len := Scnhdr_Size * Natural (Hdr.F_Nscns);
+      if Read (Fd, Sections (1)'Address, Len) /= Len then
+         Put_Line ("cannot read section header");
+         return;
+      end if;
+      for I in 1 .. Hdr.F_Nscns loop
+         declare
+            S: Scnhdr renames Sections (I);
+         begin
+            Put_Line ("Section " & Find_Nul (S.S_Name));
+            Put_Line ("Physical address :     " & Hex_Image (S.S_Paddr));
+            Put_Line ("Virtual address :      " & Hex_Image (S.S_Vaddr));
+            Put_Line ("section size :         " & Hex_Image (S.S_Size));
+            Put_Line ("section pointer :      " & Hex_Image (S.S_Scnptr));
+            Put_Line ("relocation pointer :   " & Hex_Image (S.S_Relptr));
+            Put_Line ("line num pointer :     " & Hex_Image (S.S_Lnnoptr));
+            Put_Line ("Nbr reloc entries :    " & Hex_Image (S.S_Nreloc));
+            Put_Line ("Nbr line num entries : " & Hex_Image (S.S_Nlnno));
+            Put_Line ("Flags :                " & Hex_Image (S.S_Flags));
+         end;
+      end loop;
+
+      --  Read string table.
+      Lseek (Fd,
+             Long_Integer (Hdr.F_Symptr + Hdr.F_Nsyms * Unsigned_32 (Symesz)),
+             Seek_Set);
+      if Read (Fd, Str_Size'Address, 4) /= 4 then
+         Put_Line ("cannot read string table size");
+         return;
+      end if;
+      Str := new Cstring (0 .. Unsigned_32 (Str_Size));
+      if Read (Fd, Str (4)'Address, Str_Size - 4) /= Str_Size - 4 then
+         Put_Line ("cannot read string table");
+         return;
+      end if;
+
+      --  Read symbol table.
+      Lseek (Fd, Long_Integer (Hdr.F_Symptr), Seek_Set);
+      External_Symbols := new External_Symbol_Array (0 .. Hdr.F_Nsyms - 1);
+      Len := Natural (Hdr.F_Nsyms) * Symesz;
+      if Read (Fd, External_Symbols (0)'Address, Len) /= Len then
+            Put_Line ("cannot read symbol");
+            return;
+         end if;
+
+      Skip := 0;
+      Skip_Kind := C_NULL;
+      for I in External_Symbols'range loop
+         if Skip > 0 then
+            case Skip_Kind is
+               when C_FILE =>
+                  Memcpy (Aux_File'Address, External_Symbols (I)'Address,
+                          Aux_File'Size / 8);
+                  Put_Line ("aux file : " & Get_String (Aux_File.X_N,
+                                                        Aux_File.X_Fname));
+                  Skip_Kind := C_NULL;
+               when C_STAT =>
+                  Memcpy (Aux_Scn'Address, External_Symbols (I)'Address,
+                          Aux_Scn'Size / 8);
+                  Put_Line ("section len:   " & Hex_Image (Aux_Scn.X_Scnlen));
+                  Put_Line ("nbr reloc ent: " & Hex_Image (Aux_Scn.X_Nreloc));
+                  Put_Line ("nbr line num:  " & Hex_Image (Aux_Scn.X_Nlinno));
+               when others =>
+                  Put_Line ("skip");
+            end case;
+            Skip := Skip - 1;
+         else
+            declare
+               S : Syment := Get_Symbol (I);
+            begin
+               Put_Line ("Symbol #" & Hex_Image (I));
+               Put_Line ("symbol name : " & Get_Symbol_Name (I));
+               Put_Line ("symbol value: " & Hex_Image (S.E_Value));
+               Put_Line ("section num : " & Hex_Image (S.E_Scnum)
+                         & "  " & Get_Section_Name (S.E_Scnum));
+               Put_Line ("type        : " & Hex_Image (S.E_Type));
+               Put      ("sclass      : " & Hex_Image (S.E_Sclass));
+               if Sclass_Desc (S.E_Sclass).Name /= null then
+                  Put ("  (");
+                  Put (Sclass_Desc (S.E_Sclass).Name.all);
+                  Put (" - ");
+                  Put (Sclass_Desc (S.E_Sclass).Meaning.all);
+                  Put (")");
+               end if;
+               New_Line;
+               Put_Line ("numaux      : " & Hex_Image (S.E_Numaux));
+               if S.E_Numaux > 0 then
+                  case S.E_Sclass is
+                     when C_FILE =>
+                        Skip_Kind := C_FILE;
+                     when C_STAT =>
+                        Skip_Kind := C_STAT;
+                     when others =>
+                        Skip_Kind := C_NULL;
+                  end case;
+               end if;
+               Skip := Natural (S.E_Numaux);
+            end;
+         end if;
+      end loop;
+
+      --  Disp relocs.
+      for I in 1 .. Hdr.F_Nscns loop
+         if Sections (I).S_Nreloc > 0 then
+            --  Read relocations.
+            Put_Line ("Relocations for section " & Get_Section_Name (I));
+            Lseek (Fd, Long_Integer (Sections (I).S_Relptr), Seek_Set);
+            for J in 1 .. Sections (I).S_Nreloc loop
+               if Read (Fd, Rel'Address, Relsz) /= Relsz then
+                  Put_Line ("cannot read reloc");
+                  return;
+               end if;
+               Put_Line ("reloc virtual addr: " & Hex_Image (Rel.R_Vaddr));
+               Put_Line ("symbol index      : " & Hex_Image (Rel.R_Symndx)
+                         & "  " & Get_Symbol_Name (Rel.R_Symndx));
+               Put ("type of relocation: " & Hex_Image (Rel.R_Type));
+               case Rel.R_Type is
+                  when Reloc_Rel32 =>
+                     Put (" RELOC_REL32");
+                  when Reloc_Addr32 =>
+                     Put (" RELOC_ADDR32");
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            end loop;
+         end if;
+      end loop;
+
+      Close (Fd);
+   end loop;
+end Coffdump;
+
diff --git a/src/ortho/mcode/disa_sparc.adb b/src/ortho/mcode/disa_sparc.adb
new file mode 100644
index 000000000..8c9176ff8
--- /dev/null
+++ b/src/ortho/mcode/disa_sparc.adb
@@ -0,0 +1,274 @@
+with System; use System;
+with Interfaces; use Interfaces;
+with Ada.Unchecked_Conversion;
+with Hex_Images; use Hex_Images;
+
+package body Disa_Sparc is
+   subtype Reg_Type is Unsigned_32 range 0 .. 31;
+
+   type Hex_Map_Type is array (Unsigned_32 range 0 .. 15) of Character;
+   Hex_Digit : constant Hex_Map_Type := "0123456789abcdef";
+
+   type Cstring_Acc is access constant String;
+   type Cond_Map_Type is array (Unsigned_32 range 0 .. 15) of Cstring_Acc;
+   subtype S is String;
+   Bicc_Map : constant Cond_Map_Type :=
+     (0 => new S'("n"),
+      1 => new S'("e"),
+      2 => new S'("le"),
+      3 => new S'("l"),
+      4 => new S'("leu"),
+      5 => new S'("cs"),
+      6 => new S'("neg"),
+      7 => new S'("vs"),
+      8 => new S'("a"),
+      9 => new S'("ne"),
+      10 => new S'("g"),
+      11 => new S'("ge"),
+      12 => new S'("gu"),
+      13 => new S'("cc"),
+      14 => new S'("pos"),
+      15 => new S'("vc")
+      );
+
+
+   type Format_Type is
+      (
+       Format_Bad,
+       Format_Regimm, --  format 3, rd, rs1, rs2 or imm13
+       Format_Rd,     --  format 3, rd only.
+       Format_Copro,  --  format 3, fpu or coprocessor
+       Format_Asi     --  format 3, rd, rs1, asi and rs2.
+       );
+
+   type Insn_Desc_Type is record
+      Name : Cstring_Acc;
+      Format : Format_Type;
+   end record;
+
+   type Insn_Desc_Array is array (Unsigned_32 range 0 .. 63) of Insn_Desc_Type;
+   Insn_Desc_10 : constant Insn_Desc_Array :=
+     (
+      2#000_000# => (new S'("add"), Format_Regimm),
+      2#000_001# => (new S'("and"), Format_Regimm),
+      2#000_010# => (new S'("or"), Format_Regimm),
+      2#000_011# => (new S'("xor"), Format_Regimm),
+      2#000_100# => (new S'("sub"), Format_Regimm),
+      2#000_101# => (new S'("andn"), Format_Regimm),
+      2#000_110# => (new S'("orn"), Format_Regimm),
+      2#000_111# => (new S'("xnor"), Format_Regimm),
+      2#001_000# => (new S'("addx"), Format_Regimm),
+
+      2#001_100# => (new S'("subx"), Format_Regimm),
+
+      2#010_000# => (new S'("addcc"), Format_Regimm),
+      2#010_001# => (new S'("andcc"), Format_Regimm),
+      2#010_010# => (new S'("orcc"), Format_Regimm),
+      2#010_011# => (new S'("xorcc"), Format_Regimm),
+      2#010_100# => (new S'("subcc"), Format_Regimm),
+      2#010_101# => (new S'("andncc"), Format_Regimm),
+      2#010_110# => (new S'("orncc"), Format_Regimm),
+      2#010_111# => (new S'("xnorcc"), Format_Regimm),
+      2#011_000# => (new S'("addxcc"), Format_Regimm),
+
+      2#011_100# => (new S'("subxcc"), Format_Regimm),
+
+      2#111_000# => (new S'("jmpl"), Format_Regimm),
+
+      2#111_100# => (new S'("save"), Format_Regimm),
+      2#111_101# => (new S'("restore"), Format_Regimm),
+
+      others => (null, Format_Bad)
+      );
+
+   Insn_Desc_11 : constant Insn_Desc_Array :=
+     (
+      2#000_000# => (new S'("ld"), Format_Regimm),
+      2#000_001# => (new S'("ldub"), Format_Regimm),
+      2#000_010# => (new S'("lduh"), Format_Regimm),
+      2#000_011# => (new S'("ldd"), Format_Regimm),
+      2#000_100# => (new S'("st"), Format_Regimm),
+      2#000_101# => (new S'("stb"), Format_Regimm),
+
+      2#010_000# => (new S'("lda"), Format_Asi),
+      2#010_011# => (new S'("ldda"), Format_Asi),
+
+      2#110_000# => (new S'("ldc"), Format_Regimm),
+      2#110_001# => (new S'("ldcsr"), Format_Regimm),
+
+      others => (null, Format_Bad)
+      );
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : Address;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type)
+   is
+      type Unsigned_32_Acc is access Unsigned_32;
+      function To_Unsigned_32_Acc is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Unsigned_32_Acc);
+
+      W : Unsigned_32;
+      Lo : Natural;
+
+      --  Add CHAR to the line.
+      procedure Add_Char (C : Character);
+      pragma Inline (Add_Char);
+
+      procedure Add_Char (C : Character) is
+      begin
+         Line (Lo) := C;
+         Lo := Lo + 1;
+      end Add_Char;
+
+      --  Add STR to the line.
+      procedure Add_String (Str : String) is
+      begin
+         Line (Lo .. Lo + Str'Length - 1) := Str;
+         Lo := Lo + Str'Length;
+      end Add_String;
+
+      --  Add BYTE to the line.
+--       procedure Add_Byte (V : Byte) is
+--          type My_Str is array (Natural range 0 .. 15) of Character;
+--          Hex_Digit : constant My_Str := "0123456789abcdef";
+--       begin
+--          Add_Char (Hex_Digit (Natural (Shift_Right (V, 4) and 16#0f#)));
+--          Add_Char (Hex_Digit (Natural (Shift_Right (V, 0) and 16#0f#)));
+--       end Add_Byte;
+
+      procedure Disp_Const (Mask : Unsigned_32)
+      is
+         L : Natural;
+         V : Unsigned_32;
+      begin
+         L := Lo;
+         Proc_Cb.all (Addr, Line (Lo .. Line'Last), Lo);
+         V := W and Mask;
+
+         -- Extend sign.
+         if (W and ((Mask + 1) / 2)) /= 0 then
+            V := V or not Mask;
+         end if;
+         if L /= Lo then
+            if V = 0 then
+               return;
+            end if;
+            Add_String (" + ");
+         end if;
+         Add_String ("0x");
+         Add_String (Hex_Image (V));
+      end Disp_Const;
+
+      procedure Add_Cond (Str : String)
+      is
+      begin
+         Add_String (Str);
+         Add_String (Bicc_Map (Shift_Right (W, 25) and 2#1111#).all);
+         if (W and 16#2000_0000#) /= 0 then
+            Add_String (",a");
+         end if;
+         Add_Char (' ');
+         Disp_Const (16#3f_Ffff#);
+      end Add_Cond;
+
+
+      procedure Add_Ireg (R : Reg_Type)
+      is
+      begin
+         Add_Char ('%');
+         if R <= 7 then
+            Add_Char ('g');
+         elsif R <= 15 then
+            if R = 14 then
+               Add_String ("sp");
+               return;
+            else
+               Add_Char ('o');
+            end if;
+         elsif R <= 23 then
+            Add_Char ('l');
+         else
+            if R = 30 then
+               Add_String ("fp");
+               return;
+            else
+               Add_Char ('i');
+            end if;
+         end if;
+         Add_Char (Hex_Digit (R and 7));
+      end Add_Ireg;
+
+      procedure Disp_Unknown is
+      begin
+         Add_String ("unknown ");
+         Add_String (Hex_Image (W));
+      end Disp_Unknown;
+
+      procedure Disp_Format3 (Map : Insn_Desc_Array)
+      is
+         Op2 : Unsigned_32 range 0 .. 63;
+      begin
+         Op2 := Shift_Right (W, 19) and 2#111_111#;
+
+         case Map (Op2).Format is
+            when Format_Regimm =>
+               Add_String (Map (Op2).Name.all);
+               Add_Char (' ');
+               Add_Ireg (Shift_Right (W, 25) and 31);
+               Add_Char (',');
+               Add_Ireg (Shift_Right (W, 14) and 31);
+               Add_Char (',');
+               if (W and 16#2000#) /= 0 then
+                  Disp_Const (16#1fff#);
+               else
+                  Add_Ireg (W and 31);
+               end if;
+            when others =>
+               Add_String ("unknown3, op2=");
+               Add_String (Hex_Image (Op2));
+         end case;
+      end Disp_Format3;
+
+
+   begin
+      W := To_Unsigned_32_Acc (Addr).all;
+      Insn_Len := 4;
+      Lo := Line'First;
+
+      case Shift_Right (W, 30) is
+         when 2#00# =>
+            --  BIcc, SETHI
+            case Shift_Right (W, 22) and 2#111# is
+               when 2#000# =>
+                  Add_String ("unimp ");
+                  Disp_Const (16#3f_Ffff#);
+               when 2#010# =>
+                  Add_Cond ("b");
+               when 2#100# =>
+                  Add_String ("sethi ");
+                  Add_Ireg (Shift_Right (W, 25));
+                  Add_String (", ");
+                  Disp_Const (16#3f_Ffff#);
+               when others =>
+                  Disp_Unknown;
+            end case;
+         when 2#01# =>
+            --  Call
+            Add_String ("call ");
+            Disp_Const (16#3fff_Ffff#);
+         when 2#10# =>
+            Disp_Format3 (Insn_Desc_10);
+         when 2#11# =>
+            Disp_Format3 (Insn_Desc_11);
+         when others =>
+            --  Misc.
+            Disp_Unknown;
+      end case;
+
+      Line_Len := Lo - Line'First;
+   end Disassemble_Insn;
+
+end Disa_Sparc;
diff --git a/src/ortho/mcode/disa_sparc.ads b/src/ortho/mcode/disa_sparc.ads
new file mode 100644
index 000000000..486dff977
--- /dev/null
+++ b/src/ortho/mcode/disa_sparc.ads
@@ -0,0 +1,15 @@
+with System;
+
+package Disa_Sparc is
+   --  Call-back used to find a relocation symbol.
+   type Symbol_Proc_Type is access procedure (Addr : System.Address;
+                                              Line : in out String;
+                                              Line_Len : in out Natural);
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type);
+end Disa_Sparc;
diff --git a/src/ortho/mcode/disa_x86.adb b/src/ortho/mcode/disa_x86.adb
new file mode 100644
index 000000000..1d2d48565
--- /dev/null
+++ b/src/ortho/mcode/disa_x86.adb
@@ -0,0 +1,997 @@
+--  X86 disassembler.
+--  Copyright (C) 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.Address_To_Access_Conversions;
+
+package body Disa_X86 is
+   type Byte is new Interfaces.Unsigned_8;
+   type Bf_2 is mod 2 ** 2;
+   type Bf_3 is mod 2 ** 3;
+   type Byte_Vector is array (Natural) of Byte;
+   package Bv_Addr2acc is new System.Address_To_Access_Conversions
+     (Object => Byte_Vector);
+   use Bv_Addr2acc;
+
+   type Cstring_Acc is access constant String;
+   type Index_Type is
+     (
+      N_None,
+      N_Push,
+      N_Pop,
+      N_Ret,
+      N_Mov,
+      N_Add,
+      N_Or,
+      N_Adc,
+      N_Sbb,
+      N_And,
+      N_Sub,
+      N_Xor,
+      N_Cmp,
+      N_Into,
+      N_Jmp,
+      N_Jcc,
+      N_Setcc,
+      N_Call,
+      N_Int,
+      N_Cdq,
+      N_Imul,
+      N_Mul,
+      N_Leave,
+      N_Test,
+      N_Lea,
+      N_O,
+      N_No,
+      N_B,
+      N_AE,
+      N_E,
+      N_Ne,
+      N_Be,
+      N_A,
+      N_S,
+      N_Ns,
+      N_P,
+      N_Np,
+      N_L,
+      N_Ge,
+      N_Le,
+      N_G,
+      N_Not,
+      N_Neg,
+      N_Cbw,
+      N_Div,
+      N_Idiv,
+      N_Movsx,
+      N_Movzx,
+      N_Nop,
+      N_Hlt,
+      N_Inc,
+      N_Dec,
+      N_Rol,
+      N_Ror,
+      N_Rcl,
+      N_Rcr,
+      N_Shl,
+      N_Shr,
+      N_Sar,
+      N_Fadd,
+      N_Fmul,
+      N_Fcom,
+      N_Fcomp,
+      N_Fsub,
+      N_Fsubr,
+      N_Fdiv,
+      N_Fdivr,
+
+      G_1,
+      G_2,
+      G_3,
+      G_5
+     );
+
+   type Names_Type is array (Index_Type range <>) of Cstring_Acc;
+   subtype S is String;
+   Names : constant Names_Type :=
+     (N_None => new S'("none"),
+      N_Push => new S'("push"),
+      N_Pop => new S'("pop"),
+      N_Ret => new S'("ret"),
+      N_Mov => new S'("mov"),
+      N_Add => new S'("add"),
+      N_Or => new S'("or"),
+      N_Adc => new S'("adc"),
+      N_Sbb => new S'("sbb"),
+      N_And => new S'("and"),
+      N_Sub => new S'("sub"),
+      N_Xor => new S'("xor"),
+      N_Cmp => new S'("cmp"),
+      N_Into => new S'("into"),
+      N_Jmp => new S'("jmp"),
+      N_Jcc => new S'("j"),
+      N_Int => new S'("int"),
+      N_Cdq => new S'("cdq"),
+      N_Call => new S'("call"),
+      N_Imul => new S'("imul"),
+      N_Mul => new S'("mul"),
+      N_Leave => new S'("leave"),
+      N_Test => new S'("test"),
+      N_Setcc => new S'("set"),
+      N_Lea => new S'("lea"),
+      N_O => new S'("o"),
+      N_No => new S'("no"),
+      N_B => new S'("b"),
+      N_AE => new S'("ae"),
+      N_E => new S'("e"),
+      N_Ne => new S'("ne"),
+      N_Be => new S'("be"),
+      N_A => new S'("a"),
+      N_S => new S'("s"),
+      N_Ns => new S'("ns"),
+      N_P => new S'("p"),
+      N_Np => new S'("np"),
+      N_L => new S'("l"),
+      N_Ge => new S'("ge"),
+      N_Le => new S'("le"),
+      N_G => new S'("g"),
+      N_Not => new S'("not"),
+      N_Neg => new S'("neg"),
+      N_Cbw => new S'("cbw"),
+      N_Div => new S'("div"),
+      N_Idiv => new S'("idiv"),
+      N_Movsx => new S'("movsx"),
+      N_Movzx => new S'("movzx"),
+      N_Nop => new S'("nop"),
+      N_Hlt => new S'("hlt"),
+      N_Inc => new S'("inc"),
+      N_Dec => new S'("dec"),
+      N_Rol => new S'("rol"),
+      N_Ror => new S'("ror"),
+      N_Rcl => new S'("rcl"),
+      N_Rcr => new S'("rcr"),
+      N_Shl => new S'("shl"),
+      N_Shr => new S'("shr"),
+      N_Sar => new S'("sar"),
+      N_Fadd => new S'("fadd"),
+      N_Fmul => new S'("fmul"),
+      N_Fcom => new S'("fcom"),
+      N_Fcomp => new S'("fcomp"),
+      N_Fsub => new S'("fsub"),
+      N_Fsubr => new S'("fsubr"),
+      N_Fdiv => new S'("fdiv"),
+      N_Fdivr => new S'("fdivr")
+     );
+
+
+
+   --  Format of an instruction.
+   --  MODRM_SRC_8 : modrm byte follow, and modrm is source, witdh = 8bits
+   --  MODRM_DST_8 : modrm byte follow, and modrm is dest, width = 8 bits.
+   --  MODRM_SRC_W : modrm byte follow, and modrm is source, width = 16/32 bits
+   --  MODRM_DST_W : modrm byte follow, and modrm is dest, width =16/32 bits.
+   --  MODRM_IMM_W : modrm byte follow, with an opcode in the reg field,
+   --                followed by an immediat, width = 16/32 bits.
+   --  MODRM_IMM_8 : modrm byte follow, with an opcode in the reg field,
+   --               followed by an immediat, width = 8 bits.
+   --  IMM : the opcode is followed by an immediate value.
+   --  PREFIX : the opcode is a prefix (1 byte).
+   --  OPCODE : inherent addressing.
+   --  OPCODE2 : a second byte specify the instruction.
+   --  REG_IMP : register is in the 3 LSB of the opcode.
+   --  REG_IMM_W : register is in the 3 LSB of the opcode, followed by an
+   --              immediat, width = 16/32 bits.
+   --  DISP_W : a wide displacement (16/32 bits).
+   --  DISP_8 : short displacement (8 bits).
+   --  INVALID : bad opcode.
+   type Format_Type is (Modrm_Src, Modrm_Dst,
+                        Modrm_Imm, Modrm_Imm_S,
+                        Modrm,
+                        Modrm_Ax,
+                        Modrm_Imm8,
+                        Imm, Imm_S, Imm_8,
+                        Eax_Imm,
+                        Prefix, Opcode, Opcode2, Reg_Imp,
+                        Reg_Imm,
+                        Imp,
+                        Disp_W, Disp_8,
+                        Cond_Disp_W, Cond_Disp_8,
+                        Cond_Modrm,
+                        Ax_Off_Src, Ax_Off_Dst,
+                        Invalid);
+
+   type Width_Type is (W_None, W_8, W_16, W_32, W_Data);
+
+   --  Description for one instruction.
+   type Insn_Desc_Type is record
+      --  Name of the operation.
+      Name : Index_Type;
+
+      --  Width of the instruction.
+      --  This is used to add a suffix (b,w,l) to the instruction.
+      --  This may also be the size of a data.
+      Width : Width_Type;
+
+      --  Format of the instruction.
+      Format : Format_Type;
+   end record;
+
+   Desc_Invalid : constant Insn_Desc_Type := (N_None, W_None, Invalid);
+
+   type Insn_Desc_Array_Type is array (Byte) of Insn_Desc_Type;
+   type Group_Desc_Array_Type is array (Bf_3) of Insn_Desc_Type;
+   Insn_Desc : constant Insn_Desc_Array_Type :=
+     (
+      2#00_000_000# => (N_Add, W_8, Modrm_Dst),
+      2#00_000_001# => (N_Add, W_Data, Modrm_Dst),
+      2#00_000_010# => (N_Add, W_8, Modrm_Src),
+      2#00_000_011# => (N_Add, W_Data, Modrm_Src),
+
+      2#00_001_000# => (N_Or, W_8, Modrm_Dst),
+      2#00_001_001# => (N_Or, W_Data, Modrm_Dst),
+      2#00_001_010# => (N_Or, W_8, Modrm_Src),
+      2#00_001_011# => (N_Or, W_Data, Modrm_Src),
+
+      2#00_011_000# => (N_Sbb, W_8, Modrm_Dst),
+      2#00_011_001# => (N_Sbb, W_Data, Modrm_Dst),
+      2#00_011_010# => (N_Sbb, W_8, Modrm_Src),
+      2#00_011_011# => (N_Sbb, W_Data, Modrm_Src),
+
+      2#00_100_000# => (N_And, W_8, Modrm_Dst),
+      2#00_100_001# => (N_And, W_Data, Modrm_Dst),
+      2#00_100_010# => (N_And, W_8, Modrm_Src),
+      2#00_100_011# => (N_And, W_Data, Modrm_Src),
+
+      2#00_101_000# => (N_Sub, W_8, Modrm_Dst),
+      2#00_101_001# => (N_Sub, W_Data, Modrm_Dst),
+      2#00_101_010# => (N_Sub, W_8, Modrm_Src),
+      2#00_101_011# => (N_Sub, W_Data, Modrm_Src),
+
+      2#00_110_000# => (N_Xor, W_8, Modrm_Dst),
+      2#00_110_001# => (N_Xor, W_Data, Modrm_Dst),
+      2#00_110_010# => (N_Xor, W_8, Modrm_Src),
+      2#00_110_011# => (N_Xor, W_Data, Modrm_Src),
+
+      2#00_111_000# => (N_Cmp, W_8, Modrm_Dst),
+      2#00_111_001# => (N_Cmp, W_Data, Modrm_Dst),
+      2#00_111_010# => (N_Cmp, W_8, Modrm_Src),
+      2#00_111_011# => (N_Cmp, W_Data, Modrm_Src),
+
+      2#00_111_100# => (N_Cmp, W_8, Eax_Imm),
+      2#00_111_101# => (N_Cmp, W_Data, Eax_Imm),
+
+      2#0101_0_000# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_001# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_010# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_011# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_100# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_101# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_110# => (N_Push, W_Data, Reg_Imp),
+      2#0101_0_111# => (N_Push, W_Data, Reg_Imp),
+
+      2#0101_1_000# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_001# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_010# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_011# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_100# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_101# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_110# => (N_Pop, W_Data, Reg_Imp),
+      2#0101_1_111# => (N_Pop, W_Data, Reg_Imp),
+
+      2#0110_1000# => (N_Push, W_Data, Imm),
+      2#0110_1010# => (N_Push, W_Data, Imm_S),
+
+      2#0111_0000# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0001# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0010# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0011# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0100# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0101# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0110# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_0111# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1000# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1001# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1010# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1011# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1100# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1101# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1110# => (N_Jcc, W_None, Cond_Disp_8),
+      2#0111_1111# => (N_Jcc, W_None, Cond_Disp_8),
+
+      2#1000_0000# => (G_1, W_8, Modrm_Imm),
+      2#1000_0001# => (G_1, W_Data, Modrm_Imm),
+      2#1000_0011# => (G_1, W_Data, Modrm_Imm_S),
+
+      2#1000_0101# => (N_Test, W_Data, Modrm_Src),
+      2#1000_1101# => (N_Lea, W_Data, Modrm_Src),
+
+      2#1000_1010# => (N_Mov, W_8, Modrm_Src),
+      2#1000_1011# => (N_Mov, W_Data, Modrm_Src),
+      2#1000_1000# => (N_Mov, W_8, Modrm_Dst),
+      2#1000_1001# => (N_Mov, W_Data, Modrm_Dst),
+
+      2#1001_0000# => (N_Nop, W_None, Opcode),
+      2#1001_1001# => (N_Cdq, W_Data, Imp),
+
+      2#1010_0000# => (N_Mov, W_8, Ax_Off_Src),
+      2#1010_0001# => (N_Mov, W_Data, Ax_Off_Src),
+      2#1010_0010# => (N_Mov, W_8, Ax_Off_Dst),
+      2#1010_0011# => (N_Mov, W_Data, Ax_Off_Dst),
+
+      2#1011_0000# => (N_Mov, W_8, Reg_Imm),
+
+      2#1011_1000# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1001# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1010# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1011# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1100# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1101# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1110# => (N_Mov, W_Data, Reg_Imm),
+      2#1011_1111# => (N_Mov, W_Data, Reg_Imm),
+
+      2#1100_0000# => (G_2, W_8, Modrm_Imm8),
+      2#1100_0001# => (G_2, W_Data, Modrm_Imm8),
+
+      2#1100_0011# => (N_Ret, W_None, Opcode),
+      2#1100_0110# => (N_Mov, W_8, Modrm_Imm),
+      2#1100_0111# => (N_Mov, W_Data, Modrm_Imm),
+      2#1100_1001# => (N_Leave, W_None, Opcode),
+      2#1100_1101# => (N_Int, W_None, Imm_8),
+      2#1100_1110# => (N_Into, W_None, Opcode),
+
+      2#1110_1000# => (N_Call, W_None, Disp_W),
+      2#1110_1001# => (N_Jmp, W_None, Disp_W),
+      2#1110_1011# => (N_Jmp, W_None, Disp_8),
+
+      2#1111_0100# => (N_Hlt, W_None, Opcode),
+
+      2#1111_0110# => (G_3, W_None, Invalid),
+      2#1111_0111# => (G_3, W_None, Invalid),
+
+      2#1111_1111# => (G_5, W_None, Invalid),
+      --2#1111_1111# => (N_Push, W_Data, Modrm),
+      others => (N_None, W_None, Invalid));
+
+   Insn_Desc_0F : constant Insn_Desc_Array_Type :=
+     (2#1000_0000# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0001# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0010# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0011# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0100# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0101# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0110# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_0111# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1000# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1001# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1010# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1011# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1100# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1101# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1110# => (N_Jcc, W_None, Cond_Disp_W),
+      2#1000_1111# => (N_Jcc, W_None, Cond_Disp_W),
+
+      2#1001_0000# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0001# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0010# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0011# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0100# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0101# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0110# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_0111# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1000# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1001# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1010# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1011# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1100# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1101# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1110# => (N_Setcc, W_8, Cond_Modrm),
+      2#1001_1111# => (N_Setcc, W_8, Cond_Modrm),
+
+      2#1011_0110# => (N_Movzx, W_Data, Modrm_Dst),
+      2#1011_1110# => (N_Movsx, W_Data, Modrm_Dst),
+      others => (N_None, W_None, Invalid));
+
+   --  16#F7#
+   Insn_Desc_G3 : constant Group_Desc_Array_Type :=
+     (2#000# => (N_Test, W_Data, Reg_Imm),
+      2#010# => (N_Not, W_Data, Modrm_Dst),
+      2#011# => (N_Neg, W_Data, Modrm_Dst),
+      2#100# => (N_Mul, W_Data, Modrm_Ax),
+      2#101# => (N_Imul, W_Data, Modrm_Ax),
+      2#110# => (N_Div, W_Data, Modrm_Ax),
+      2#111# => (N_Idiv, W_Data, Modrm_Ax),
+      others => (N_None, W_None, Invalid));
+
+   Insn_Desc_G5 : constant Group_Desc_Array_Type :=
+     (2#000# => (N_Inc, W_Data, Modrm),
+      2#001# => (N_Dec, W_Data, Modrm),
+      2#010# => (N_Call, W_Data, Modrm),
+      --2#011# => (N_Call, W_Data, Modrm_Ax),
+      2#100# => (N_Jmp, W_Data, Modrm),
+      --2#101# => (N_Jmp, W_Data, Modrm_Ax),
+      2#110# => (N_Push, W_Data, Modrm_Ax),
+      others => (N_None, W_None, Invalid));
+
+   type Group_Name_Array_Type is array (Index_Type range G_1 .. G_2, Bf_3)
+     of Index_Type;
+   Group_Name : constant Group_Name_Array_Type :=
+     (
+      G_1 => (N_Add, N_Or, N_Adc, N_Sbb, N_And, N_Sub, N_Xor, N_Cmp),
+      G_2 => (N_Rol, N_Ror, N_Rcl, N_Rcr, N_Shl, N_Shr, N_None, N_Sar)
+     );
+
+   --  Standard widths of operations.
+   type Width_Array_Type is array (Width_Type) of Character;
+   Width_Char : constant Width_Array_Type :=
+     (W_None => '-', W_8 => 'b', W_16 => 'w', W_32 => 'l', W_Data => '?');
+   type Width_Len_Type is array (Width_Type) of Natural;
+   Width_Len : constant Width_Len_Type :=
+     (W_None => 0, W_8 => 1, W_16 => 2, W_32 => 4, W_Data => 0);
+
+   --  Registers.
+--    type Reg_Type is (Reg_Ax, Reg_Bx, Reg_Cx, Reg_Dx,
+--                      Reg_Bp, Reg_Sp, Reg_Si, Reg_Di,
+--                      Reg_Al, Reg_Ah, Reg_Bl, Reg_Bh,
+--                      Reg_Cl, Reg_Ch, Reg_Dl, Reg_Dh);
+
+   --  Bits extraction from byte functions.
+   --  For a byte, MSB (most significant bit) is bit 7 while
+   --  LSB (least significant bit) is bit 0.
+
+   --  Extract bits 2, 1 and 0.
+   function Ext_210 (B : Byte) return Bf_3;
+   pragma Inline (Ext_210);
+
+   --  Extract bits 5-3 of byte B.
+   function Ext_543 (B : Byte) return Bf_3;
+   pragma Inline (Ext_543);
+
+   --  Extract bits 7-6 of byte B.
+   function Ext_76 (B : Byte) return Bf_2;
+   pragma Inline (Ext_76);
+
+   function Ext_210 (B : Byte) return Bf_3 is
+   begin
+      return Bf_3 (B and 2#111#);
+   end Ext_210;
+
+   function Ext_543 (B : Byte) return Bf_3 is
+   begin
+      return Bf_3 (Shift_Right (B, 3) and 2#111#);
+   end Ext_543;
+
+   function Ext_76 (B : Byte) return Bf_2 is
+   begin
+      return Bf_2 (Shift_Right (B, 6) and 2#11#);
+   end Ext_76;
+
+   function Ext_Modrm_Mod (B : Byte) return Bf_2 renames Ext_76;
+   function Ext_Modrm_Rm (B : Byte) return Bf_3 renames Ext_210;
+   function Ext_Modrm_Reg (B : Byte) return Bf_3 renames Ext_543;
+   function Ext_Sib_Base (B : Byte) return Bf_3 renames Ext_210;
+   function Ext_Sib_Index (B : Byte) return Bf_3 renames Ext_543;
+   function Ext_Sib_Scale (B : Byte) return Bf_2 renames Ext_76;
+
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Pc : Unsigned_32;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type)
+   is
+      --  Index in LINE of the next character to be written.
+      Lo : Natural;
+
+      --  Default width.
+      W_Default : constant Width_Type := W_32;
+
+      --  The instruction memory, 0 based.
+      Mem : Bv_Addr2acc.Object_Pointer;
+
+      --  Add NAME to the line.
+      procedure Add_Name (Name : Index_Type);
+      pragma Inline (Add_Name);
+
+      --  Add CHAR to the line.
+      procedure Add_Char (C : Character);
+      pragma Inline (Add_Char);
+
+      --  Add STR to the line.
+      procedure Add_String (Str : String) is
+      begin
+         Line (Lo .. Lo + Str'Length - 1) := Str;
+         Lo := Lo + Str'Length;
+      end Add_String;
+
+      --  Add BYTE to the line.
+      procedure Add_Byte (V : Byte) is
+         type My_Str is array (Natural range 0 .. 15) of Character;
+         Hex_Digit : constant My_Str := "0123456789abcdef";
+      begin
+         Add_Char (Hex_Digit (Natural (Shift_Right (V, 4) and 16#0f#)));
+         Add_Char (Hex_Digit (Natural (Shift_Right (V, 0) and 16#0f#)));
+      end Add_Byte;
+
+      procedure Add_Name (Name : Index_Type) is
+      begin
+         Add_String (Names (Name).all);
+      end Add_Name;
+
+      procedure Add_Char (C : Character) is
+      begin
+         Line (Lo) := C;
+         Lo := Lo + 1;
+      end Add_Char;
+
+      procedure Add_Comma is
+      begin
+         Add_String (", ");
+      end Add_Comma;
+
+      procedure Name_Align (Orig : Natural) is
+      begin
+         Add_Char (' ');
+         while Lo - Orig < 8 loop
+            Add_Char (' ');
+         end loop;
+      end Name_Align;
+
+      procedure Add_Opcode (Name : Index_Type; Width : Width_Type)
+      is
+         L : constant Natural := Lo;
+      begin
+         Add_Name (Name);
+         if False and Width /= W_None then
+            Add_Char (Width_Char (Width));
+         end if;
+         Name_Align (L);
+      end Add_Opcode;
+
+      procedure Add_Cond_Opcode (Name : Index_Type; B : Byte)
+      is
+         L : constant Natural := Lo;
+      begin
+         Add_Name (Name);
+         Add_Name (Index_Type'Val (Index_Type'Pos (N_O)
+                                     + Byte'Pos (B and 16#0f#)));
+         Name_Align (L);
+      end Add_Cond_Opcode;
+
+      procedure Decode_Reg_Field (F : Bf_3; W : Width_Type) is
+         type Reg_Name2_Array is array (Bf_3) of String (1 .. 2);
+         type Reg_Name3_Array is array (Bf_3) of String (1 .. 3);
+         Regs_8 : constant Reg_Name2_Array :=
+           ("al", "cl", "dl", "bl", "ah", "ch", "dh", "bh");
+         Regs_16 : constant Reg_Name2_Array :=
+           ("ax", "cx", "dx", "bx", "sp", "bp", "si", "di");
+         Regs_32 : constant Reg_Name3_Array :=
+           ("eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi");
+      begin
+         Add_Char ('%');
+         case W is
+            when W_8 =>
+               Add_String (Regs_8 (F));
+            when W_16 =>
+               Add_String (Regs_16 (F));
+            when W_32 =>
+               Add_String (Regs_32 (F));
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Reg_Field;
+
+      procedure Decode_Val (Off : Natural; Width : Width_Type)
+      is
+      begin
+         case Width is
+            when W_8 =>
+               Add_Byte (Mem (Off));
+            when W_16 =>
+               Add_Byte (Mem (Off + 1));
+               Add_Byte (Mem (Off));
+            when W_32 =>
+               Add_Byte (Mem (Off + 3));
+               Add_Byte (Mem (Off + 2));
+               Add_Byte (Mem (Off + 1));
+               Add_Byte (Mem (Off + 0));
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Val;
+
+      function Decode_Val (Off : Natural; Width : Width_Type)
+                          return Unsigned_32
+      is
+         V : Unsigned_32;
+      begin
+         case Width is
+            when W_8 =>
+               V := Unsigned_32 (Mem (Off));
+               --  Sign extension.
+               if V >= 16#80# then
+                  V := 16#Ffff_Ff00# or V;
+               end if;
+               return V;
+            when W_16 =>
+               return Shift_Left (Unsigned_32 (Mem (Off + 1)), 8)
+                 or Unsigned_32 (Mem (Off));
+            when W_32 =>
+               return  Shift_Left (Unsigned_32 (Mem (Off + 3)), 24)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 2)), 16)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 1)), 8)
+                 or Shift_Left (Unsigned_32 (Mem (Off + 0)), 0);
+            when W_None
+              | W_Data =>
+               raise Program_Error;
+         end case;
+      end Decode_Val;
+
+      procedure Decode_Imm (Off : in out Natural; Width : Width_Type)
+      is
+      begin
+         Add_String ("$0x");
+         Decode_Val (Off, Width);
+         Off := Off + Width_Len (Width);
+      end Decode_Imm;
+
+      procedure Decode_Disp (Off : in out Natural;
+                             Width : Width_Type;
+                             Offset : Unsigned_32 := 0)
+      is
+         L : Natural;
+         V : Unsigned_32;
+         Off_Orig : constant Natural := Off;
+      begin
+         L := Lo;
+         V := Decode_Val (Off, Width) + Offset;
+         Off := Off + Width_Len (Width);
+         if Proc_Cb /= null then
+            Proc_Cb.all (Mem (Off)'Address,
+                         Line (Lo .. Line'Last), Lo);
+         end if;
+         if L /= Lo then
+            if V = 0 then
+               return;
+            end if;
+            Add_String (" + ");
+         end if;
+         Add_String ("0x");
+         if Offset = 0 then
+            Decode_Val (Off_Orig, Width);
+         else
+            Add_Byte (Byte (Shift_Right (V, 24) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 16) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 8) and 16#Ff#));
+            Add_Byte (Byte (Shift_Right (V, 0) and 16#Ff#));
+         end if;
+      end Decode_Disp;
+
+      procedure Decode_Modrm_Reg (B : Byte; Width : Width_Type) is
+      begin
+         Decode_Reg_Field (Ext_Modrm_Reg (B), Width);
+      end Decode_Modrm_Reg;
+
+      procedure Decode_Sib (Sib : Byte; B_Mod : Bf_2)
+      is
+         S : Bf_2;
+         I : Bf_3;
+         B : Bf_3;
+      begin
+         S := Ext_Sib_Scale (Sib);
+         B := Ext_Sib_Base (Sib);
+         I := Ext_Sib_Index (Sib);
+         Add_Char ('(');
+         if B = 2#101# and then B_Mod /= 0 then
+            Decode_Reg_Field (B, W_32);
+            Add_Char (',');
+         end if;
+         if I /= 2#100# then
+            Decode_Reg_Field (I, W_32);
+            case S is
+               when 2#00# =>
+                  null;
+               when 2#01# =>
+                  Add_String (",2");
+               when 2#10# =>
+                  Add_String (",4");
+               when 2#11# =>
+                  Add_String (",8");
+            end case;
+         end if;
+         Add_Char (')');
+      end Decode_Sib;
+
+      procedure Decode_Modrm_Mem (Off : in out Natural; Width : Width_Type)
+      is
+         B : Byte;
+         B_Mod : Bf_2;
+         B_Rm : Bf_3;
+         Off_Orig : Natural;
+      begin
+         B := Mem (Off);
+         B_Mod := Ext_Modrm_Mod (B);
+         B_Rm := Ext_Modrm_Rm (B);
+         Off_Orig := Off;
+         case B_Mod is
+            when 2#11# =>
+               Decode_Reg_Field (B_Rm, Width);
+               Off := Off + 1;
+            when 2#10# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Disp (Off, W_32);
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               else
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_32);
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+               end if;
+            when 2#01# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Disp (Off, W_8);
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               else
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_8);
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+               end if;
+            when 2#00# =>
+               if B_Rm = 2#100# then
+                  Off := Off + 2;
+                  Decode_Sib (Mem (Off_Orig + 1), B_Mod);
+               elsif B_Rm = 2#101# then
+                  Off := Off + 1;
+                  Decode_Disp (Off, W_32);
+               else
+                  Add_Char ('(');
+                  Decode_Reg_Field (B_Rm, W_32);
+                  Add_Char (')');
+                  Off := Off + 1;
+               end if;
+         end case;
+      end Decode_Modrm_Mem;
+
+      --  Return the length of the modrm bytes.
+      --  At least 1 (mod/rm), at most 6 (mod/rm + SUB + disp32).
+      function Decode_Modrm_Len (Off : Natural) return Natural
+      is
+         B : Byte;
+         M_Mod : Bf_2;
+         M_Rm : Bf_3;
+      begin
+         B := Mem (Off);
+         M_Mod := Ext_Modrm_Mod (B);
+         M_Rm := Ext_Modrm_Rm (B);
+         case M_Mod is
+            when 2#11# =>
+               return 1;
+            when 2#10# =>
+               if M_Rm = 2#100# then
+                  return 1 + 1 + 4;
+               else
+                  return 1 + 4;
+               end if;
+            when 2#01# =>
+               if M_Rm = 2#100# then
+                  return 1 + 1 + 1;
+               else
+                  return 1 + 1;
+               end if;
+            when 2#00# =>
+               if M_Rm = 2#101# then
+                  --  disp32.
+                  return 1 + 4;
+               elsif M_Rm = 2#100# then
+                  --  SIB
+                  return 1 + 1;
+               else
+                  return 1;
+               end if;
+         end case;
+      end Decode_Modrm_Len;
+
+
+      Off : Natural;
+      B : Byte;
+      B1 : Byte;
+      Desc : Insn_Desc_Type;
+      Name : Index_Type;
+      W : Width_Type;
+   begin
+      Mem := To_Pointer (Addr);
+      Off := 0;
+      Lo := Line'First;
+
+      B := Mem (0);
+      if B = 2#0000_1111# then
+         B := Mem (1);
+         Off := 2;
+         Insn_Len := 2;
+         Desc := Insn_Desc_0F (B);
+      else
+         Off := 1;
+         Insn_Len := 1;
+         Desc := Insn_Desc (B);
+      end if;
+
+      if Desc.Name >= G_1 then
+         B1 := Mem (Off);
+         case Desc.Name is
+            when G_1
+              | G_2 =>
+               Name := Group_Name (Desc.Name, Ext_543 (B1));
+            when G_3 =>
+               Desc := Insn_Desc_G3 (Ext_543 (B1));
+               Name := Desc.Name;
+            when G_5 =>
+               Desc := Insn_Desc_G5 (Ext_543 (B1));
+               Name := Desc.Name;
+            when others =>
+               Desc := Desc_Invalid;
+         end case;
+      else
+         Name := Desc.Name;
+      end if;
+
+      case Desc.Width is
+         when W_Data =>
+            W := W_Default;
+         when W_8
+           | W_16
+           | W_32 =>
+            W := Desc.Width;
+         when W_None =>
+            case Desc.Format is
+               when Disp_8
+                 | Cond_Disp_8
+                 | Imm_8 =>
+                  W := W_8;
+               when Disp_W
+                 | Cond_Disp_W =>
+                  W := W_Default;
+               when Invalid
+                 | Opcode =>
+                  W := W_None;
+               when others =>
+                  raise Program_Error;
+            end case;
+      end case;
+
+      case Desc.Format is
+         when Reg_Imp =>
+            Add_Opcode (Desc.Name, W_Default);
+            Decode_Reg_Field (Ext_210 (B), W_Default);
+         when Opcode =>
+            Add_Opcode (Desc.Name, W_None);
+         when Modrm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Modrm_Mem (Insn_Len, W);
+         when Modrm_Src =>
+            Add_Opcode (Desc.Name, W);
+            --  Disp source first.
+            Decode_Modrm_Mem (Insn_Len, W);
+            Add_Comma;
+            B := Mem (Off);
+            Decode_Modrm_Reg (Mem (Off), W);
+         when Modrm_Dst =>
+            Add_Opcode (Desc.Name, W);
+            --  Disp source first.
+            B := Mem (Off);
+            Decode_Modrm_Reg (B, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Insn_Len, W);
+         when Modrm_Imm =>
+            Add_Opcode (Name, W);
+            Insn_Len := Off + Decode_Modrm_Len (Off);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+         when Modrm_Imm_S =>
+            Add_Opcode (Name, W);
+            Insn_Len := Off + Decode_Modrm_Len (Off);
+            Decode_Imm (Insn_Len, W_8);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+         when Modrm_Imm8 =>
+            Add_Opcode (Name, W);
+            Decode_Modrm_Mem (Off, W);
+            Add_Comma;
+            Decode_Imm (Off, W_8);
+
+         when Reg_Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (Ext_210 (B), W);
+         when Eax_Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (2#000#, W);
+
+         when Disp_W
+           | Disp_8 =>
+            Add_Opcode (Desc.Name, W_None);
+            Decode_Disp (Insn_Len, W,
+                         Pc + Unsigned_32 (Insn_Len + Width_Len (W)));
+
+         when Cond_Disp_8
+           | Cond_Disp_W =>
+            Add_Cond_Opcode (Desc.Name, B);
+            Decode_Disp (Insn_Len, W,
+                         Pc + Unsigned_32 (Insn_Len + Width_Len (W)));
+
+         when Cond_Modrm =>
+            Add_Cond_Opcode (Desc.Name, B);
+            Decode_Modrm_Mem (Insn_Len, W);
+
+         when Imm =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W);
+
+         when Imm_S
+           | Imm_8 =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Imm (Insn_Len, W_8);
+
+         when Modrm_Ax =>
+            if (B and 2#1#) = 2#0# then
+               W := W_8;
+            else
+               W := W_Default;
+            end if;
+            Add_Opcode (Desc.Name, W);
+            Decode_Reg_Field (0, W);
+            Add_Comma;
+            Decode_Modrm_Mem (Off, W);
+
+         when Ax_Off_Src =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Disp (Insn_Len, W);
+            Add_Comma;
+            Decode_Reg_Field (0, W);
+
+         when Ax_Off_Dst =>
+            Add_Opcode (Desc.Name, W);
+            Decode_Reg_Field (0, W);
+            Add_Comma;
+            Decode_Disp (Insn_Len, W);
+
+         when Imp =>
+            Add_Opcode (Desc.Name, W_Default);
+
+         when Invalid
+           | Prefix
+           | Opcode2 =>
+            Add_String ("invalid ");
+            if Insn_Len = 2 then
+               Add_Byte (Mem (0));
+            end if;
+            Add_Byte (B);
+            Insn_Len := 1;
+      end case;
+
+      Line_Len := Lo - Line'First;
+   end Disassemble_Insn;
+end Disa_X86;
+
+
diff --git a/src/ortho/mcode/disa_x86.ads b/src/ortho/mcode/disa_x86.ads
new file mode 100644
index 000000000..c215cf0a3
--- /dev/null
+++ b/src/ortho/mcode/disa_x86.ads
@@ -0,0 +1,34 @@
+--  X86 disassembler.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Disa_X86 is
+   --  Call-back used to find a relocation symbol.
+   type Symbol_Proc_Type is access procedure (Addr : System.Address;
+                                              Line : in out String;
+                                              Line_Len : in out Natural);
+
+   --  Disassemble instruction at ADDR, and put the result in LINE/LINE_LEN.
+   procedure Disassemble_Insn (Addr : System.Address;
+                               Pc : Unsigned_32;
+                               Line : in out String;
+                               Line_Len : out Natural;
+                               Insn_Len : out Natural;
+                               Proc_Cb : Symbol_Proc_Type);
+end Disa_X86;
diff --git a/src/ortho/mcode/disassemble.ads b/src/ortho/mcode/disassemble.ads
new file mode 100644
index 000000000..5c9811fed
--- /dev/null
+++ b/src/ortho/mcode/disassemble.ads
@@ -0,0 +1,3 @@
+with Disa_X86;
+
+package Disassemble renames Disa_X86;
diff --git a/src/ortho/mcode/dwarf.ads b/src/ortho/mcode/dwarf.ads
new file mode 100644
index 000000000..40ee94f10
--- /dev/null
+++ b/src/ortho/mcode/dwarf.ads
@@ -0,0 +1,446 @@
+--  DWARF definitions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Dwarf is
+   DW_TAG_Array_Type               : constant := 16#01#;
+   DW_TAG_Class_Type               : constant := 16#02#;
+   DW_TAG_Entry_Point              : constant := 16#03#;
+   DW_TAG_Enumeration_Type         : constant := 16#04#;
+   DW_TAG_Formal_Parameter         : constant := 16#05#;
+   DW_TAG_Imported_Declaration     : constant := 16#08#;
+   DW_TAG_Label                    : constant := 16#0a#;
+   DW_TAG_Lexical_Block            : constant := 16#0b#;
+   DW_TAG_Member                   : constant := 16#0d#;
+   DW_TAG_Pointer_Type             : constant := 16#0f#;
+   DW_TAG_Reference_Type           : constant := 16#10#;
+   DW_TAG_Compile_Unit             : constant := 16#11#;
+   DW_TAG_String_Type              : constant := 16#12#;
+   DW_TAG_Structure_Type           : constant := 16#13#;
+   DW_TAG_Subroutine_Type          : constant := 16#15#;
+   DW_TAG_Typedef                  : constant := 16#16#;
+   DW_TAG_Union_Type               : constant := 16#17#;
+   DW_TAG_Unspecified_Parameters   : constant := 16#18#;
+   DW_TAG_Variant                  : constant := 16#19#;
+   DW_TAG_Common_Block             : constant := 16#1a#;
+   DW_TAG_Common_Inclusion         : constant := 16#1b#;
+   DW_TAG_Inheritance              : constant := 16#1c#;
+   DW_TAG_Inlined_Subroutine       : constant := 16#1d#;
+   DW_TAG_Module                   : constant := 16#1e#;
+   DW_TAG_Ptr_To_Member_Type       : constant := 16#1f#;
+   DW_TAG_Set_Type                 : constant := 16#20#;
+   DW_TAG_Subrange_Type            : constant := 16#21#;
+   DW_TAG_With_Stmt                : constant := 16#22#;
+   DW_TAG_Access_Declaration       : constant := 16#23#;
+   DW_TAG_Base_Type                : constant := 16#24#;
+   DW_TAG_Catch_Block              : constant := 16#25#;
+   DW_TAG_Const_Type               : constant := 16#26#;
+   DW_TAG_Constant                 : constant := 16#27#;
+   DW_TAG_Enumerator               : constant := 16#28#;
+   DW_TAG_File_Type                : constant := 16#29#;
+   DW_TAG_Friend                   : constant := 16#2a#;
+   DW_TAG_Namelist                 : constant := 16#2b#;
+   DW_TAG_Namelist_Item            : constant := 16#2c#;
+   DW_TAG_Packed_Type              : constant := 16#2d#;
+   DW_TAG_Subprogram               : constant := 16#2e#;
+   DW_TAG_Template_Type_Parameter  : constant := 16#2f#;
+   DW_TAG_Template_Value_Parameter : constant := 16#30#;
+   DW_TAG_Thrown_Type              : constant := 16#31#;
+   DW_TAG_Try_Block                : constant := 16#32#;
+   DW_TAG_Variant_Part             : constant := 16#33#;
+   DW_TAG_Variable                 : constant := 16#34#;
+   DW_TAG_Volatile_Type            : constant := 16#35#;
+   DW_TAG_Dwarf_Procedure          : constant := 16#36#;
+   DW_TAG_Restrict_Type            : constant := 16#37#;
+   DW_TAG_Interface_Type           : constant := 16#38#;
+   DW_TAG_Namespace                : constant := 16#39#;
+   DW_TAG_Imported_Module          : constant := 16#3a#;
+   DW_TAG_Unspecified_Type         : constant := 16#3b#;
+   DW_TAG_Partial_Unit             : constant := 16#3c#;
+   DW_TAG_Imported_Unit            : constant := 16#3d#;
+   DW_TAG_Mutable_Type             : constant := 16#3e#;
+   DW_TAG_Lo_User                  : constant := 16#4080#;
+   DW_TAG_Hi_User                  : constant := 16#Ffff#;
+
+   DW_CHILDREN_No      : constant := 16#0#;
+   DW_CHILDREN_Yes     : constant := 16#1#;
+
+   DW_AT_Sibling              : constant := 16#01#; -- reference
+   DW_AT_Location             : constant := 16#02#; -- block, loclistptr
+   DW_AT_Name                 : constant := 16#03#; -- string
+   DW_AT_Ordering             : constant := 16#09#; -- constant
+   DW_AT_Byte_Size            : constant := 16#0b#; -- block, constant, ref
+   DW_AT_Bit_Offset           : constant := 16#0c#; -- block, constant, ref
+   DW_AT_Bit_Size             : constant := 16#0d#; -- block, constant, ref
+   DW_AT_Stmt_List            : constant := 16#10#; -- lineptr
+   DW_AT_Low_Pc               : constant := 16#11#; -- address
+   DW_AT_High_Pc              : constant := 16#12#; -- address
+   DW_AT_Language             : constant := 16#13#; -- constant
+   DW_AT_Discr                : constant := 16#15#; -- reference
+   DW_AT_Discr_Value          : constant := 16#16#; -- constant
+   DW_AT_Visibility           : constant := 16#17#; -- constant
+   DW_AT_Import               : constant := 16#18#; -- reference
+   DW_AT_String_Length        : constant := 16#19#; -- block, loclistptr
+   DW_AT_Common_Reference     : constant := 16#1a#; -- reference
+   DW_AT_Comp_Dir             : constant := 16#1b#; -- string
+   DW_AT_Const_Value          : constant := 16#1c#; -- block, constant, string
+   DW_AT_Containing_Type      : constant := 16#1d#; -- reference
+   DW_AT_Default_Value        : constant := 16#1e#; -- reference
+   DW_AT_Inline               : constant := 16#20#; -- constant
+   DW_AT_Is_Optional          : constant := 16#21#; -- flag
+   DW_AT_Lower_Bound          : constant := 16#22#; -- block, constant, ref
+   DW_AT_Producer             : constant := 16#25#; -- string
+   DW_AT_Prototyped           : constant := 16#27#; -- flag
+   DW_AT_Return_Addr          : constant := 16#2a#; -- block, loclistptr
+   DW_AT_Start_Scope          : constant := 16#2c#; -- constant
+   DW_AT_Stride_Size          : constant := 16#2e#; -- constant
+   DW_AT_Upper_Bound          : constant := 16#2f#; -- block, constant, ref
+   DW_AT_Abstract_Origin      : constant := 16#31#; -- reference
+   DW_AT_Accessibility        : constant := 16#32#; -- constant
+   DW_AT_Address_Class        : constant := 16#33#; -- constant
+   DW_AT_Artificial           : constant := 16#34#; -- flag
+   DW_AT_Base_Types           : constant := 16#35#; -- reference
+   DW_AT_Calling_Convention   : constant := 16#36#; -- constant
+   DW_AT_Count                : constant := 16#37#; -- block, constant, ref
+   DW_AT_Data_Member_Location : constant := 16#38#; -- block, const, loclistptr
+   DW_AT_Decl_Column          : constant := 16#39#; -- constant
+   DW_AT_Decl_File            : constant := 16#3a#; -- constant
+   DW_AT_Decl_Line            : constant := 16#3b#; -- constant
+   DW_AT_Declaration          : constant := 16#3c#; -- flag
+   DW_AT_Discr_List           : constant := 16#3d#; -- block
+   DW_AT_Encoding             : constant := 16#3e#; -- constant
+   DW_AT_External             : constant := 16#3f#; -- flag
+   DW_AT_Frame_Base           : constant := 16#40#; -- block, loclistptr
+   DW_AT_Friend               : constant := 16#41#; -- reference
+   DW_AT_Identifier_Case      : constant := 16#42#; -- constant
+   DW_AT_Macro_Info           : constant := 16#43#; -- macptr
+   DW_AT_Namelist_Item        : constant := 16#44#; -- block
+   DW_AT_Priority             : constant := 16#45#; -- reference
+   DW_AT_Segment              : constant := 16#46#; -- block, constant
+   DW_AT_Specification        : constant := 16#47#; -- reference
+   DW_AT_Static_Link          : constant := 16#48#; -- block, loclistptr
+   DW_AT_Type                 : constant := 16#49#; -- reference
+   DW_AT_Use_Location         : constant := 16#4a#; -- block, loclistptr
+   DW_AT_Variable_Parameter   : constant := 16#4b#; -- flag
+   DW_AT_Virtuality           : constant := 16#4c#; -- constant
+   DW_AT_Vtable_Elem_Location : constant := 16#4d#; -- block, loclistptr
+   DW_AT_Allocated            : constant := 16#4e#; -- block, constant, ref
+   DW_AT_Associated           : constant := 16#4f#; -- block, constant, ref
+   DW_AT_Data_Location        : constant := 16#50#; -- x50block
+   DW_AT_Stride               : constant := 16#51#; -- block, constant, ref
+   DW_AT_Entry_Pc             : constant := 16#52#; -- address
+   DW_AT_Use_UTF8             : constant := 16#53#; -- flag
+   DW_AT_Extension            : constant := 16#04#; -- reference
+   DW_AT_Ranges               : constant := 16#55#; -- rangelistptr
+   DW_AT_Trampoline           : constant := 16#56#; -- address, flag, ref, str
+   DW_AT_Call_Column          : constant := 16#57#; -- constant
+   DW_AT_Call_File            : constant := 16#58#; -- constant
+   DW_AT_Call_Line            : constant := 16#59#; -- constant
+   DW_AT_Description          : constant := 16#5a#; -- string
+   DW_AT_Lo_User              : constant := 16#2000#; -- ---
+   DW_AT_Hi_User              : constant := 16#3fff#; -- ---
+
+   DW_FORM_Addr      : constant := 16#01#; -- address
+   DW_FORM_Block2    : constant := 16#03#; -- block
+   DW_FORM_Block4    : constant := 16#04#; -- block
+   DW_FORM_Data2     : constant := 16#05#; -- constant
+   DW_FORM_Data4     : constant := 16#06#; -- constant, lineptr, loclistptr...
+   DW_FORM_Data8     : constant := 16#07#; -- ...  macptr, rangelistptr
+   DW_FORM_String    : constant := 16#08#; -- string
+   DW_FORM_Block     : constant := 16#09#; -- block
+   DW_FORM_Block1    : constant := 16#0a#; -- block
+   DW_FORM_Data1     : constant := 16#0b#; -- constant
+   DW_FORM_Flag      : constant := 16#0c#; -- flag
+   DW_FORM_Sdata     : constant := 16#0d#; -- constant
+   DW_FORM_Strp      : constant := 16#0e#; -- string
+   DW_FORM_Udata     : constant := 16#0f#; -- constant
+   DW_FORM_Ref_Addr  : constant := 16#10#; -- reference
+   DW_FORM_Ref1      : constant := 16#11#; -- reference
+   DW_FORM_Ref2      : constant := 16#12#; -- reference
+   DW_FORM_Ref4      : constant := 16#13#; -- reference
+   DW_FORM_Ref8      : constant := 16#14#; -- reference
+   DW_FORM_Ref_Udata : constant := 16#15#; -- reference
+   DW_FORM_Indirect  : constant := 16#16#; -- (see Section 7.5.3)
+
+
+   DW_OP_Addr        : constant := 16#03#; -- 1 constant address (target spec)
+   DW_OP_Deref       : constant := 16#06#; -- 0
+   DW_OP_Const1u     : constant := 16#08#; -- 1 1-byte constant
+   DW_OP_Const1s     : constant := 16#09#; -- 1 1-byte constant
+   DW_OP_Const2u     : constant := 16#0a#; -- 1 2-byte constant
+   DW_OP_Const2s     : constant := 16#0b#; -- 1 2-byte constant
+   DW_OP_Const4u     : constant := 16#0c#; -- 1 4-byte constant
+   DW_OP_Const4s     : constant := 16#0d#; -- 1 4-byte constant
+   DW_OP_Const8u     : constant := 16#0e#; -- 1 8-byte constant
+   DW_OP_Const8s     : constant := 16#0f#; -- 1 8-byte constant
+   DW_OP_Constu      : constant := 16#10#; -- 1 ULEB128 constant
+   DW_OP_Consts      : constant := 16#11#; -- 1 SLEB128 constant
+   DW_OP_Dup         : constant := 16#12#; -- 0
+   DW_OP_Drop        : constant := 16#13#; -- 0
+   DW_OP_Over        : constant := 16#14#; -- 0
+   DW_OP_Pick        : constant := 16#15#; -- 1 1-byte stack index
+   DW_OP_Swap        : constant := 16#16#; -- 0
+   DW_OP_Rot         : constant := 16#17#; -- 0
+   DW_OP_Xderef      : constant := 16#18#; -- 0
+   DW_OP_Abs         : constant := 16#19#; -- 0
+   DW_OP_And         : constant := 16#1a#; -- 0
+   DW_OP_Div         : constant := 16#1b#; -- 0
+   DW_OP_Minus       : constant := 16#1c#; -- 0
+   DW_OP_Mod         : constant := 16#1d#; -- 0
+   DW_OP_Mul         : constant := 16#1e#; -- 0
+   DW_OP_Neg         : constant := 16#1f#; -- 0
+   DW_OP_Not         : constant := 16#20#; -- 0
+   DW_OP_Or          : constant := 16#21#; -- 0
+   DW_OP_Plus        : constant := 16#22#; -- 0
+   DW_OP_Plus_Uconst : constant := 16#23#; -- 1 ULEB128 addend
+   DW_OP_Shl         : constant := 16#24#; -- 0
+   DW_OP_Shr         : constant := 16#25#; -- 0
+   DW_OP_Shra        : constant := 16#26#; -- 0
+   DW_OP_Xor         : constant := 16#27#; -- 0
+   DW_OP_Skip        : constant := 16#2f#; -- 1 signed 2-byte constant
+   DW_OP_Bra         : constant := 16#28#; -- 1 signed 2-byte constant
+   DW_OP_Eq          : constant := 16#29#; -- 0
+   DW_OP_Ge          : constant := 16#2a#; -- 0
+   DW_OP_Gt          : constant := 16#2b#; -- 0
+   DW_OP_Le          : constant := 16#2c#; -- 0
+   DW_OP_Lt          : constant := 16#2d#; -- 0
+   DW_OP_Ne          : constant := 16#2e#; -- 0
+   DW_OP_Lit0        : constant := 16#30#; -- 0
+   DW_OP_Lit1        : constant := 16#31#; -- 0
+   DW_OP_Lit2        : constant := 16#32#; -- 0
+   DW_OP_Lit3        : constant := 16#33#; -- 0
+   DW_OP_Lit4        : constant := 16#34#; -- 0
+   DW_OP_Lit5        : constant := 16#35#; -- 0
+   DW_OP_Lit6        : constant := 16#36#; -- 0
+   DW_OP_Lit7        : constant := 16#37#; -- 0
+   DW_OP_Lit8        : constant := 16#38#; -- 0
+   DW_OP_Lit9        : constant := 16#39#; -- 0
+   DW_OP_Lit10       : constant := 16#3a#; -- 0
+   DW_OP_Lit11       : constant := 16#3b#; -- 0
+   DW_OP_Lit12       : constant := 16#3c#; -- 0
+   DW_OP_Lit13       : constant := 16#3d#; -- 0
+   DW_OP_Lit14       : constant := 16#3e#; -- 0
+   DW_OP_Lit15       : constant := 16#3f#; -- 0
+   DW_OP_Lit16       : constant := 16#40#; -- 0
+   DW_OP_Lit17       : constant := 16#41#; -- 0
+   DW_OP_Lit18       : constant := 16#42#; -- 0
+   DW_OP_Lit19       : constant := 16#43#; -- 0
+   DW_OP_Lit20       : constant := 16#44#; -- 0
+   DW_OP_Lit21       : constant := 16#45#; -- 0
+   DW_OP_Lit22       : constant := 16#46#; -- 0
+   DW_OP_Lit23       : constant := 16#47#; -- 0
+   DW_OP_Lit24       : constant := 16#48#; -- 0
+   DW_OP_Lit25       : constant := 16#49#; -- 0
+   DW_OP_Lit26       : constant := 16#4a#; -- 0
+   DW_OP_Lit27       : constant := 16#4b#; -- 0
+   DW_OP_Lit28       : constant := 16#4c#; -- 0
+   DW_OP_Lit29       : constant := 16#4d#; -- 0
+   DW_OP_Lit30       : constant := 16#4e#; -- 0
+   DW_OP_Lit31       : constant := 16#4f#; -- 0
+   DW_OP_Reg0        : constant := 16#50#; -- 0
+   DW_OP_Reg1        : constant := 16#51#; -- 0
+   DW_OP_Reg2        : constant := 16#52#; -- 0
+   DW_OP_Reg3        : constant := 16#53#; -- 0
+   DW_OP_Reg4        : constant := 16#54#; -- 0
+   DW_OP_Reg5        : constant := 16#55#; -- 0
+   DW_OP_Reg6        : constant := 16#56#; -- 0
+   DW_OP_Reg7        : constant := 16#57#; -- 0
+   DW_OP_Reg8        : constant := 16#58#; -- 0
+   DW_OP_Reg9        : constant := 16#59#; -- 0
+   DW_OP_Reg10       : constant := 16#5a#; -- 0
+   DW_OP_Reg11       : constant := 16#5b#; -- 0
+   DW_OP_Reg12       : constant := 16#5c#; -- 0
+   DW_OP_Reg13       : constant := 16#5d#; -- 0
+   DW_OP_Reg14       : constant := 16#5e#; -- 0
+   DW_OP_Reg15       : constant := 16#5f#; -- 0
+   DW_OP_Reg16       : constant := 16#60#; -- 0
+   DW_OP_Reg17       : constant := 16#61#; -- 0
+   DW_OP_Reg18       : constant := 16#62#; -- 0
+   DW_OP_Reg19       : constant := 16#63#; -- 0
+   DW_OP_Reg20       : constant := 16#64#; -- 0
+   DW_OP_Reg21       : constant := 16#65#; -- 0
+   DW_OP_Reg22       : constant := 16#66#; -- 0
+   DW_OP_Reg23       : constant := 16#67#; -- 0
+   DW_OP_Reg24       : constant := 16#68#; -- 0
+   DW_OP_Reg25       : constant := 16#69#; -- 0
+   DW_OP_Reg26       : constant := 16#6a#; -- 0
+   DW_OP_Reg27       : constant := 16#6b#; -- 0
+   DW_OP_Reg28       : constant := 16#6c#; -- 0
+   DW_OP_Reg29       : constant := 16#6d#; -- 0
+   DW_OP_Reg30       : constant := 16#6e#; -- 0
+   DW_OP_Reg31       : constant := 16#6f#; -- 0 reg 0..31
+   DW_OP_Breg0       : constant := 16#70#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg1       : constant := 16#71#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg2       : constant := 16#72#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg3       : constant := 16#73#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg4       : constant := 16#74#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg5       : constant := 16#75#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg6       : constant := 16#76#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg7       : constant := 16#77#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg8       : constant := 16#78#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg9       : constant := 16#79#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg10      : constant := 16#7a#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg11      : constant := 16#7b#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg12      : constant := 16#7c#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg13      : constant := 16#7d#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg14      : constant := 16#7e#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg15      : constant := 16#7f#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg16      : constant := 16#80#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg17      : constant := 16#81#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg18      : constant := 16#82#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg19      : constant := 16#83#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg20      : constant := 16#84#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg21      : constant := 16#85#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg22      : constant := 16#86#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg23      : constant := 16#87#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg24      : constant := 16#88#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg25      : constant := 16#89#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg26      : constant := 16#8a#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg27      : constant := 16#8b#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg28      : constant := 16#8c#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg29      : constant := 16#8d#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg30      : constant := 16#8e#; -- 1 SLEB128 offset base reg
+   DW_OP_Breg31      : constant := 16#8f#; -- 1 SLEB128 offset base reg 0..31
+   DW_OP_Regx        : constant := 16#90#; -- 1 ULEB128 register
+   DW_OP_Fbreg       : constant := 16#91#; -- 1 SLEB128 offset
+   DW_OP_Bregx       : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset
+   DW_OP_Piece       : constant := 16#93#; -- 1 ULEB128 size of piece addressed
+   DW_OP_Deref_Size  : constant := 16#94#; -- 1 1-byte size of data retrieved
+   DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved
+   DW_OP_Nop         : constant := 16#96#; -- 0
+   DW_OP_Push_Object_Address : constant := 16#97#; -- 0
+   DW_OP_Call2       : constant := 16#98#; -- 1 2-byte offset of DIE
+   DW_OP_Call4       : constant := 16#99#; -- 1 4-byte offset of DIE
+   DW_OP_Call_Ref    : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE
+   DW_OP_Lo_User     : constant := 16#E0#; --
+   DW_OP_Hi_User     : constant := 16#ff#; --
+
+   DW_ATE_Address         : constant := 16#1#;
+   DW_ATE_Boolean         : constant := 16#2#;
+   DW_ATE_Complex_Float   : constant := 16#3#;
+   DW_ATE_Float           : constant := 16#4#;
+   DW_ATE_Signed          : constant := 16#5#;
+   DW_ATE_Signed_Char     : constant := 16#6#;
+   DW_ATE_Unsigned        : constant := 16#7#;
+   DW_ATE_Unsigned_Char   : constant := 16#8#;
+   DW_ATE_Imaginary_Float : constant := 16#9#;
+   DW_ATE_Lo_User         : constant := 16#80#;
+   DW_ATE_Hi_User         : constant := 16#ff#;
+
+   DW_ACCESS_Public       : constant := 1;
+   DW_ACCESS_Protected    : constant := 2;
+   DW_ACCESS_Private      : constant := 3;
+
+   DW_LANG_C89            : constant := 16#0001#;
+   DW_LANG_C              : constant := 16#0002#;
+   DW_LANG_Ada83          : constant := 16#0003#;
+   DW_LANG_C_Plus_Plus    : constant := 16#0004#;
+   DW_LANG_Cobol74        : constant := 16#0005#;
+   DW_LANG_Cobol85        : constant := 16#0006#;
+   DW_LANG_Fortran77      : constant := 16#0007#;
+   DW_LANG_Fortran90      : constant := 16#0008#;
+   DW_LANG_Pascal83       : constant := 16#0009#;
+   DW_LANG_Modula2        : constant := 16#000a#;
+   DW_LANG_Java           : constant := 16#000b#;
+   DW_LANG_C99            : constant := 16#000c#;
+   DW_LANG_Ada95          : constant := 16#000d#;
+   DW_LANG_Fortran95      : constant := 16#000e#;
+   DW_LANG_PLI            : constant := 16#000f#;
+   DW_LANG_Lo_User        : constant := 16#8000#;
+   DW_LANG_Hi_User        : constant := 16#ffff#;
+
+   DW_ID_Case_Sensitive   : constant := 0;
+   DW_ID_Up_Case          : constant := 1;
+   DW_ID_Down_Case        : constant := 2;
+   DW_ID_Case_Insensitive : constant := 3;
+
+   DW_CC_Normal           : constant := 16#1#;
+   DW_CC_Program          : constant := 16#2#;
+   DW_CC_Nocall           : constant := 16#3#;
+   DW_CC_Lo_User          : constant := 16#40#;
+   DW_CC_Hi_User          : constant := 16#Ff#;
+
+   DW_INL_Not_Inlined          : constant := 0;
+   DW_INL_Inlined              : constant := 1;
+   DW_INL_Declared_Not_Inlined : constant := 2;
+   DW_INL_Declared_Inlined     : constant := 3;
+
+   --  Line number information.
+   --  Line number standard opcode.
+   DW_LNS_Copy               : constant Unsigned_8 := 1;
+   DW_LNS_Advance_Pc         : constant Unsigned_8 := 2;
+   DW_LNS_Advance_Line       : constant Unsigned_8 := 3;
+   DW_LNS_Set_File           : constant Unsigned_8 := 4;
+   DW_LNS_Set_Column         : constant Unsigned_8 := 5;
+   DW_LNS_Negate_Stmt        : constant Unsigned_8 := 6;
+   DW_LNS_Set_Basic_Block    : constant Unsigned_8 := 7;
+   DW_LNS_Const_Add_Pc       : constant Unsigned_8 := 8;
+   DW_LNS_Fixed_Advance_Pc   : constant Unsigned_8 := 9;
+   DW_LNS_Set_Prologue_End   : constant Unsigned_8 := 10;
+   DW_LNS_Set_Epilogue_Begin : constant Unsigned_8 := 11;
+   DW_LNS_Set_Isa            : constant Unsigned_8 := 12;
+
+   --  Line number extended opcode.
+   DW_LNE_End_Sequence       : constant Unsigned_8 := 1;
+   DW_LNE_Set_Address        : constant Unsigned_8 := 2;
+   DW_LNE_Define_File        : constant Unsigned_8 := 3;
+   DW_LNE_Lo_User            : constant Unsigned_8 := 128;
+   DW_LNE_Hi_User            : constant Unsigned_8 := 255;
+
+   DW_CFA_Advance_Loc        : constant Unsigned_8 := 16#40#;
+   DW_CFA_Advance_Loc_Min    : constant Unsigned_8 := 16#40#;
+   DW_CFA_Advance_Loc_Max    : constant Unsigned_8 := 16#7f#;
+   DW_CFA_Offset             : constant Unsigned_8 := 16#80#;
+   DW_CFA_Offset_Min         : constant Unsigned_8 := 16#80#;
+   DW_CFA_Offset_Max         : constant Unsigned_8 := 16#Bf#;
+   DW_CFA_Restore            : constant Unsigned_8 := 16#C0#;
+   DW_CFA_Restore_Min        : constant Unsigned_8 := 16#C0#;
+   DW_CFA_Restore_Max        : constant Unsigned_8 := 16#FF#;
+   DW_CFA_Nop                : constant Unsigned_8 := 16#00#;
+   DW_CFA_Set_Loc            : constant Unsigned_8 := 16#01#;
+   DW_CFA_Advance_Loc1       : constant Unsigned_8 := 16#02#;
+   DW_CFA_Advance_Loc2       : constant Unsigned_8 := 16#03#;
+   DW_CFA_Advance_Loc4       : constant Unsigned_8 := 16#04#;
+   DW_CFA_Offset_Extended    : constant Unsigned_8 := 16#05#;
+   DW_CFA_Restore_Extended   : constant Unsigned_8 := 16#06#;
+   DW_CFA_Undefined          : constant Unsigned_8 := 16#07#;
+   DW_CFA_Same_Value         : constant Unsigned_8 := 16#08#;
+   DW_CFA_Register           : constant Unsigned_8 := 16#09#;
+   DW_CFA_Remember_State     : constant Unsigned_8 := 16#0a#;
+   DW_CFA_Restore_State      : constant Unsigned_8 := 16#0b#;
+   DW_CFA_Def_Cfa            : constant Unsigned_8 := 16#0c#;
+   DW_CFA_Def_Cfa_Register   : constant Unsigned_8 := 16#0d#;
+   DW_CFA_Def_Cfa_Offset     : constant Unsigned_8 := 16#0e#;
+   DW_CFA_Def_Cfa_Expression : constant Unsigned_8 := 16#0f#;
+
+   DW_EH_PE_Omit    : constant Unsigned_8 := 16#Ff#;
+   DW_EH_PE_Uleb128 : constant Unsigned_8 := 16#01#;
+   DW_EH_PE_Udata2  : constant Unsigned_8 := 16#02#;
+   DW_EH_PE_Udata4  : constant Unsigned_8 := 16#03#;
+   DW_EH_PE_Udata8  : constant Unsigned_8 := 16#04#;
+   DW_EH_PE_Sleb128 : constant Unsigned_8 := 16#09#;
+   DW_EH_PE_Sdata2  : constant Unsigned_8 := 16#0A#;
+   DW_EH_PE_Sdata4  : constant Unsigned_8 := 16#0B#;
+   DW_EH_PE_Sdata8  : constant Unsigned_8 := 16#0C#;
+   DW_EH_PE_Absptr  : constant Unsigned_8 := 16#00#;
+   DW_EH_PE_Pcrel   : constant Unsigned_8 := 16#10#;
+   DW_EH_PE_Datarel : constant Unsigned_8 := 16#30#;
+   DW_EH_PE_Format_Mask : constant Unsigned_8 := 16#0f#;
+end Dwarf;
+
+
diff --git a/src/ortho/mcode/elf32.adb b/src/ortho/mcode/elf32.adb
new file mode 100644
index 000000000..ef58fe64b
--- /dev/null
+++ b/src/ortho/mcode/elf32.adb
@@ -0,0 +1,48 @@
+--  ELF32 definitions.
+--  Copyright (C) 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.
+package body Elf32 is
+   function Elf32_St_Bind (Info : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Shift_Right (Info, 4);
+   end Elf32_St_Bind;
+
+   function Elf32_St_Type (Info : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Info and 16#0F#;
+   end Elf32_St_Type;
+
+   function Elf32_St_Info (B, T : Elf32_Uchar) return Elf32_Uchar is
+   begin
+      return Shift_Left (B, 4) or T;
+   end Elf32_St_Info;
+
+   function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word is
+   begin
+      return Shift_Right (I, 8);
+   end Elf32_R_Sym;
+
+   function Elf32_R_Type (I : Elf32_Word) return Elf32_Word is
+   begin
+      return I and 16#Ff#;
+   end Elf32_R_Type;
+
+   function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word is
+   begin
+      return Shift_Left (S, 8) or T;
+   end Elf32_R_Info;
+end Elf32;
diff --git a/src/ortho/mcode/elf32.ads b/src/ortho/mcode/elf32.ads
new file mode 100644
index 000000000..5afd317f6
--- /dev/null
+++ b/src/ortho/mcode/elf32.ads
@@ -0,0 +1,124 @@
+--  ELF32 definitions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with System;
+with Elf_Common; use Elf_Common;
+
+package Elf32 is
+   subtype Elf32_Addr  is Unsigned_32;
+   subtype Elf32_Half  is Unsigned_16;
+   subtype Elf32_Off   is Unsigned_32;
+   subtype Elf32_Sword is Integer_32;
+   subtype Elf32_Word  is Unsigned_32;
+   subtype Elf32_Uchar is Unsigned_8;
+
+   type Elf32_Ehdr is record
+      E_Ident     : E_Ident_Type;
+      E_Type      : Elf32_Half;
+      E_Machine   : Elf32_Half;
+      E_Version   : Elf32_Word;
+      E_Entry     : Elf32_Addr;
+      E_Phoff     : Elf32_Off;
+      E_Shoff     : Elf32_Off;
+      E_Flags     : Elf32_Word;
+      E_Ehsize    : Elf32_Half;
+      E_Phentsize : Elf32_Half;
+      E_Phnum     : Elf32_Half;
+      E_Shentsize : Elf32_Half;
+      E_Shnum     : Elf32_Half;
+      E_Shstrndx  : Elf32_Half;
+   end record;
+
+   Elf32_Ehdr_Size : constant Natural := Elf32_Ehdr'Size / System.Storage_Unit;
+
+   type Elf32_Shdr is record
+      Sh_Name      : Elf32_Word;
+      Sh_Type      : Elf32_Word;
+      Sh_Flags     : Elf32_Word;
+      Sh_Addr      : Elf32_Addr;
+      Sh_Offset    : Elf32_Off;
+      Sh_Size      : Elf32_Word;
+      Sh_Link      : Elf32_Word;
+      Sh_Info      : Elf32_Word;
+      Sh_Addralign : Elf32_Word;
+      Sh_Entsize   : Elf32_Word;
+   end record;
+   Elf32_Shdr_Size : constant Natural := Elf32_Shdr'Size / System.Storage_Unit;
+
+   --  Symbol table.
+   type Elf32_Sym is record
+      St_Name  : Elf32_Word;
+      St_Value : Elf32_Addr;
+      St_Size  : Elf32_Word;
+      St_Info  : Elf32_Uchar;
+      St_Other : Elf32_Uchar;
+      St_Shndx : Elf32_Half;
+   end record;
+   Elf32_Sym_Size : constant Natural := Elf32_Sym'Size / System.Storage_Unit;
+
+   function Elf32_St_Bind (Info : Elf32_Uchar) return Elf32_Uchar;
+   function Elf32_St_Type (Info : Elf32_Uchar) return Elf32_Uchar;
+   function Elf32_St_Info (B, T : Elf32_Uchar) return Elf32_Uchar;
+   pragma Inline (Elf32_St_Bind);
+   pragma Inline (Elf32_St_Type);
+   pragma Inline (Elf32_St_Info);
+
+   --  Relocation.
+   type Elf32_Rel is record
+      R_Offset : Elf32_Addr;
+      R_Info : Elf32_Word;
+   end record;
+   Elf32_Rel_Size : constant Natural := Elf32_Rel'Size / System.Storage_Unit;
+
+   type Elf32_Rela is record
+      R_Offset : Elf32_Addr;
+      R_Info : Elf32_Word;
+      R_Addend : Elf32_Sword;
+   end record;
+   Elf32_Rela_Size : constant Natural := Elf32_Rela'Size / System.Storage_Unit;
+
+   function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word;
+   function Elf32_R_Type (I : Elf32_Word) return Elf32_Word;
+   function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word;
+
+   --  For i386
+   R_386_NONE : constant Elf32_Word := 0; -- none none
+   R_386_32   : constant Elf32_Word := 1; -- word32 S+A
+   R_386_PC32 : constant Elf32_Word := 2; -- word32 S+A-P
+
+   --  For sparc
+   R_SPARC_NONE    : constant Elf32_Word := 0; -- none
+   R_SPARC_32 :      constant Elf32_Word := 3; -- (S + A)
+   R_SPARC_WDISP30 : constant Elf32_Word := 7; -- (S + A - P) >> 2
+   R_SPARC_WDISP22 : constant Elf32_Word := 8; -- (S + A - P) >> 2
+   R_SPARC_HI22 :    constant Elf32_Word := 9; -- (S + A) >> 10
+   R_SPARC_LO10 :    constant Elf32_Word := 12; -- (S + A) & 0x3ff
+   R_SPARC_UA32 :    constant Elf32_Word := 23; -- (S + A)
+
+   type Elf32_Phdr is record
+      P_Type   : Elf32_Word;
+      P_Offset : Elf32_Off;
+      P_Vaddr  : Elf32_Addr;
+      P_Paddr  : Elf32_Addr;
+      P_Filesz : Elf32_Word;
+      P_Memsz  : Elf32_Word;
+      P_Flags  : Elf32_Word;
+      P_Align  : Elf32_Word;
+   end record;
+   Elf32_Phdr_Size : constant Natural := Elf32_Phdr'Size / System.Storage_Unit;
+end Elf32;
diff --git a/src/ortho/mcode/elf64.ads b/src/ortho/mcode/elf64.ads
new file mode 100644
index 000000000..217e5557a
--- /dev/null
+++ b/src/ortho/mcode/elf64.ads
@@ -0,0 +1,105 @@
+--  ELF64 definitions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with System;
+with Elf_Common; use Elf_Common;
+
+package Elf64 is
+   subtype Elf64_Addr  is Unsigned_64;
+   subtype Elf64_Off   is Unsigned_64;
+   subtype Elf64_Uchar is Unsigned_8;
+   subtype Elf64_Half  is Unsigned_16;
+   subtype Elf64_Sword is Integer_32;
+   subtype Elf64_Word  is Unsigned_32;
+   subtype Elf64_Xword is Unsigned_64;
+   subtype Elf64_Sxword is Integer_64;
+
+   type Elf64_Ehdr is record
+      E_Ident     : E_Ident_Type;
+      E_Type      : Elf64_Half;
+      E_Machine   : Elf64_Half;
+      E_Version   : Elf64_Word;
+      E_Entry     : Elf64_Addr;
+      E_Phoff     : Elf64_Off;
+      E_Shoff     : Elf64_Off;
+      E_Flags     : Elf64_Word;
+      E_Ehsize    : Elf64_Half;
+      E_Phentsize : Elf64_Half;
+      E_Phnum     : Elf64_Half;
+      E_Shentsize : Elf64_Half;
+      E_Shnum     : Elf64_Half;
+      E_Shstrndx  : Elf64_Half;
+   end record;
+
+   Elf64_Ehdr_Size : constant Natural := Elf64_Ehdr'Size / System.Storage_Unit;
+
+   type Elf64_Shdr is record
+      Sh_Name      : Elf64_Word;
+      Sh_Type      : Elf64_Word;
+      Sh_Flags     : Elf64_Xword;
+      Sh_Addr      : Elf64_Addr;
+      Sh_Offset    : Elf64_Off;
+      Sh_Size      : Elf64_Xword;
+      Sh_Link      : Elf64_Word;
+      Sh_Info      : Elf64_Word;
+      Sh_Addralign : Elf64_Xword;
+      Sh_Entsize   : Elf64_Xword;
+   end record;
+   Elf64_Shdr_Size : constant Natural := Elf64_Shdr'Size / System.Storage_Unit;
+
+   --  Symbol table.
+   type Elf64_Sym is record
+      St_Name  : Elf64_Word;
+      St_Info  : Elf64_Uchar;
+      St_Other : Elf64_Uchar;
+      St_Shndx : Elf64_Half;
+      St_Value : Elf64_Addr;
+      St_Size  : Elf64_Xword;
+   end record;
+   Elf64_Sym_Size : constant Natural := Elf64_Sym'Size / System.Storage_Unit;
+
+   --  Relocation.
+   type Elf64_Rel is record
+      R_Offset : Elf64_Addr;
+      R_Info : Elf64_Xword;
+   end record;
+   Elf64_Rel_Size : constant Natural := Elf64_Rel'Size / System.Storage_Unit;
+
+   type Elf64_Rela is record
+      R_Offset : Elf64_Addr;
+      R_Info : Elf64_Xword;
+      R_Addend : Elf64_Sxword;
+   end record;
+   Elf64_Rela_Size : constant Natural := Elf64_Rela'Size / System.Storage_Unit;
+
+--     function Elf64_R_Sym (I : Elf64_Word) return Elf64_Word;
+--     function Elf64_R_Type (I : Elf64_Word) return Elf64_Word;
+--     function Elf64_R_Info (S, T : Elf64_Word) return Elf64_Word;
+
+   type Elf64_Phdr is record
+      P_Type   : Elf64_Word;
+      P_Flags  : Elf64_Word;
+      P_Offset : Elf64_Off;
+      P_Vaddr  : Elf64_Addr;
+      P_Paddr  : Elf64_Addr;
+      P_Filesz : Elf64_Xword;
+      P_Memsz  : Elf64_Xword;
+      P_Align  : Elf64_Xword;
+   end record;
+   Elf64_Phdr_Size : constant Natural := Elf64_Phdr'Size / System.Storage_Unit;
+end Elf64;
diff --git a/src/ortho/mcode/elf_arch.ads b/src/ortho/mcode/elf_arch.ads
new file mode 100644
index 000000000..325c4e5e3
--- /dev/null
+++ b/src/ortho/mcode/elf_arch.ads
@@ -0,0 +1,2 @@
+with Elf_Arch32;
+package Elf_Arch renames Elf_Arch32;
diff --git a/src/ortho/mcode/elf_arch32.ads b/src/ortho/mcode/elf_arch32.ads
new file mode 100644
index 000000000..5e987b1e6
--- /dev/null
+++ b/src/ortho/mcode/elf_arch32.ads
@@ -0,0 +1,37 @@
+--  ELF32 view of ELF.
+--  Copyright (C) 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 Elf_Common; use Elf_Common;
+with Elf32; use Elf32;
+
+package Elf_Arch32 is
+   subtype Elf_Ehdr is Elf32_Ehdr;
+   subtype Elf_Shdr is Elf32_Shdr;
+   subtype Elf_Sym is Elf32_Sym;
+   subtype Elf_Rel is Elf32_Rel;
+   subtype Elf_Rela is Elf32_Rela;
+   subtype Elf_Phdr is Elf32_Phdr;
+
+   subtype Elf_Off is Elf32_Off;
+   subtype Elf_Size is Elf32_Word;
+   Elf_Ehdr_Size : constant Natural := Elf32_Ehdr_Size;
+   Elf_Shdr_Size : constant Natural := Elf32_Shdr_Size;
+   Elf_Phdr_Size : constant Natural := Elf32_Phdr_Size;
+   Elf_Sym_Size : constant Natural := Elf32_Sym_Size;
+
+   Elf_Arch_Class : constant Elf_Uchar := ELFCLASS32;
+end Elf_Arch32;
diff --git a/src/ortho/mcode/elf_arch64.ads b/src/ortho/mcode/elf_arch64.ads
new file mode 100644
index 000000000..504cd66b3
--- /dev/null
+++ b/src/ortho/mcode/elf_arch64.ads
@@ -0,0 +1,37 @@
+--  ELF64 view of ELF.
+--  Copyright (C) 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 Elf_Common; use Elf_Common;
+with Elf64; use Elf64;
+
+package Elf_Arch64 is
+   subtype Elf_Ehdr is Elf64_Ehdr;
+   subtype Elf_Shdr is Elf64_Shdr;
+   subtype Elf_Sym is Elf64_Sym;
+   subtype Elf_Rel is Elf64_Rel;
+   subtype Elf_Rela is Elf64_Rela;
+   subtype Elf_Phdr is Elf64_Phdr;
+
+   subtype Elf_Off is Elf64_Off;
+   subtype Elf_Size is Elf64_Xword;
+   Elf_Ehdr_Size : constant Natural := Elf64_Ehdr_Size;
+   Elf_Shdr_Size : constant Natural := Elf64_Shdr_Size;
+   Elf_Phdr_Size : constant Natural := Elf64_Phdr_Size;
+   Elf_Sym_Size : constant Natural := Elf64_Sym_Size;
+
+   Elf_Arch_Class : constant Elf_Uchar := ELFCLASS64;
+end Elf_Arch64;
diff --git a/src/ortho/mcode/elf_common.adb b/src/ortho/mcode/elf_common.adb
new file mode 100644
index 000000000..5d05a2dc7
--- /dev/null
+++ b/src/ortho/mcode/elf_common.adb
@@ -0,0 +1,48 @@
+--  ELF definitions.
+--  Copyright (C) 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.
+package body Elf_Common is
+   function Elf_St_Bind (Info : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Shift_Right (Info, 4);
+   end Elf_St_Bind;
+
+   function Elf_St_Type (Info : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Info and 16#0F#;
+   end Elf_St_Type;
+
+   function Elf_St_Info (B, T : Elf_Uchar) return Elf_Uchar is
+   begin
+      return Shift_Left (B, 4) or T;
+   end Elf_St_Info;
+
+--     function Elf32_R_Sym (I : Elf32_Word) return Elf32_Word is
+--     begin
+--        return Shift_Right (I, 8);
+--     end Elf32_R_Sym;
+
+--     function Elf32_R_Type (I : Elf32_Word) return Elf32_Word is
+--     begin
+--        return I and 16#Ff#;
+--     end Elf32_R_Type;
+
+--     function Elf32_R_Info (S, T : Elf32_Word) return Elf32_Word is
+--     begin
+--        return Shift_Left (S, 8) or T;
+--     end Elf32_R_Info;
+end Elf_Common;
diff --git a/src/ortho/mcode/elf_common.ads b/src/ortho/mcode/elf_common.ads
new file mode 100644
index 000000000..28186d094
--- /dev/null
+++ b/src/ortho/mcode/elf_common.ads
@@ -0,0 +1,250 @@
+--  ELF definitions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Elf_Common is
+   subtype Elf_Half  is Unsigned_16;
+   subtype Elf_Sword is Integer_32;
+   subtype Elf_Word  is Unsigned_32;
+   subtype Elf_Uchar is Unsigned_8;
+
+   EI_NIDENT : constant Natural := 16;
+   type E_Ident_Type is array (Natural range 0 .. EI_NIDENT - 1)
+     of Elf_Uchar;
+
+   --  e_type values.
+   ET_NONE   : constant Elf_Half := 0;        --  No file type
+   ET_REL    : constant Elf_Half := 1;        --  Relocatable file
+   ET_EXEC   : constant Elf_Half := 2;        --  Executable file
+   ET_DYN    : constant Elf_Half := 3;        --  Shared object file
+   ET_CORE   : constant Elf_Half := 4;        --  Core file
+   ET_LOPROC : constant Elf_Half := 16#Ff00#; --  Processor-specific
+   ET_HIPROC : constant Elf_Half := 16#Ffff#; --  Processor-specific
+
+   --  e_machine values.
+   EM_NONE        : constant Elf_Half := 0;  --  No machine
+   EM_M32         : constant Elf_Half := 1;  --  AT&T WE 32100
+   EM_SPARC       : constant Elf_Half := 2;  --  SPARC
+   EM_386         : constant Elf_Half := 3;  --  Intel Architecture
+   EM_68K         : constant Elf_Half := 4;  --  Motorola 68000
+   EM_88K         : constant Elf_Half := 5;  --  Motorola 88000
+   EM_860         : constant Elf_Half := 7;  --  Intel 80860
+   EM_MIPS        : constant Elf_Half := 8;  --  MIPS RS3000 Big-Endian
+   EM_MIPS_RS4_BE : constant Elf_Half := 10; --  MIPS RS4000 Big-Endian
+   -- RESERVED : constant Elf_Half := 11; -- -16 Reserved for future use
+
+   --  e_version
+   EV_NONE    : constant Elf_Uchar := 0; --  Invalid versionn
+   EV_CURRENT : constant Elf_Uchar := 1; --  Current version
+
+   --  e_ident identification indexes.
+   EI_MAG0    : constant Natural := 0;  --  File identification
+   EI_MAG1    : constant Natural := 1;  --  File identification
+   EI_MAG2    : constant Natural := 2;  --  File identification
+   EI_MAG3    : constant Natural := 3;  --  File identification
+   EI_CLASS   : constant Natural := 4;  --  File class
+   EI_DATA    : constant Natural := 5;  --  Data encoding
+   EI_VERSION : constant Natural := 6;  --  File version
+   EI_PAD     : constant Natural := 7;  --  Start of padding bytes
+   --EI_NIDENT  : constant Natural := 16; --  Size of e_ident[]
+
+   --  Magic values.
+   ELFMAG0 : constant Elf_Uchar := 16#7f#; --  e_ident[EI_MAG0]
+   ELFMAG1 : constant Elf_Uchar := Character'Pos ('E'); --  e_ident[EI_MAG1]
+   ELFMAG2 : constant Elf_Uchar := Character'Pos ('L'); --  e_ident[EI_MAG2]
+   ELFMAG3 : constant Elf_Uchar := Character'Pos ('F'); --  e_ident[EI_MAG3]
+
+   ELFCLASSNONE : constant Elf_Uchar := 0; --  Invalid class
+   ELFCLASS32   : constant Elf_Uchar := 1; --  32-bit objects
+   ELFCLASS64   : constant Elf_Uchar := 2; --  64-bit objects
+
+   ELFDATANONE : constant Elf_Uchar := 0; --  Invalid data encoding
+   ELFDATA2LSB : constant Elf_Uchar := 1; --  See below
+   ELFDATA2MSB : constant Elf_Uchar := 2; --  See below
+
+   SHN_UNDEF     : constant Elf_Half := 0; --
+   SHN_LORESERVE : constant Elf_Half := 16#Ff00#; --
+   SHN_LOPROC    : constant Elf_Half := 16#ff00#; --
+   SHN_HIPROC    : constant Elf_Half := 16#ff1f#; --
+   SHN_ABS       : constant Elf_Half := 16#fff1#; --
+   SHN_COMMON    : constant Elf_Half := 16#fff2#; --
+   SHN_HIRESERVE : constant Elf_Half := 16#ffff#; --
+
+   -- Sh_type.
+   SHT_NULL          : constant Elf_Word := 0;
+   SHT_PROGBITS      : constant Elf_Word := 1;
+   SHT_SYMTAB        : constant Elf_Word := 2;
+   SHT_STRTAB        : constant Elf_Word := 3;
+   SHT_RELA          : constant Elf_Word := 4;
+   SHT_HASH          : constant Elf_Word := 5;
+   SHT_DYNAMIC       : constant Elf_Word := 6;
+   SHT_NOTE          : constant Elf_Word := 7;
+   SHT_NOBITS        : constant Elf_Word := 8;
+   SHT_REL           : constant Elf_Word := 9;
+   SHT_SHLIB         : constant Elf_Word := 10;
+   SHT_DYNSYM        : constant Elf_Word := 11;
+   SHT_INIT_ARRAY    : constant Elf_Word := 14;
+   SHT_FINI_ARRAY    : constant Elf_Word := 15;
+   SHT_PREINIT_ARRAY : constant Elf_Word := 16;
+   SHT_GROUP         : constant Elf_Word := 17;
+   SHT_SYMTAB_SHNDX  : constant Elf_Word := 18;
+   SHT_NUM           : constant Elf_Word := 19;
+   SHT_LOOS          : constant Elf_Word := 16#60000000#;
+   SHT_GNU_LIBLIST   : constant Elf_Word := 16#6ffffff7#;
+   SHT_CHECKSUM      : constant Elf_Word := 16#6ffffff8#;
+   SHT_LOSUNW        : constant Elf_Word := 16#6ffffffa#;
+   SHT_SUNW_Move     : constant Elf_Word := 16#6ffffffa#;
+   SHT_SUNW_COMDAT   : constant Elf_Word := 16#6ffffffb#;
+   SHT_SUNW_Syminfo  : constant Elf_Word := 16#6ffffffc#;
+   SHT_GNU_Verdef    : constant Elf_Word := 16#6ffffffd#;
+   SHT_GNU_Verneed   : constant Elf_Word := 16#6ffffffe#;
+   SHT_GNU_Versym    : constant Elf_Word := 16#6fffffff#;
+   SHT_HISUNW        : constant Elf_Word := 16#6fffffff#;
+   SHT_HIOS          : constant Elf_Word := 16#6fffffff#;
+   SHT_LOPROC        : constant Elf_Word := 16#70000000#;
+   SHT_HIPROC        : constant Elf_Word := 16#7fffffff#;
+   SHT_LOUSER        : constant Elf_Word := 16#80000000#;
+   SHT_HIUSER        : constant Elf_Word := 16#ffffffff#;
+
+
+   SHF_WRITE     : constant := 16#1#;
+   SHF_ALLOC     : constant := 16#2#;
+   SHF_EXECINSTR : constant := 16#4#;
+   SHF_MASKPROC  : constant := 16#F0000000#;
+
+   function Elf_St_Bind (Info : Elf_Uchar) return Elf_Uchar;
+   function Elf_St_Type (Info : Elf_Uchar) return Elf_Uchar;
+   function Elf_St_Info (B, T : Elf_Uchar) return Elf_Uchar;
+   pragma Inline (Elf_St_Bind);
+   pragma Inline (Elf_St_Type);
+   pragma Inline (Elf_St_Info);
+
+   --  Symbol binding.
+   STB_LOCAL  : constant Elf_Uchar := 0;
+   STB_GLOBAL : constant Elf_Uchar := 1;
+   STB_WEAK   : constant Elf_Uchar := 2;
+   STB_LOPROC : constant Elf_Uchar := 13;
+   STB_HIPROC : constant Elf_Uchar := 15;
+
+   --  Symbol types.
+   STT_NOTYPE  : constant Elf_Uchar := 0;
+   STT_OBJECT  : constant Elf_Uchar := 1;
+   STT_FUNC    : constant Elf_Uchar := 2;
+   STT_SECTION : constant Elf_Uchar := 3;
+   STT_FILE    : constant Elf_Uchar := 4;
+   STT_LOPROC  : constant Elf_Uchar := 13;
+   STT_HIPROC  : constant Elf_Uchar := 15;
+
+
+   PT_NULL         : constant Elf_Word := 0;
+   PT_LOAD         : constant Elf_Word := 1;
+   PT_DYNAMIC      : constant Elf_Word := 2;
+   PT_INTERP       : constant Elf_Word := 3;
+   PT_NOTE         : constant Elf_Word := 4;
+   PT_SHLIB        : constant Elf_Word := 5;
+   PT_PHDR         : constant Elf_Word := 6;
+   PT_TLS          : constant Elf_Word := 7;
+   PT_NUM          : constant Elf_Word := 8;
+   PT_LOOS         : constant Elf_Word := 16#60000000#;
+   PT_GNU_EH_FRAME : constant Elf_Word := 16#6474e550#;
+   PT_LOSUNW       : constant Elf_Word := 16#6ffffffa#;
+   PT_SUNWBSS      : constant Elf_Word := 16#6ffffffa#;
+   PT_SUNWSTACK    : constant Elf_Word := 16#6ffffffb#;
+   PT_HISUNW       : constant Elf_Word := 16#6fffffff#;
+   PT_HIOS         : constant Elf_Word := 16#6fffffff#;
+   PT_LOPROC       : constant Elf_Word := 16#70000000#;
+   PT_HIPROC       : constant Elf_Word := 16#7fffffff#;
+
+   PF_X : constant Elf_Word := 1;
+   PF_W : constant Elf_Word := 2;
+   PF_R : constant Elf_Word := 4;
+
+   DT_NULL            : constant Elf_Word := 0;
+   DT_NEEDED          : constant Elf_Word := 1;
+   DT_PLTRELSZ        : constant Elf_Word := 2;
+   DT_PLTGOT          : constant Elf_Word := 3;
+   DT_HASH            : constant Elf_Word := 4;
+   DT_STRTAB          : constant Elf_Word := 5;
+   DT_SYMTAB          : constant Elf_Word := 6;
+   DT_RELA            : constant Elf_Word := 7;
+   DT_RELASZ          : constant Elf_Word := 8;
+   DT_RELAENT         : constant Elf_Word := 9;
+   DT_STRSZ           : constant Elf_Word := 10;
+   DT_SYMENT          : constant Elf_Word := 11;
+   DT_INIT            : constant Elf_Word := 12;
+   DT_FINI            : constant Elf_Word := 13;
+   DT_SONAME          : constant Elf_Word := 14;
+   DT_RPATH           : constant Elf_Word := 15;
+   DT_SYMBOLIC        : constant Elf_Word := 16;
+   DT_REL             : constant Elf_Word := 17;
+   DT_RELSZ           : constant Elf_Word := 18;
+   DT_RELENT          : constant Elf_Word := 19;
+   DT_PLTREL          : constant Elf_Word := 20;
+   DT_DEBUG           : constant Elf_Word := 21;
+   DT_TEXTREL         : constant Elf_Word := 22;
+   DT_JMPREL          : constant Elf_Word := 23;
+   DT_BIND_NOW        : constant Elf_Word := 24;
+   DT_INIT_ARRAY      : constant Elf_Word := 25;
+   DT_FINI_ARRAY      : constant Elf_Word := 26;
+   DT_INIT_ARRAYSZ    : constant Elf_Word := 27;
+   DT_FINI_ARRAYSZ    : constant Elf_Word := 28;
+   DT_RUNPATH         : constant Elf_Word := 29;
+   DT_FLAGS           : constant Elf_Word := 30;
+   DT_ENCODING        : constant Elf_Word := 32;
+   DT_PREINIT_ARRAY   : constant Elf_Word := 32;
+   DT_PREINIT_ARRAYSZ : constant Elf_Word := 33;
+   DT_NUM             : constant Elf_Word := 34;
+   DT_LOOS            : constant Elf_Word := 16#60000000#;
+   DT_HIOS            : constant Elf_Word := 16#6fffffff#;
+   DT_LOPROC          : constant Elf_Word := 16#70000000#;
+   DT_HIPROC          : constant Elf_Word := 16#7fffffff#;
+   DT_VALRNGLO        : constant Elf_Word := 16#6ffffd00#;
+   DT_GNU_PRELINKED   : constant Elf_Word := 16#6ffffdf5#;
+   DT_GNU_CONFLICTSZ  : constant Elf_Word := 16#6ffffdf6#;
+   DT_GNU_LIBLISTSZ   : constant Elf_Word := 16#6ffffdf7#;
+   DT_CHECKSUM        : constant Elf_Word := 16#6ffffdf8#;
+   DT_PLTPADSZ        : constant Elf_Word := 16#6ffffdf9#;
+   DT_MOVEENT         : constant Elf_Word := 16#6ffffdfa#;
+   DT_MOVESZ          : constant Elf_Word := 16#6ffffdfb#;
+   DT_FEATURE_1       : constant Elf_Word := 16#6ffffdfc#;
+   DT_POSFLAG_1       : constant Elf_Word := 16#6ffffdfd#;
+   DT_SYMINSZ         : constant Elf_Word := 16#6ffffdfe#;
+   DT_SYMINENT        : constant Elf_Word := 16#6ffffdff#;
+   DT_VALRNGHI        : constant Elf_Word := 16#6ffffdff#;
+   DT_ADDRRNGLO       : constant Elf_Word := 16#6ffffe00#;
+   DT_GNU_CONFLICT    : constant Elf_Word := 16#6ffffef8#;
+   DT_GNU_LIBLIST     : constant Elf_Word := 16#6ffffef9#;
+   DT_CONFIG          : constant Elf_Word := 16#6ffffefa#;
+   DT_DEPAUDIT        : constant Elf_Word := 16#6ffffefb#;
+   DT_AUDIT           : constant Elf_Word := 16#6ffffefc#;
+   DT_PLTPAD          : constant Elf_Word := 16#6ffffefd#;
+   DT_MOVETAB         : constant Elf_Word := 16#6ffffefe#;
+   DT_SYMINFO         : constant Elf_Word := 16#6ffffeff#;
+   DT_ADDRRNGHI       : constant Elf_Word := 16#6ffffeff#;
+   DT_VERSYM          : constant Elf_Word := 16#6ffffff0#;
+   DT_RELACOUNT       : constant Elf_Word := 16#6ffffff9#;
+   DT_RELCOUNT        : constant Elf_Word := 16#6ffffffa#;
+   DT_FLAGS_1         : constant Elf_Word := 16#6ffffffb#;
+   DT_VERDEF          : constant Elf_Word := 16#6ffffffc#;
+   DT_VERDEFNUM       : constant Elf_Word := 16#6ffffffd#;
+   DT_VERNEED         : constant Elf_Word := 16#6ffffffe#;
+   DT_VERNEEDNUM      : constant Elf_Word := 16#6fffffff#;
+   DT_AUXILIARY       : constant Elf_Word := 16#7ffffffd#;
+   DT_FILTER          : constant Elf_Word := 16#7fffffff#;
+
+end Elf_Common;
diff --git a/src/ortho/mcode/elfdump.adb b/src/ortho/mcode/elfdump.adb
new file mode 100644
index 000000000..d49275912
--- /dev/null
+++ b/src/ortho/mcode/elfdump.adb
@@ -0,0 +1,267 @@
+--  ELF dumper (main program).
+--  Copyright (C) 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 Ada.Text_IO; use Ada.Text_IO;
+with Elf_Common; use Elf_Common;
+with Ada.Command_Line; use Ada.Command_Line;
+with Hex_Images; use Hex_Images;
+with Interfaces; use Interfaces;
+with Elfdumper; use Elfdumper;
+
+procedure Elfdump is
+   Flag_Ehdr : Boolean := False;
+   Flag_Shdr : Boolean := False;
+   Flag_Strtab : Boolean := False;
+   Flag_Symtab : Boolean := False;
+   Flag_Dwarf_Info : Boolean := False;
+   Flag_Dwarf_Abbrev : Boolean := False;
+   Flag_Dwarf_Pubnames : Boolean := False;
+   Flag_Dwarf_Aranges : Boolean := False;
+   Flag_Dwarf_Line : Boolean := False;
+   Flag_Dwarf_Frame : Boolean := False;
+   Flag_Eh_Frame_Hdr : Boolean := False;
+   Flag_Long_Shdr : Boolean := False;
+   Flag_Phdr : Boolean := False;
+   Flag_Note : Boolean := False;
+   Flag_Dynamic : Boolean := False;
+
+   procedure Disp_Max_Len (Str : String; Len : Natural)
+   is
+   begin
+      if Str'Length > Len then
+         Put (Str (Str'First .. Str'First + Len - 1));
+      else
+         Put (Str);
+         Put ((Str'Length + 1 .. Len => ' '));
+      end if;
+   end Disp_Max_Len;
+
+   procedure Disp_Section_Header (File : Elf_File; Index : Elf_Half) is
+   begin
+      Put ("Section " & Hex_Image (Index));
+      Put (" ");
+      Put (Get_Section_Name (File, Index));
+      New_Line;
+   end Disp_Section_Header;
+
+   procedure Disp_Elf_File (Filename : String)
+   is
+      File : Elf_File;
+      Ehdr : Elf_Ehdr_Acc;
+      Shdr : Elf_Shdr_Acc;
+      Phdr : Elf_Phdr_Acc;
+      Sh_Strtab : Strtab_Type;
+   begin
+      Open_File (File, Filename);
+      if Get_Status (File) /= Status_Ok then
+         Put_Line ("cannot open elf file '" & Filename & "': " &
+                   Elf_File_Status'Image (Get_Status (File)));
+         return;
+      end if;
+
+      Ehdr := Get_Ehdr (File);
+
+      if Flag_Ehdr then
+         Disp_Ehdr (Ehdr.all);
+      end if;
+
+      Load_Shdr (File);
+      Sh_Strtab := Get_Sh_Strtab (File);
+
+      if Flag_Long_Shdr then
+         if Ehdr.E_Shnum = 0 then
+            Put ("no section");
+         else
+            for I in 0 .. Ehdr.E_Shnum - 1 loop
+               Put ("Section " & Hex_Image (I));
+               New_Line;
+               Disp_Shdr (Get_Shdr (File, I).all, Sh_Strtab);
+            end loop;
+         end if;
+      end if;
+      if Flag_Shdr then
+         if Ehdr.E_Shnum = 0 then
+            Put ("no section");
+         else
+            Put ("Num   Name                Type       ");
+            Put ("Offset   Size     Link Info Al Es");
+            New_Line;
+            for I in 0 .. Ehdr.E_Shnum - 1 loop
+               declare
+                  Shdr : Elf_Shdr_Acc := Get_Shdr (File, I);
+               begin
+                  Put (Hex_Image (I));
+                  Put (" ");
+                  Disp_Max_Len (Get_Section_Name (File, I), 20);
+                  Put (" ");
+                  Disp_Max_Len (Get_Shdr_Type_Name (Shdr.Sh_Type), 10);
+                  Put (" ");
+                  Put (Hex_Image (Shdr.Sh_Offset));
+                  Put (" ");
+                  Put (Hex_Image (Shdr.Sh_Size));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_16 (Shdr.Sh_Link and 16#Ffff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_16 (Shdr.Sh_Info and 16#Ffff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_8 (Shdr.Sh_Addralign and 16#ff#)));
+                  Put (" ");
+                  Put (Hex_Image (Unsigned_8 (Shdr.Sh_Entsize and 16#ff#)));
+                  New_Line;
+               end;
+            end loop;
+         end if;
+      end if;
+
+      if Flag_Phdr then
+         Load_Phdr (File);
+         if Ehdr.E_Phnum = 0 then
+            Put ("no program segment");
+         else
+            for I in 0 .. Ehdr.E_Phnum - 1 loop
+               Put ("segment " & Hex_Image (I));
+               New_Line;
+               Disp_Phdr (Get_Phdr (File, I).all);
+            end loop;
+         end if;
+      end if;
+
+      --  Dump each section.
+      if Ehdr.E_Shnum > 0 then
+         for I in 0 .. Ehdr.E_Shnum - 1 loop
+            Shdr := Get_Shdr (File, I);
+            case Shdr.Sh_Type is
+               when SHT_SYMTAB =>
+                  if Flag_Symtab then
+                     Disp_Section_Header (File, I);
+                     Disp_Symtab (File, I);
+                  end if;
+               when SHT_STRTAB =>
+                  if Flag_Strtab then
+                     Disp_Section_Header (File, I);
+                     Disp_Strtab (File, I);
+                  end if;
+               when SHT_PROGBITS =>
+                  declare
+                     Name : String := Get_Section_Name (File, I);
+                  begin
+                     if Flag_Dwarf_Abbrev and then Name = ".debug_abbrev" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Abbrev (File, I);
+                     elsif Flag_Dwarf_Info and then Name = ".debug_info" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Info (File, I);
+                     elsif Flag_Dwarf_Line and then Name = ".debug_line" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Line (File, I);
+                     elsif Flag_Dwarf_Frame and then Name = ".debug_frame" then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Frame (File, I);
+                     elsif Flag_Dwarf_Pubnames
+                       and then Name = ".debug_pubnames"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Pubnames (File, I);
+                     elsif Flag_Eh_Frame_Hdr and then Name = ".eh_frame_hdr"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Eh_Frame_Hdr (File, I);
+                     elsif Flag_Dwarf_Aranges
+                       and then Name = ".debug_aranges"
+                     then
+                        Disp_Section_Header (File, I);
+                        Disp_Debug_Aranges (File, I);
+                     end if;
+                  end;
+               when SHT_NOTE =>
+                  if Flag_Note then
+                     Disp_Section_Header (File, I);
+                     Disp_Section_Note (File, I);
+                  end if;
+               when SHT_DYNAMIC =>
+                  if Flag_Dynamic then
+                     Disp_Section_Header (File, I);
+                     Disp_Dynamic (File, I);
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      elsif Ehdr.E_Phnum > 0 then
+         Load_Phdr (File);
+         for I in 0 .. Ehdr.E_Phnum - 1 loop
+            Phdr := Get_Phdr (File, I);
+            case Phdr.P_Type is
+               when PT_NOTE =>
+                  if Flag_Note then
+                     Disp_Segment_Note (File, I);
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      end if;
+   end Disp_Elf_File;
+
+begin
+   for I in 1 .. Argument_Count loop
+      declare
+         Arg : String := Argument (I);
+      begin
+         if Arg (1) = '-' then
+            --  An option.
+            if Arg = "-e" then
+               Flag_Ehdr := True;
+            elsif Arg = "-t" then
+               Flag_Strtab := True;
+            elsif Arg = "-S" then
+               Flag_Symtab := True;
+            elsif Arg = "-s" then
+               Flag_Shdr := True;
+            elsif Arg = "-p" then
+               Flag_Phdr := True;
+            elsif Arg = "-n" then
+               Flag_Note := True;
+            elsif Arg = "-d" then
+               Flag_Dynamic := True;
+            elsif Arg = "--dwarf-info" then
+               Flag_Dwarf_Info := True;
+            elsif Arg = "--dwarf-abbrev" then
+               Flag_Dwarf_Abbrev := True;
+            elsif Arg = "--dwarf-line" then
+               Flag_Dwarf_Line := True;
+            elsif Arg = "--dwarf-frame" then
+               Flag_Dwarf_Frame := True;
+            elsif Arg = "--dwarf-pubnames" then
+               Flag_Dwarf_Pubnames := True;
+            elsif Arg = "--dwarf-aranges" then
+               Flag_Dwarf_Aranges := True;
+            elsif Arg = "--eh-frame-hdr" then
+               Flag_Eh_Frame_Hdr := True;
+            elsif Arg = "--long-shdr" then
+               Flag_Long_Shdr := True;
+            else
+               Put_Line ("unknown option '" & Arg & "'");
+               return;
+            end if;
+         else
+            Disp_Elf_File (Arg);
+         end if;
+      end;
+   end loop;
+end Elfdump;
+
diff --git a/src/ortho/mcode/elfdumper.adb b/src/ortho/mcode/elfdumper.adb
new file mode 100644
index 000000000..b3a3b70f2
--- /dev/null
+++ b/src/ortho/mcode/elfdumper.adb
@@ -0,0 +1,2818 @@
+--  ELF dumper (library).
+--  Copyright (C) 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.Storage_Elements; use System.Storage_Elements;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.OS_Lib;
+with Interfaces; use Interfaces;
+with Hex_Images; use Hex_Images;
+with Elf_Common; use Elf_Common;
+with Dwarf;
+
+package body Elfdumper is
+   function Get_String (Strtab : Strtab_Type; N : Elf_Size) return String
+   is
+      E : Elf_Size;
+   begin
+      E := N;
+      while Strtab.Base (E) /= Nul loop
+         E := E + 1;
+      end loop;
+      if E = N then
+         return "";
+      else
+         return String (Strtab.Base (N .. E - 1));
+      end if;
+   end Get_String;
+
+   procedure Disp_Ehdr (Ehdr : Elf_Ehdr) is
+   begin
+      Put ("File class: ");
+      case Ehdr.E_Ident (EI_CLASS) is
+         when ELFCLASSNONE =>
+            Put ("none");
+         when ELFCLASS32 =>
+            Put ("class_32");
+         when ELFCLASS64 =>
+            Put ("class_64");
+         when others =>
+            Put ("others");
+      end case;
+      New_Line;
+
+      Put ("encoding  : ");
+      case Ehdr.E_Ident (EI_DATA) is
+         when ELFDATANONE =>
+            Put ("none");
+         when ELFDATA2LSB =>
+            Put ("LSB byte order");
+         when ELFDATA2MSB =>
+            Put ("MSB byte order");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put ("version   : ");
+      case Ehdr.E_Ident (EI_VERSION) is
+         when EV_NONE =>
+            Put ("none");
+         when EV_CURRENT =>
+            Put ("current (1)");
+         when others =>
+            Put ("future");
+      end case;
+      New_Line;
+
+      if Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
+--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
+        or Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
+      then
+         Put_Line ("bad class/data encoding/version");
+         return;
+      end if;
+
+      Put ("File type : ");
+      case Ehdr.E_Type is
+         when ET_NONE =>
+            Put ("no file type");
+         when ET_REL =>
+            Put ("relocatable file");
+         when ET_EXEC =>
+            Put ("executable file");
+         when ET_CORE =>
+            Put ("core file");
+         when ET_LOPROC .. ET_HIPROC =>
+            Put ("processor-specific");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put ("machine   : ");
+      case Ehdr.E_Machine is
+         when EM_NONE =>
+            Put ("no machine");
+         when EM_M32 =>
+            Put ("AT&T WE 32100");
+         when EM_SPARC =>
+            Put ("SPARC");
+         when EM_386 =>
+            Put ("Intel architecture");
+         when EM_68K =>
+            Put ("Motorola 68000");
+         when EM_88K =>
+            Put ("Motorola 88000");
+         when EM_860 =>
+            Put ("Intel 80860");
+         when EM_MIPS =>
+            Put ("MIPS RS3000 Big-Endian");
+         when EM_MIPS_RS4_BE =>
+            Put ("MIPS RS4000 Big-Endian");
+         when others =>
+            Put ("unknown");
+      end case;
+      New_Line;
+
+      Put_Line ("Version   : " & Hex_Image (Ehdr.E_Version));
+      Put_Line ("Phoff     : " & Hex_Image (Ehdr.E_Phoff));
+      Put_Line ("Shoff     : " & Hex_Image (Ehdr.E_Shoff));
+      Put_Line ("flags     : " & Hex_Image (Ehdr.E_Flags));
+      Put_Line ("phentsize : " & Hex_Image (Ehdr.E_Ehsize));
+      Put_Line ("phnum     : " & Hex_Image (Ehdr.E_Phentsize));
+      Put_Line ("shentsize : " & Hex_Image (Ehdr.E_Shentsize));
+      Put_Line ("shnum     : " & Hex_Image (Ehdr.E_Shnum));
+      Put_Line ("shstrndx  : " & Hex_Image (Ehdr.E_Shstrndx));
+   end Disp_Ehdr;
+
+   function Get_Shdr_Type_Name (Stype : Elf_Word) return String is
+   begin
+      case Stype is
+         when SHT_NULL =>
+            return "NULL";
+         when SHT_PROGBITS =>
+            return "PROGBITS";
+         when SHT_SYMTAB =>
+            return "SYMTAB";
+         when SHT_STRTAB =>
+            return "STRTAB";
+         when SHT_RELA =>
+            return "RELA";
+         when SHT_HASH =>
+            return "HASH";
+         when SHT_DYNAMIC =>
+            return "DYNAMIC";
+         when SHT_NOTE =>
+            return "NOTE";
+         when SHT_NOBITS =>
+            return "NOBITS";
+         when SHT_REL =>
+            return "REL";
+         when SHT_SHLIB =>
+            return "SHLIB";
+         when SHT_DYNSYM =>
+            return "DYNSYM";
+         when SHT_INIT_ARRAY =>
+            return "INIT_ARRAY";
+         when SHT_FINI_ARRAY =>
+            return "FINI_ARRAY";
+         when SHT_PREINIT_ARRAY =>
+            return "PREINIT_ARRAY";
+         when SHT_GROUP =>
+            return "GROUP";
+         when SHT_SYMTAB_SHNDX =>
+            return "SYMTAB_SHNDX";
+         when SHT_NUM =>
+            return "NUM";
+         when SHT_LOOS =>
+            return "LOOS";
+         when SHT_GNU_LIBLIST =>
+            return "GNU_LIBLIST";
+         when SHT_CHECKSUM =>
+            return "CHECKSUM";
+         when SHT_SUNW_Move =>
+            return "SUNW_move";
+         when SHT_SUNW_COMDAT =>
+            return "SUNW_COMDAT";
+         when SHT_SUNW_Syminfo =>
+            return "SUNW_syminfo";
+         when SHT_GNU_Verdef =>
+            return "GNU_verdef";
+         when SHT_GNU_Verneed =>
+            return "GNU_verneed";
+         when SHT_GNU_Versym =>
+            return "GNU_versym";
+         when SHT_LOPROC .. SHT_HIPROC =>
+            return "Processor dependant";
+         when SHT_LOUSER .. SHT_HIUSER =>
+            return "User dependant";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Shdr_Type_Name;
+
+   procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type)
+   is
+   begin
+      Put_Line ("name  : " & Hex_Image (Shdr.Sh_Name) & " """
+                & Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) & """");
+      Put ("type  : " & Hex_Image (Shdr.Sh_Type) & " ");
+      Put (Get_Shdr_Type_Name (Shdr.Sh_Type));
+      New_Line;
+      Put ("flags : " & Hex_Image (Shdr.Sh_Flags));
+      if (Shdr.Sh_Flags and SHF_WRITE) /= 0 then
+         Put (" WRITE");
+      end if;
+      if (Shdr.Sh_Flags and SHF_ALLOC) /= 0 then
+         Put (" ALLOC");
+      end if;
+      if (Shdr.Sh_Flags and SHF_EXECINSTR) /= 0 then
+         Put (" EXEC");
+      end if;
+      New_Line;
+      Put ("addr  : " & Hex_Image (Shdr.Sh_Addr));
+      Put ("  offset : " & Hex_Image (Shdr.Sh_Offset));
+      Put ("       size : " & Hex_Image (Shdr.Sh_Size));
+      New_Line;
+      Put ("link  : " & Hex_Image (Shdr.Sh_Link));
+      Put ("    info : " & Hex_Image (Shdr.Sh_Info));
+      Put ("  addralign : " & Hex_Image (Shdr.Sh_Addralign));
+      Put ("  entsize : " & Hex_Image (Shdr.Sh_Entsize));
+      New_Line;
+   end Disp_Shdr;
+
+   procedure Disp_Sym (File : Elf_File;
+                       Sym : Elf_Sym;
+                       Strtab : Strtab_Type)
+   is
+   begin
+      Put (Hex_Image (Sym.St_Value));
+      Put (" " & Hex_Image (Sym.St_Size));
+      Put (' ');
+      --Put ("  info:" & Hex_Image (Sym.St_Info) & " ");
+      case Elf_St_Bind (Sym.St_Info) is
+         when STB_LOCAL =>
+            Put ("loc ");
+         when STB_GLOBAL =>
+            Put ("glob");
+         when STB_WEAK =>
+            Put ("weak");
+         when others =>
+            Put ("?   ");
+      end case;
+      Put (' ');
+      case Elf_St_Type (Sym.St_Info) is
+         when STT_NOTYPE =>
+            Put ("none");
+         when STT_OBJECT =>
+            Put ("obj ");
+         when STT_FUNC =>
+            Put ("func");
+         when STT_SECTION =>
+            Put ("sect");
+         when STT_FILE =>
+            Put ("file");
+         when others =>
+            Put ("?   ");
+      end case;
+      --Put ("  other:" & Hex_Image (Sym.St_Other));
+      Put (' ');
+      case Sym.St_Shndx is
+         when SHN_UNDEF =>
+            Put ("UNDEF   ");
+         when 1 .. SHN_LORESERVE - 1 =>
+            declare
+               S : String := Get_Section_Name (File, Sym.St_Shndx);
+               Max : constant Natural := 8;
+            begin
+               if S'Length <= Max then
+                  Put (S);
+                  for I in S'Length + 1 .. Max loop
+                     Put (' ');
+                  end loop;
+               else
+                  Put (S (S'First .. S'First + Max - 1));
+               end if;
+            end;
+         when SHN_LOPROC .. SHN_HIPROC =>
+            Put ("*proc*  ");
+         when SHN_ABS =>
+            Put ("*ABS*   ");
+         when SHN_COMMON =>
+            Put ("*COMMON*");
+         when others =>
+            Put ("??      ");
+      end case;
+      --Put (" sect:" & Hex_Image (Sym.St_Shndx));
+      Put (' ');
+      Put_Line (Get_String (Strtab, Elf_Size (Sym.St_Name)));
+   end Disp_Sym;
+
+   function Get_Offset (File : Elf_File; Off : Elf_Off; Size : Elf_Size)
+                       return Address
+   is
+   begin
+      if Off > File.Length or Off + Size > File.Length then
+         return Null_Address;
+      end if;
+      return File.Base + Storage_Offset (Off);
+   end Get_Offset;
+
+   function Get_Section_Base (File : Elf_File; Shdr : Elf_Shdr)
+                             return Address
+   is
+   begin
+      return Get_Offset (File, Shdr.Sh_Offset, Shdr.Sh_Size);
+   end Get_Section_Base;
+
+   function Get_Section_Base (File : Elf_File; Index : Elf_Half)
+                             return Address
+   is
+      Shdr : Elf_Shdr_Acc;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      return Get_Section_Base (File, Shdr.all);
+   end Get_Section_Base;
+
+   function Get_Segment_Base (File : Elf_File; Phdr : Elf_Phdr)
+                             return Address
+   is
+   begin
+      return Get_Offset (File, Phdr.P_Offset, Phdr.P_Filesz);
+   end Get_Segment_Base;
+
+   function Get_Segment_Base (File : Elf_File; Index : Elf_Half)
+                             return Address
+   is
+      Phdr : Elf_Phdr_Acc;
+   begin
+      Phdr := Get_Phdr (File, Index);
+      return Get_Segment_Base (File, Phdr.all);
+   end Get_Segment_Base;
+
+   procedure Open_File (File : out Elf_File; Filename : String)
+   is
+      function Malloc (Size : Integer) return Address;
+      pragma Import (C, Malloc);
+
+      use GNAT.OS_Lib;
+      Length : Long_Integer;
+      Len : Integer;
+      Fd : File_Descriptor;
+   begin
+      File := (Filename => new String'(Filename),
+               Status => Status_Ok,
+               Length => 0,
+               Base => Null_Address,
+               Ehdr => null,
+               Shdr_Base => Null_Address,
+               Sh_Strtab => (null, 0),
+               Phdr_Base => Null_Address);
+
+      --  Open the file.
+      Fd := Open_Read (Filename, Binary);
+      if Fd = Invalid_FD then
+         File.Status := Status_Open_Failure;
+         return;
+      end if;
+
+      --  Get length.
+      Length := File_Length (Fd);
+      Len := Integer (Length);
+      if Len < Elf_Ehdr_Size then
+         File.Status := Status_Bad_File;
+         Close (Fd);
+         return;
+      end if;
+
+      File.Length := Elf_Off (Len);
+
+      --  Allocate memory for the file.
+      File.Base := Malloc (Len);
+      if File.Base = Null_Address then
+         File.Status := Status_Memory;
+         Close (Fd);
+         return;
+      end if;
+
+      --  Read the whole file.
+      if Read (Fd, File.Base, Integer (Length)) /= Integer (Length) then
+         File.Status := Status_Read_Error;
+         Close (Fd);
+         return;
+      end if;
+
+      Close (Fd);
+
+      File.Ehdr := To_Elf_Ehdr_Acc (File.Base);
+
+      if File.Ehdr.E_Ident (EI_MAG0) /= ELFMAG0
+        or File.Ehdr.E_Ident (EI_MAG1) /= ELFMAG1
+        or File.Ehdr.E_Ident (EI_MAG2) /= ELFMAG2
+        or File.Ehdr.E_Ident (EI_MAG3) /= ELFMAG3
+      then
+         File.Status := Status_Bad_Magic;
+         return;
+      end if;
+
+      if File.Ehdr.E_Ident (EI_CLASS) /= Elf_Arch_Class
+--        or Ehdr.E_Ident (EI_DATA) /= ELFDATA2LSB
+        or File.Ehdr.E_Ident (EI_VERSION) /= EV_CURRENT
+      then
+         File.Status := Status_Bad_Class;
+         return;
+      end if;
+   end Open_File;
+
+   function Get_Status (File : Elf_File) return Elf_File_Status is
+   begin
+      return File.Status;
+   end Get_Status;
+
+   function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc is
+   begin
+      return File.Ehdr;
+   end Get_Ehdr;
+
+   function Get_Shdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Shdr_Acc
+   is
+   begin
+      if Index >= File.Ehdr.E_Shnum then
+         raise Constraint_Error;
+      end if;
+      return To_Elf_Shdr_Acc
+        (File.Shdr_Base
+         + Storage_Offset (Index * Elf_Half (Elf_Shdr_Size)));
+   end Get_Shdr;
+
+   procedure Load_Phdr (File : in out Elf_File)
+   is
+   begin
+      if Get_Ehdr (File).E_Phentsize /= Elf_Half (Elf_Phdr_Size) then
+         return;
+      end if;
+
+      File.Phdr_Base :=
+        Get_Offset (File, Get_Ehdr (File).E_Phoff,
+                    Elf_Size (Get_Ehdr (File).E_Phnum
+                              * Elf_Half (Elf_Phdr_Size)));
+   end Load_Phdr;
+
+   function Get_Phdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Phdr_Acc
+   is
+   begin
+      if Index >= File.Ehdr.E_Phnum then
+         raise Constraint_Error;
+      end if;
+      return To_Elf_Phdr_Acc
+        (File.Phdr_Base
+         + Storage_Offset (Index * Elf_Half (Elf_Phdr_Size)));
+   end Get_Phdr;
+
+   function Get_Strtab (File : Elf_File; Index : Elf_Half)
+                       return Strtab_Type
+   is
+      Shdr : Elf_Shdr_Acc;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      if Shdr = null or Shdr.Sh_Type /= SHT_STRTAB then
+         return Null_Strtab;
+      end if;
+      return (Base => To_Strtab_Fat_Acc (Get_Section_Base (File, Shdr.all)),
+              Length => Shdr.Sh_Size);
+   end Get_Strtab;
+
+   procedure Load_Shdr (File : in out Elf_File)
+   is
+   begin
+      if Get_Ehdr (File).E_Shentsize /= Elf_Half (Elf_Shdr_Size) then
+         return;
+      end if;
+
+      File.Shdr_Base :=
+        Get_Offset (File, Get_Ehdr (File).E_Shoff,
+                    Elf_Size (Get_Ehdr (File).E_Shnum
+                              * Elf_Half (Elf_Shdr_Size)));
+      File.Sh_Strtab := Get_Strtab (File, Get_Ehdr (File).E_Shstrndx);
+   end Load_Shdr;
+
+   function Get_Sh_Strtab (File : Elf_File) return Strtab_Type is
+   begin
+      return File.Sh_Strtab;
+   end Get_Sh_Strtab;
+
+   function Get_Section_Name (File : Elf_File; Index : Elf_Half)
+                             return String
+   is
+   begin
+      return Get_String (Get_Sh_Strtab (File),
+                         Elf_Size (Get_Shdr (File, Index).Sh_Name));
+   end Get_Section_Name;
+
+   function Get_Section_By_Name (File : Elf_File; Name : String)
+                                return Elf_Half
+   is
+      Ehdr : Elf_Ehdr_Acc;
+      Shdr : Elf_Shdr_Acc;
+      Sh_Strtab : Strtab_Type;
+   begin
+      Ehdr := Get_Ehdr (File);
+      Sh_Strtab := Get_Sh_Strtab (File);
+      for I in 1 .. Ehdr.E_Shnum - 1 loop
+         Shdr := Get_Shdr (File, I);
+         if Get_String (Sh_Strtab, Elf_Size (Shdr.Sh_Name)) = Name then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Get_Section_By_Name;
+
+   procedure Disp_Symtab (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      S_Strtab : Strtab_Type;
+      Base : Address;
+      Off : Storage_Offset;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      if Shdr.Sh_Entsize /= Elf_Size (Elf_Sym_Size) then
+         return;
+      end if;
+      S_Strtab := Get_Strtab (File, Elf_Half (Shdr.Sh_Link));
+      Base := Get_Section_Base (File, Shdr.all);
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Disp_Sym (File, To_Elf_Sym_Acc (Base + Off).all, S_Strtab);
+         Off := Off + Storage_Offset (Elf_Sym_Size);
+      end loop;
+   end Disp_Symtab;
+
+   procedure Disp_Strtab (File : Elf_File; Index : Elf_Half)
+   is
+      Strtab : Strtab_Type;
+      S, E : Elf_Size;
+   begin
+      Strtab := Get_Strtab (File, Index);
+      S := 1;
+      while S < Strtab.Length loop
+         E := S;
+         while Strtab.Base (E) /= Nul loop
+            E := E + 1;
+         end loop;
+         Put_Line (Hex_Image (S) & ": "
+                   & String (Strtab.Base (S .. E - 1)));
+         S := E + 1;
+      end loop;
+   end Disp_Strtab;
+
+   function Read_Byte (Addr : Address) return Unsigned_8
+   is
+      type Unsigned_8_Acc is access all Unsigned_8;
+      function To_Unsigned_8_Acc is new Ada.Unchecked_Conversion
+        (Address, Unsigned_8_Acc);
+   begin
+      return To_Unsigned_8_Acc (Addr).all;
+   end Read_Byte;
+
+   procedure Read_ULEB128 (Base : Address;
+                           Off : in out Storage_Offset;
+                           Res : out Unsigned_32)
+   is
+      B : Unsigned_8;
+      Shift : Integer;
+   begin
+      Res := 0;
+      Shift := 0;
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+         exit when (B and 16#80#) = 0;
+         Shift := Shift + 7;
+      end loop;
+   end Read_ULEB128;
+
+   procedure Read_SLEB128 (Base : Address;
+                           Off : in out Storage_Offset;
+                           Res : out Unsigned_32)
+   is
+      B : Unsigned_8;
+      Shift : Integer;
+   begin
+      Res := 0;
+      Shift := 0;
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         Res := Res or Shift_Left (Unsigned_32 (B and 16#7f#), Shift);
+         Shift := Shift + 7;
+         exit when (B and 16#80#) = 0;
+      end loop;
+      if Shift < 32 and (Res and Shift_Left (1, Shift - 1)) /= 0 then
+         Res := Res or Shift_Left (-1, Shift);
+      end if;
+   end Read_SLEB128;
+
+   procedure Read_Word4 (Base : Address;
+                         Off : in out Storage_Offset;
+                         Res : out Unsigned_32)
+   is
+      B0, B1, B2, B3 : Unsigned_8;
+   begin
+      B0 := Read_Byte (Base + Off + 0);
+      B1 := Read_Byte (Base + Off + 1);
+      B2 := Read_Byte (Base + Off + 2);
+      B3 := Read_Byte (Base + Off + 3);
+      Res := Shift_Left (Unsigned_32 (B3), 24)
+        or Shift_Left (Unsigned_32 (B2), 16)
+        or Shift_Left (Unsigned_32 (B1), 8)
+        or Shift_Left (Unsigned_32 (B0), 0);
+      Off := Off + 4;
+   end Read_Word4;
+
+   procedure Read_Word2 (Base : Address;
+                         Off : in out Storage_Offset;
+                         Res : out Unsigned_16)
+   is
+      B0, B1 : Unsigned_8;
+   begin
+      B0 := Read_Byte (Base + Off + 0);
+      B1 := Read_Byte (Base + Off + 1);
+      Res := Shift_Left (Unsigned_16 (B1), 8)
+        or Shift_Left (Unsigned_16 (B0), 0);
+      Off := Off + 2;
+   end Read_Word2;
+
+   procedure Read_Byte (Base : Address;
+                        Off : in out Storage_Offset;
+                        Res : out Unsigned_8)
+   is
+   begin
+      Res := Read_Byte (Base + Off);
+      Off := Off + 1;
+   end Read_Byte;
+
+   procedure Disp_Note (Base : Address; Size : Storage_Offset)
+   is
+      Off : Storage_Offset;
+      Namesz : Unsigned_32;
+      Descsz : Unsigned_32;
+      Ntype : Unsigned_32;
+      B : Unsigned_8;
+      Is_Full : Boolean;
+   begin
+      Off := 0;
+      while Off < Size loop
+         Read_Word4 (Base, Off, Namesz);
+         Read_Word4 (Base, Off, Descsz);
+         Read_Word4 (Base, Off, Ntype);
+         Put ("type : ");
+         Put (Hex_Image (Ntype));
+         New_Line;
+         Put ("name : ");
+         Put (Hex_Image (Namesz));
+         Put ("  ");
+         for I in 1 .. Namesz loop
+            Read_Byte (Base, Off, B);
+            if B /= 0 then
+               Put (Character'Val (B));
+            end if;
+         end loop;
+         if Namesz mod 4 /= 0 then
+            for I in (Namesz mod 4) .. 3 loop
+               Read_Byte (Base, Off, B);
+            end loop;
+         end if;
+         New_Line;
+         Put ("desc : ");
+         Put (Hex_Image (Descsz));
+         Put (" ");
+         Is_Full := Descsz >= 20;
+         for I in 1 .. Descsz loop
+            if Is_Full and (I mod 16) = 1 then
+               New_Line;
+            end if;
+            Read_Byte (Base, Off, B);
+            Put (' ');
+            Put (Hex_Image (B));
+         end loop;
+         if Descsz mod 4 /= 0 then
+            for I in (Descsz mod 4) .. 3 loop
+               Read_Byte (Base, Off, B);
+            end loop;
+         end if;
+         New_Line;
+      end loop;
+   end Disp_Note;
+
+   procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+      Disp_Note (Base, Storage_Offset (Shdr.Sh_Size));
+   end Disp_Section_Note;
+
+   procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half)
+   is
+      Phdr : Elf_Phdr_Acc;
+      Base : Address;
+   begin
+      Phdr := Get_Phdr (File, Index);
+      Base := Get_Segment_Base (File, Phdr.all);
+      Disp_Note (Base, Storage_Offset (Phdr.P_Filesz));
+   end Disp_Segment_Note;
+
+
+   function Get_Dt_Name (Name : Elf_Word) return String is
+   begin
+      case Name is
+         when DT_NULL =>
+            return "NULL";
+         when DT_NEEDED =>
+            return "NEEDED";
+         when DT_PLTRELSZ =>
+            return "PLTRELSZ";
+         when DT_PLTGOT =>
+            return "PLTGOT";
+         when DT_HASH =>
+            return "HASH";
+         when DT_STRTAB =>
+            return "STRTAB";
+         when DT_SYMTAB =>
+            return "SYMTAB";
+         when DT_RELA =>
+            return "RELA";
+         when DT_RELASZ =>
+            return "RELASZ";
+         when DT_RELAENT =>
+            return "RELAENT";
+         when DT_STRSZ =>
+            return "STRSZ";
+         when DT_SYMENT =>
+            return "SYMENT";
+         when DT_INIT =>
+            return "INIT";
+         when DT_FINI =>
+            return "FINI";
+         when DT_SONAME =>
+            return "SONAME";
+         when DT_RPATH =>
+            return "RPATH";
+         when DT_SYMBOLIC =>
+            return "SYMBOLIC";
+         when DT_REL =>
+            return "REL";
+         when DT_RELSZ =>
+            return "RELSZ";
+         when DT_RELENT =>
+            return "RELENT";
+         when DT_PLTREL =>
+            return "PLTREL";
+         when DT_DEBUG =>
+            return "DEBUG";
+         when DT_TEXTREL =>
+            return "TEXTREL";
+         when DT_JMPREL =>
+            return "JMPREL";
+         when DT_BIND_NOW =>
+            return "BIND_NOW";
+         when DT_INIT_ARRAY =>
+            return "INIT_ARRAY";
+         when DT_FINI_ARRAY =>
+            return "FINI_ARRAY";
+         when DT_INIT_ARRAYSZ =>
+            return "INIT_ARRAYSZ";
+         when DT_FINI_ARRAYSZ =>
+            return "FINI_ARRAYSZ";
+         when DT_RUNPATH =>
+            return "RUNPATH";
+         when DT_FLAGS =>
+            return "FLAGS";
+--           when DT_ENCODING =>
+--              return "ENCODING";
+         when DT_PREINIT_ARRAY =>
+            return "PREINIT_ARRAY";
+         when DT_PREINIT_ARRAYSZ =>
+            return "PREINIT_ARRAYSZ";
+         when DT_NUM =>
+            return "NUM";
+         when DT_LOOS =>
+            return "LOOS";
+--           when DT_HIOS =>
+--              return "HIOS";
+         when DT_LOPROC =>
+            return "LOPROC";
+--           when DT_HIPROC =>
+--              return "HIPROC";
+         when DT_VALRNGLO =>
+            return "VALRNGLO";
+         when DT_GNU_PRELINKED =>
+            return "GNU_PRELINKED";
+         when DT_GNU_CONFLICTSZ =>
+            return "GNU_CONFLICTSZ";
+         when DT_GNU_LIBLISTSZ =>
+            return "GNU_LIBLISTSZ";
+         when DT_CHECKSUM =>
+            return "CHECKSUM";
+         when DT_PLTPADSZ =>
+            return "PLTPADSZ";
+         when DT_MOVEENT =>
+            return "MOVEENT";
+         when DT_MOVESZ =>
+            return "MOVESZ";
+         when DT_FEATURE_1 =>
+            return "FEATURE_1";
+         when DT_POSFLAG_1 =>
+            return "POSFLAG_1";
+         when DT_SYMINSZ =>
+            return "SYMINSZ";
+         when DT_SYMINENT =>
+            return "SYMINENT";
+--           when DT_VALRNGHI =>
+--              return "VALRNGHI";
+         when DT_ADDRRNGLO =>
+            return "ADDRRNGLO";
+         when DT_GNU_CONFLICT =>
+            return "GNU_CONFLICT";
+         when DT_GNU_LIBLIST =>
+            return "GNU_LIBLIST";
+         when DT_CONFIG =>
+            return "CONFIG";
+         when DT_DEPAUDIT =>
+            return "DEPAUDIT";
+         when DT_AUDIT =>
+            return "AUDIT";
+         when DT_PLTPAD =>
+            return "PLTPAD";
+         when DT_MOVETAB =>
+            return "MOVETAB";
+         when DT_SYMINFO =>
+            return "SYMINFO";
+--           when DT_ADDRRNGHI =>
+--              return "ADDRRNGHI";
+         when DT_VERSYM =>
+            return "VERSYM";
+         when DT_RELACOUNT =>
+            return "RELACOUNT";
+         when DT_RELCOUNT =>
+            return "RELCOUNT";
+         when DT_FLAGS_1 =>
+            return "FLAGS_1";
+         when DT_VERDEF =>
+            return "VERDEF";
+         when DT_VERDEFNUM =>
+            return "VERDEFNUM";
+         when DT_VERNEED =>
+            return "VERNEED";
+         when DT_VERNEEDNUM =>
+            return "VERNEEDNUM";
+         when DT_AUXILIARY =>
+            return "AUXILIARY";
+         when DT_FILTER =>
+            return "FILTER";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dt_Name;
+
+   procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Tag : Unsigned_32;
+      Val : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Tag);
+         Read_Word4 (Base, Off, Val);
+         Put ("tag : ");
+         Put (Hex_Image (Tag));
+         Put ("  (");
+         Put (Get_Dt_Name (Tag));
+         Put (")");
+         Set_Col (34);
+         Put ("val : ");
+         Put (Hex_Image (Val));
+         New_Line;
+      end loop;
+   end Disp_Dynamic;
+
+   function Get_Dwarf_Form_Name (Name : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Name is
+         when DW_FORM_Addr =>
+            return "addr";
+         when DW_FORM_Block2 =>
+            return "block2";
+         when DW_FORM_Block4 =>
+            return "block4";
+         when DW_FORM_Data2 =>
+            return "data2";
+         when DW_FORM_Data4 =>
+            return "data4";
+         when DW_FORM_Data8 =>
+            return "data8";
+         when DW_FORM_String =>
+            return "string";
+         when DW_FORM_Block =>
+            return "block";
+         when DW_FORM_Block1 =>
+            return "block1";
+         when DW_FORM_Data1 =>
+            return "data1";
+         when DW_FORM_Flag =>
+            return "flag";
+         when DW_FORM_Sdata =>
+            return "sdata";
+         when DW_FORM_Strp =>
+            return "strp";
+         when DW_FORM_Udata =>
+            return "udata";
+         when DW_FORM_Ref_Addr =>
+            return "ref_addr";
+         when DW_FORM_Ref1 =>
+            return "ref1";
+         when DW_FORM_Ref2 =>
+            return "ref2";
+         when DW_FORM_Ref4 =>
+            return "ref4";
+         when DW_FORM_Ref8 =>
+            return "ref8";
+         when DW_FORM_Ref_Udata =>
+            return "ref_udata";
+         when DW_FORM_Indirect =>
+            return "indirect";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Form_Name;
+
+   function Get_Dwarf_Tag_Name (Tag : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Tag is
+         when DW_TAG_Array_Type =>
+            return "array_type";
+         when DW_TAG_Class_Type =>
+            return "class_type";
+         when DW_TAG_Entry_Point =>
+            return "entry_point";
+         when DW_TAG_Enumeration_Type =>
+            return "enumeration_type";
+         when DW_TAG_Formal_Parameter =>
+            return "formal_parameter";
+         when DW_TAG_Imported_Declaration =>
+            return "imported_declaration";
+         when DW_TAG_Label =>
+            return "label";
+         when DW_TAG_Lexical_Block =>
+            return "lexical_block";
+         when DW_TAG_Member =>
+            return "member";
+         when DW_TAG_Pointer_Type =>
+            return "pointer_type";
+         when DW_TAG_Reference_Type =>
+            return "reference_type";
+         when DW_TAG_Compile_Unit =>
+            return "compile_unit";
+         when DW_TAG_String_Type =>
+            return "string_type";
+         when DW_TAG_Structure_Type =>
+            return "structure_type";
+         when DW_TAG_Subroutine_Type =>
+            return "subroutine_type";
+         when DW_TAG_Typedef =>
+            return "typedef";
+         when DW_TAG_Union_Type =>
+            return "union_type";
+         when DW_TAG_Unspecified_Parameters =>
+            return "unspecified_parameters";
+         when DW_TAG_Variant =>
+            return "variant";
+         when DW_TAG_Common_Block =>
+            return "common_block";
+         when DW_TAG_Common_Inclusion =>
+            return "common_inclusion";
+         when DW_TAG_Inheritance =>
+            return "inheritance";
+         when DW_TAG_Inlined_Subroutine =>
+            return "inlined_subroutine";
+         when DW_TAG_Module =>
+            return "module";
+         when DW_TAG_Ptr_To_Member_Type =>
+            return "ptr_to_member_type";
+         when DW_TAG_Set_Type =>
+            return "set_type";
+         when DW_TAG_Subrange_Type =>
+            return "subrange_type";
+         when DW_TAG_With_Stmt =>
+            return "with_stmt";
+         when DW_TAG_Access_Declaration =>
+            return "access_declaration";
+         when DW_TAG_Base_Type =>
+            return "base_type";
+         when DW_TAG_Catch_Block =>
+            return "catch_block";
+         when DW_TAG_Const_Type =>
+            return "const_type";
+         when DW_TAG_Constant =>
+            return "constant";
+         when DW_TAG_Enumerator =>
+            return "enumerator";
+         when DW_TAG_File_Type =>
+            return "file_type";
+         when DW_TAG_Friend =>
+            return "friend";
+         when DW_TAG_Namelist =>
+            return "namelist";
+         when DW_TAG_Namelist_Item =>
+            return "namelist_item";
+         when DW_TAG_Packed_Type =>
+            return "packed_type";
+         when DW_TAG_Subprogram =>
+            return "subprogram";
+         when DW_TAG_Template_Type_Parameter =>
+            return "template_type_parameter";
+         when DW_TAG_Template_Value_Parameter =>
+            return "template_value_parameter";
+         when DW_TAG_Thrown_Type =>
+            return "thrown_type";
+         when DW_TAG_Try_Block =>
+            return "try_block";
+         when DW_TAG_Variant_Part =>
+            return "variant_part";
+         when DW_TAG_Variable =>
+            return "variable";
+         when DW_TAG_Volatile_Type =>
+            return "volatile_type";
+         when DW_TAG_Dwarf_Procedure =>
+            return "dwarf_procedure";
+         when DW_TAG_Restrict_Type =>
+            return "restrict_type";
+         when DW_TAG_Interface_Type =>
+            return "interface_type";
+         when DW_TAG_Namespace =>
+            return "namespace";
+         when DW_TAG_Imported_Module =>
+            return "imported_module";
+         when DW_TAG_Unspecified_Type =>
+            return "unspecified_type";
+         when DW_TAG_Partial_Unit =>
+            return "partial_unit";
+         when DW_TAG_Imported_Unit =>
+            return "imported_unit";
+         when DW_TAG_Mutable_Type =>
+            return "mutable_type";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Tag_Name;
+
+   function Get_Dwarf_At_Name (Attr : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Attr is
+         when DW_AT_Sibling =>
+            return "sibling";
+         when DW_AT_Location =>
+            return "location";
+         when DW_AT_Name =>
+            return "name";
+         when DW_AT_Ordering =>
+            return "ordering";
+         when DW_AT_Byte_Size =>
+            return "byte_size";
+         when DW_AT_Bit_Offset =>
+            return "bit_offset";
+         when DW_AT_Bit_Size =>
+            return "bit_size";
+         when DW_AT_Stmt_List =>
+            return "stmt_list";
+         when DW_AT_Low_Pc =>
+            return "low_pc";
+         when DW_AT_High_Pc =>
+            return "high_pc";
+         when DW_AT_Language =>
+            return "language";
+         when DW_AT_Discr =>
+            return "discr";
+         when DW_AT_Discr_Value =>
+            return "discr_value";
+         when DW_AT_Visibility =>
+            return "visibility";
+         when DW_AT_Import =>
+            return "import";
+         when DW_AT_String_Length =>
+            return "string_length";
+         when DW_AT_Common_Reference =>
+            return "common_reference";
+         when DW_AT_Comp_Dir =>
+            return "comp_dir";
+         when DW_AT_Const_Value =>
+            return "const_value";
+         when DW_AT_Containing_Type =>
+            return "containing_type";
+         when DW_AT_Default_Value =>
+            return "default_value";
+         when DW_AT_Inline =>
+            return "inline";
+         when DW_AT_Is_Optional =>
+            return "is_optional";
+         when DW_AT_Lower_Bound =>
+            return "lower_bound";
+         when DW_AT_Producer =>
+            return "producer";
+         when DW_AT_Prototyped =>
+            return "prototyped";
+         when DW_AT_Return_Addr =>
+            return "return_addr";
+         when DW_AT_Start_Scope =>
+            return "start_scope";
+         when DW_AT_Stride_Size =>
+            return "stride_size";
+         when DW_AT_Upper_Bound =>
+            return "upper_bound";
+         when DW_AT_Abstract_Origin =>
+            return "abstract_origin";
+         when DW_AT_Accessibility =>
+            return "accessibility";
+         when DW_AT_Address_Class =>
+            return "address_class";
+         when DW_AT_Artificial =>
+            return "artificial";
+         when DW_AT_Base_Types =>
+            return "base_types";
+         when DW_AT_Calling_Convention =>
+            return "calling_convention";
+         when DW_AT_Count =>
+            return "count";
+         when DW_AT_Data_Member_Location =>
+            return "data_member_location";
+         when DW_AT_Decl_Column =>
+            return "decl_column";
+         when DW_AT_Decl_File =>
+            return "decl_file";
+         when DW_AT_Decl_Line =>
+            return "decl_line";
+         when DW_AT_Declaration =>
+            return "declaration";
+         when DW_AT_Discr_List =>
+            return "discr_list";
+         when DW_AT_Encoding =>
+            return "encoding";
+         when DW_AT_External =>
+            return "external";
+         when DW_AT_Frame_Base =>
+            return "frame_base";
+         when DW_AT_Friend =>
+            return "friend";
+         when DW_AT_Identifier_Case =>
+            return "identifier_case";
+         when DW_AT_Macro_Info =>
+            return "macro_info";
+         when DW_AT_Namelist_Item =>
+            return "namelist_item";
+         when DW_AT_Priority =>
+            return "priority";
+         when DW_AT_Segment =>
+            return "segment";
+         when DW_AT_Specification =>
+            return "specification";
+         when DW_AT_Static_Link =>
+            return "static_link";
+         when DW_AT_Type =>
+            return "type";
+         when DW_AT_Use_Location =>
+            return "use_location";
+         when DW_AT_Variable_Parameter =>
+            return "variable_parameter";
+         when DW_AT_Virtuality =>
+            return "virtuality";
+         when DW_AT_Vtable_Elem_Location =>
+            return "vtable_elem_location";
+         when DW_AT_Allocated =>
+            return "allocated";
+         when DW_AT_Associated =>
+            return "associated";
+         when DW_AT_Data_Location =>
+            return "data_location";
+         when DW_AT_Stride =>
+            return "stride";
+         when DW_AT_Entry_Pc =>
+            return "entry_pc";
+         when DW_AT_Use_UTF8 =>
+            return "use_utf8";
+         when DW_AT_Extension =>
+            return "extension";
+         when DW_AT_Ranges =>
+            return "ranges";
+         when DW_AT_Trampoline =>
+            return "trampoline";
+         when DW_AT_Call_Column =>
+            return "call_column";
+         when DW_AT_Call_File =>
+            return "call_file";
+         when DW_AT_Call_Line =>
+            return "call_line";
+         when DW_AT_Description =>
+            return "description";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_At_Name;
+
+   procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Old_Off : Storage_Offset;
+      Off : Storage_Offset;
+      V : Unsigned_32;
+      Tag : Unsigned_32;
+      Name : Unsigned_32;
+      Form : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Old_Off := Off;
+         Read_ULEB128 (Base, Off, V);
+         Put_Line ("abbrev #" & Hex_Image (V) & " at "
+                   & Hex_Image (Unsigned_32 (Old_Off)) & ':');
+         if V = 0 then
+            Put_Line ("pad");
+            goto Again;
+         end if;
+         Read_ULEB128 (Base, Off, Tag);
+         Put (" tag: " & Hex_Image (Tag));
+         Put (" (");
+         Put (Get_Dwarf_Tag_Name (Tag));
+         Put ("),  children: " & Hex_Image (Read_Byte (Base + Off)));
+         New_Line;
+         Off := Off + 1;
+         loop
+            Read_ULEB128 (Base, Off, Name);
+            Read_ULEB128 (Base, Off, Form);
+            Put ("   name: " & Hex_Image (Name));
+            Put (" (");
+            Put (Get_Dwarf_At_Name (Name));
+            Put (")");
+            Set_Col (42);
+            Put ("form: " & Hex_Image (Form));
+            Put (" (");
+            Put (Get_Dwarf_Form_Name (Form));
+            Put (")");
+            New_Line;
+            exit when Name = 0 and Form = 0;
+         end loop;
+         << Again >> null;
+      end loop;
+   end Disp_Debug_Abbrev;
+
+   type Abbrev_Map_Type is array (Unsigned_32 range <>) of Address;
+   type Abbrev_Map_Acc is access Abbrev_Map_Type;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Abbrev_Map_Type, Abbrev_Map_Acc);
+
+   procedure Build_Abbrev_Map (Base : Address; Res : out Abbrev_Map_Acc)
+   is
+      Max : Unsigned_32;
+      Off : Storage_Offset;
+      V : Unsigned_32;
+      V1 : Unsigned_32;
+      N_Res : Abbrev_Map_Acc;
+   begin
+      Off := 0;
+      Max := 0;
+      Res := new Abbrev_Map_Type (0 .. 128);
+      Res.all := (others => Null_Address);
+      loop
+         Read_ULEB128 (Base, Off, V);
+         if V > Max then
+            Max := V;
+         end if;
+         exit when V = 0;
+         if Max > Res.all'Last then
+            N_Res := new Abbrev_Map_Type (0 .. 2 * Max);
+            N_Res (Res'Range) := Res.all;
+            N_Res (Res'Last + 1 .. N_Res'Last) := (others => Null_Address);
+            Unchecked_Deallocation (Res);
+            Res := N_Res;
+         end if;
+         if Res (V) /= Null_Address then
+            Put_Line ("!! abbrev override !!");
+            return;
+         end if;
+         Res (V) := Base + Off;
+         Read_ULEB128 (Base, Off, V);
+         --  Skip child flag.
+         Off := Off + 1;
+         loop
+            Read_ULEB128 (Base, Off, V);
+            Read_ULEB128 (Base, Off, V1);
+            exit when V = 0 and V1 = 0;
+         end loop;
+      end loop;
+   end Build_Abbrev_Map;
+
+   procedure Disp_Block (Base : Address;
+                         Off : in out Storage_Offset;
+                         Cnt : Unsigned_32)
+   is
+   begin
+      for I in 1 .. Cnt loop
+         Put (" ");
+         Put (Hex_Image (Read_Byte (Base + Off + Storage_Offset (I - 1))));
+      end loop;
+      Off := Off + Storage_Offset (Cnt);
+   end Disp_Block;
+
+   procedure Disp_Dwarf_Form (Base : Address;
+                              Off : in out Storage_Offset;
+                              Form : Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Addr =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("address: " & Hex_Image (V));
+            end;
+         when DW_FORM_Flag =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("flag: " & Hex_Image (V));
+            end;
+         when DW_FORM_Block1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("block1: " & Hex_Image (V));
+               Disp_Block (Base, Off, Unsigned_32 (V));
+            end;
+         when DW_FORM_Data1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Put ("data1: " & Hex_Image (V));
+            end;
+         when DW_FORM_Data2 =>
+            declare
+               V : Unsigned_16;
+            begin
+               Read_Word2 (Base, Off, V);
+               Put ("data2: " & Hex_Image (V));
+            end;
+         when DW_FORM_Data4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("data4: " & Hex_Image (V));
+            end;
+         when DW_FORM_Sdata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_SLEB128 (Base, Off, V);
+               Put ("sdata: " & Hex_Image (V));
+            end;
+         when DW_FORM_Udata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_ULEB128 (Base, Off, V);
+               Put ("udata: " & Hex_Image (V));
+            end;
+         when DW_FORM_Ref4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("ref4: " & Hex_Image (V));
+            end;
+         when DW_FORM_Strp =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Put ("strp: " & Hex_Image (V));
+            end;
+         when DW_FORM_String =>
+            declare
+               C : Unsigned_8;
+            begin
+               Put ("string: ");
+               loop
+                  Read_Byte (Base, Off, C);
+                  exit when C = 0;
+                  Put (Character'Val (C));
+               end loop;
+            end;
+         when others =>
+            Put ("???");
+            raise Program_Error;
+      end case;
+   end Disp_Dwarf_Form;
+
+   function Get_Dwarf_ATE_Name (Val : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Val is
+         when DW_ATE_Address =>
+            return "address";
+         when DW_ATE_Boolean =>
+            return "boolean";
+         when DW_ATE_Complex_Float =>
+            return "complex_float";
+         when DW_ATE_Float =>
+            return "float";
+         when DW_ATE_Signed =>
+            return "signed";
+         when DW_ATE_Signed_Char =>
+            return "signed_char";
+         when DW_ATE_Unsigned =>
+            return "unsigned";
+         when DW_ATE_Unsigned_Char =>
+            return "unsigned_char";
+         when DW_ATE_Imaginary_Float =>
+            return "imaginary_float";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_ATE_Name;
+
+   procedure Read_Dwarf_Constant (Base : Address;
+                                  Off : in out Storage_Offset;
+                                  Form : Unsigned_32;
+                                  Res : out Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Data1 =>
+            declare
+               V : Unsigned_8;
+            begin
+               Read_Byte (Base, Off, V);
+               Res := Unsigned_32 (V);
+            end;
+         when DW_FORM_Data2 =>
+            declare
+               V : Unsigned_16;
+            begin
+               Read_Word2 (Base, Off, V);
+               Res := Unsigned_32 (V);
+            end;
+         when DW_FORM_Data4 =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_Word4 (Base, Off, V);
+               Res := V;
+            end;
+         when DW_FORM_Sdata =>
+            declare
+               V : Unsigned_32;
+            begin
+               Read_SLEB128 (Base, Off, V);
+               Res := V;
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Read_Dwarf_Constant;
+
+   procedure Disp_Dwarf_Encoding
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      Val : Unsigned_32;
+   begin
+      Read_Dwarf_Constant (Base, Off, Form, Val);
+      Put (Get_Dwarf_ATE_Name (Val));
+   end Disp_Dwarf_Encoding;
+
+   function Get_Dwarf_Lang_Name (Lang : Unsigned_32) return String
+   is
+      use Dwarf;
+   begin
+      case Lang is
+         when DW_LANG_C89 =>
+            return "C89";
+         when DW_LANG_C =>
+            return "C";
+         when DW_LANG_Ada83 =>
+            return "Ada83";
+         when DW_LANG_C_Plus_Plus =>
+            return "C_Plus_Plus";
+         when DW_LANG_Cobol74 =>
+            return "Cobol74";
+         when DW_LANG_Cobol85 =>
+            return "Cobol85";
+         when DW_LANG_Fortran77 =>
+            return "Fortran77";
+         when DW_LANG_Fortran90 =>
+            return "Fortran90";
+         when DW_LANG_Pascal83 =>
+            return "Pascal83";
+         when DW_LANG_Modula2 =>
+            return "Modula2";
+         when DW_LANG_Java =>
+            return "Java";
+         when DW_LANG_C99 =>
+            return "C99";
+         when DW_LANG_Ada95 =>
+            return "Ada95";
+         when DW_LANG_Fortran95 =>
+            return "Fortran95";
+         when DW_LANG_PLI =>
+            return "PLI";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_Lang_Name;
+
+   procedure Disp_Dwarf_Language
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      Val : Unsigned_32;
+   begin
+      Read_Dwarf_Constant (Base, Off, Form, Val);
+      Put (Get_Dwarf_Lang_Name (Val));
+   end Disp_Dwarf_Language;
+
+   function Get_Dwarf_Op_Name (Op : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Op is
+         when DW_OP_Addr =>
+            return "addr";
+         when DW_OP_Deref =>
+            return "deref";
+         when DW_OP_Const1u =>
+            return "const1u";
+         when DW_OP_Const1s =>
+            return "const1s";
+         when DW_OP_Const2u =>
+            return "const2u";
+         when DW_OP_Const2s =>
+            return "const2s";
+         when DW_OP_Const4u =>
+            return "const4u";
+         when DW_OP_Const4s =>
+            return "const4s";
+         when DW_OP_Const8u =>
+            return "const8u";
+         when DW_OP_Const8s =>
+            return "const8s";
+         when DW_OP_Constu =>
+            return "constu";
+         when DW_OP_Consts =>
+            return "consts";
+         when DW_OP_Dup =>
+            return "dup";
+         when DW_OP_Drop =>
+            return "drop";
+         when DW_OP_Over =>
+            return "over";
+         when DW_OP_Pick =>
+            return "pick";
+         when DW_OP_Swap =>
+            return "swap";
+         when DW_OP_Rot =>
+            return "rot";
+         when DW_OP_Xderef =>
+            return "xderef";
+         when DW_OP_Abs =>
+            return "abs";
+         when DW_OP_And =>
+            return "and";
+         when DW_OP_Div =>
+            return "div";
+         when DW_OP_Minus =>
+            return "minus";
+         when DW_OP_Mod =>
+            return "mod";
+         when DW_OP_Mul =>
+            return "mul";
+         when DW_OP_Neg =>
+            return "neg";
+         when DW_OP_Not =>
+            return "not";
+         when DW_OP_Or =>
+            return "or";
+         when DW_OP_Plus =>
+            return "plus";
+         when DW_OP_Plus_Uconst =>
+            return "plus_uconst";
+         when DW_OP_Shl =>
+            return "shl";
+         when DW_OP_Shr =>
+            return "shr";
+         when DW_OP_Shra =>
+            return "shra";
+         when DW_OP_Xor =>
+            return "xor";
+         when DW_OP_Skip =>
+            return "skip";
+         when DW_OP_Bra =>
+            return "bra";
+         when DW_OP_Eq =>
+            return "eq";
+         when DW_OP_Ge =>
+            return "ge";
+         when DW_OP_Gt =>
+            return "gt";
+         when DW_OP_Le =>
+            return "le";
+         when DW_OP_Lt =>
+            return "lt";
+         when DW_OP_Ne =>
+            return "ne";
+         when DW_OP_Lit0 =>
+            return "lit0";
+         when DW_OP_Lit1 =>
+            return "lit1";
+         when DW_OP_Lit2 =>
+            return "lit2";
+         when DW_OP_Lit3 =>
+            return "lit3";
+         when DW_OP_Lit4 =>
+            return "lit4";
+         when DW_OP_Lit5 =>
+            return "lit5";
+         when DW_OP_Lit6 =>
+            return "lit6";
+         when DW_OP_Lit7 =>
+            return "lit7";
+         when DW_OP_Lit8 =>
+            return "lit8";
+         when DW_OP_Lit9 =>
+            return "lit9";
+         when DW_OP_Lit10 =>
+            return "lit10";
+         when DW_OP_Lit11 =>
+            return "lit11";
+         when DW_OP_Lit12 =>
+            return "lit12";
+         when DW_OP_Lit13 =>
+            return "lit13";
+         when DW_OP_Lit14 =>
+            return "lit14";
+         when DW_OP_Lit15 =>
+            return "lit15";
+         when DW_OP_Lit16 =>
+            return "lit16";
+         when DW_OP_Lit17 =>
+            return "lit17";
+         when DW_OP_Lit18 =>
+            return "lit18";
+         when DW_OP_Lit19 =>
+            return "lit19";
+         when DW_OP_Lit20 =>
+            return "lit20";
+         when DW_OP_Lit21 =>
+            return "lit21";
+         when DW_OP_Lit22 =>
+            return "lit22";
+         when DW_OP_Lit23 =>
+            return "lit23";
+         when DW_OP_Lit24 =>
+            return "lit24";
+         when DW_OP_Lit25 =>
+            return "lit25";
+         when DW_OP_Lit26 =>
+            return "lit26";
+         when DW_OP_Lit27 =>
+            return "lit27";
+         when DW_OP_Lit28 =>
+            return "lit28";
+         when DW_OP_Lit29 =>
+            return "lit29";
+         when DW_OP_Lit30 =>
+            return "lit30";
+         when DW_OP_Lit31 =>
+            return "lit31";
+         when DW_OP_Reg0 =>
+            return "reg0";
+         when DW_OP_Reg1 =>
+            return "reg1";
+         when DW_OP_Reg2 =>
+            return "reg2";
+         when DW_OP_Reg3 =>
+            return "reg3";
+         when DW_OP_Reg4 =>
+            return "reg4";
+         when DW_OP_Reg5 =>
+            return "reg5";
+         when DW_OP_Reg6 =>
+            return "reg6";
+         when DW_OP_Reg7 =>
+            return "reg7";
+         when DW_OP_Reg8 =>
+            return "reg8";
+         when DW_OP_Reg9 =>
+            return "reg9";
+         when DW_OP_Reg10 =>
+            return "reg10";
+         when DW_OP_Reg11 =>
+            return "reg11";
+         when DW_OP_Reg12 =>
+            return "reg12";
+         when DW_OP_Reg13 =>
+            return "reg13";
+         when DW_OP_Reg14 =>
+            return "reg14";
+         when DW_OP_Reg15 =>
+            return "reg15";
+         when DW_OP_Reg16 =>
+            return "reg16";
+         when DW_OP_Reg17 =>
+            return "reg17";
+         when DW_OP_Reg18 =>
+            return "reg18";
+         when DW_OP_Reg19 =>
+            return "reg19";
+         when DW_OP_Reg20 =>
+            return "reg20";
+         when DW_OP_Reg21 =>
+            return "reg21";
+         when DW_OP_Reg22 =>
+            return "reg22";
+         when DW_OP_Reg23 =>
+            return "reg23";
+         when DW_OP_Reg24 =>
+            return "reg24";
+         when DW_OP_Reg25 =>
+            return "reg25";
+         when DW_OP_Reg26 =>
+            return "reg26";
+         when DW_OP_Reg27 =>
+            return "reg27";
+         when DW_OP_Reg28 =>
+            return "reg28";
+         when DW_OP_Reg29 =>
+            return "reg29";
+         when DW_OP_Reg30 =>
+            return "reg30";
+         when DW_OP_Reg31 =>
+            return "reg31";
+         when DW_OP_Breg0 =>
+            return "breg0";
+         when DW_OP_Breg1 =>
+            return "breg1";
+         when DW_OP_Breg2 =>
+            return "breg2";
+         when DW_OP_Breg3 =>
+            return "breg3";
+         when DW_OP_Breg4 =>
+            return "breg4";
+         when DW_OP_Breg5 =>
+            return "breg5";
+         when DW_OP_Breg6 =>
+            return "breg6";
+         when DW_OP_Breg7 =>
+            return "breg7";
+         when DW_OP_Breg8 =>
+            return "breg8";
+         when DW_OP_Breg9 =>
+            return "breg9";
+         when DW_OP_Breg10 =>
+            return "breg10";
+         when DW_OP_Breg11 =>
+            return "breg11";
+         when DW_OP_Breg12 =>
+            return "breg12";
+         when DW_OP_Breg13 =>
+            return "breg13";
+         when DW_OP_Breg14 =>
+            return "breg14";
+         when DW_OP_Breg15 =>
+            return "breg15";
+         when DW_OP_Breg16 =>
+            return "breg16";
+         when DW_OP_Breg17 =>
+            return "breg17";
+         when DW_OP_Breg18 =>
+            return "breg18";
+         when DW_OP_Breg19 =>
+            return "breg19";
+         when DW_OP_Breg20 =>
+            return "breg20";
+         when DW_OP_Breg21 =>
+            return "breg21";
+         when DW_OP_Breg22 =>
+            return "breg22";
+         when DW_OP_Breg23 =>
+            return "breg23";
+         when DW_OP_Breg24 =>
+            return "breg24";
+         when DW_OP_Breg25 =>
+            return "breg25";
+         when DW_OP_Breg26 =>
+            return "breg26";
+         when DW_OP_Breg27 =>
+            return "breg27";
+         when DW_OP_Breg28 =>
+            return "breg28";
+         when DW_OP_Breg29 =>
+            return "breg29";
+         when DW_OP_Breg30 =>
+            return "breg30";
+         when DW_OP_Breg31 =>
+            return "breg31";
+         when DW_OP_Regx =>
+            return "regx";
+         when DW_OP_Fbreg =>
+            return "fbreg";
+         when DW_OP_Bregx =>
+            return "bregx";
+         when DW_OP_Piece =>
+            return "piece";
+         when DW_OP_Deref_Size =>
+            return "deref_size";
+         when DW_OP_Xderef_Size =>
+            return "xderef_size";
+         when DW_OP_Nop =>
+            return "nop";
+         when DW_OP_Push_Object_Address =>
+            return "push_object_address";
+         when DW_OP_Call2 =>
+            return "call2";
+         when DW_OP_Call4 =>
+            return "call4";
+         when DW_OP_Call_Ref =>
+            return "call_ref";
+         when others =>
+            return "unknown";
+      end case;
+   end Get_Dwarf_Op_Name;
+
+   procedure Read_Dwarf_Block (Base : Address;
+                               Off : in out Storage_Offset;
+                               Form : Unsigned_32;
+                               B : out Address;
+                               L : out Unsigned_32)
+   is
+      use Dwarf;
+   begin
+      case Form is
+         when DW_FORM_Block1 =>
+            B := Base + Off + 1;
+            L := Unsigned_32 (Read_Byte (Base + Off));
+            Off := Off + 1;
+         when others =>
+            raise Program_Error;
+      end case;
+      Off := Off + Storage_Offset (L);
+   end Read_Dwarf_Block;
+
+   procedure Disp_Dwarf_Location
+     (Base : Address; Off : in out Storage_Offset; Form : Unsigned_32)
+   is
+      use Dwarf;
+      B : Address;
+      L : Unsigned_32;
+      Op : Unsigned_8;
+      Boff : Storage_Offset;
+      Is_Full : Boolean;
+   begin
+      Read_Dwarf_Block (Base, Off, Form, B, L);
+      if L = 0 then
+         return;
+      end if;
+      Is_Full := L > 6;
+      Boff := 0;
+      while Boff < Storage_Offset (L) loop
+         if Is_Full then
+            New_Line;
+            Put ("   ");
+            Put (Hex_Image (Unsigned_32 (Boff)));
+            Put (": ");
+         end if;
+         Op := Read_Byte (B + Boff);
+         Put (' ');
+         Put (Get_Dwarf_Op_Name (Op));
+         Boff := Boff + 1;
+         case Op is
+            when DW_OP_Addr =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_Word4 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+            when DW_OP_Deref =>
+               null;
+            when DW_OP_Const1u
+              | DW_OP_Const1s =>
+               declare
+                  V : Unsigned_8;
+               begin
+                  Read_Byte (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+--     DW_OP_Const2u     : constant := 16#0a#; -- 1 2-byte constant
+--     DW_OP_Const2s     : constant := 16#0b#; -- 1 2-byte constant
+--     DW_OP_Const4u     : constant := 16#0c#; -- 1 4-byte constant
+--     DW_OP_Const4s     : constant := 16#0d#; -- 1 4-byte constant
+--     DW_OP_Const8u     : constant := 16#0e#; -- 1 8-byte constant
+--     DW_OP_Const8s     : constant := 16#0f#; -- 1 8-byte constant
+--     DW_OP_Constu      : constant := 16#10#; -- 1 ULEB128 constant
+--     DW_OP_Consts      : constant := 16#11#; -- 1 SLEB128 constant
+--     DW_OP_Dup         : constant := 16#12#; -- 0
+--     DW_OP_Drop        : constant := 16#13#; -- 0
+--     DW_OP_Over        : constant := 16#14#; -- 0
+--     DW_OP_Pick        : constant := 16#15#; -- 1 1-byte stack index
+
+            when DW_OP_Swap
+              | DW_OP_Rot
+              | DW_OP_Xderef
+              | DW_OP_Abs
+              | DW_OP_And
+              | DW_OP_Div
+              | DW_OP_Minus
+              | DW_OP_Mod
+              | DW_OP_Mul
+              | DW_OP_Neg
+              | DW_OP_Not
+              | DW_OP_Or
+              | DW_OP_Plus =>
+               null;
+            when DW_OP_Plus_Uconst
+              | DW_OP_Piece
+              | DW_OP_Regx =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_ULEB128 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+            when DW_OP_Shl
+              | DW_OP_Shr
+              | DW_OP_Shra
+              | DW_OP_Xor =>
+               null;
+            when DW_OP_Skip
+              | DW_OP_Bra =>
+               declare
+                  V : Unsigned_16;
+               begin
+                  Read_Word2 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+                  Put (" (@");
+                  --  FIXME: signed
+                  Put (Hex_Image (Unsigned_32 (Boff) + Unsigned_32 (V)));
+                  Put (")");
+               end;
+            when DW_OP_Eq
+              | DW_OP_Ge
+              | DW_OP_Gt
+              | DW_OP_Le
+              | DW_OP_Lt
+              | DW_OP_Ne =>
+               null;
+            when DW_OP_Lit0 .. DW_OP_Lit31 =>
+               null;
+            when DW_OP_Reg0 .. DW_OP_Reg31 =>
+               null;
+            when DW_OP_Breg0 .. DW_OP_Breg31
+              | DW_OP_Fbreg =>
+               declare
+                  V : Unsigned_32;
+               begin
+                  Read_SLEB128 (B, Boff, V);
+                  Put (':');
+                  Put (Hex_Image (V));
+               end;
+
+--   DW_OP_Regx        : constant := 16#90#; -- 1 ULEB128 register
+--   DW_OP_Bregx       : constant := 16#92#; -- 2 ULEB128 reg + SLEB128 offset
+--   DW_OP_Deref_Size  : constant := 16#94#; -- 1 1-byte size of data retrieved
+--   DW_OP_Xderef_Size : constant := 16#95#; -- 1 1-byte size of data retrieved
+            when DW_OP_Nop =>
+               null;
+--     DW_OP_Push_Object_Address : constant := 16#97#; -- 0
+--     DW_OP_Call2       : constant := 16#98#; -- 1 2-byte offset of DIE
+--     DW_OP_Call4       : constant := 16#99#; -- 1 4-byte offset of DIE
+--     DW_OP_Call_Ref    : constant := 16#9a#; -- 1 4- or 8-byte offset of DIE
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+   end Disp_Dwarf_Location;
+
+   procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half)
+   is
+      use Dwarf;
+
+      Abbrev_Index : Elf_Half;
+      Abbrev_Base : Address;
+      Map : Abbrev_Map_Acc;
+      Abbrev : Address;
+
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Aoff : Storage_Offset;
+      Old_Off : Storage_Offset;
+
+      Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Abbrev_Off : Unsigned_32;
+      Ptr_Sz : Unsigned_8;
+      Last : Storage_Offset;
+      Num : Unsigned_32;
+
+      Tag : Unsigned_32;
+      Name : Unsigned_32;
+      Form : Unsigned_32;
+
+      Level : Unsigned_8;
+   begin
+      Abbrev_Index := Get_Section_By_Name (File, ".debug_abbrev");
+      Abbrev_Base := Get_Section_Base (File, Abbrev_Index);
+      Map := null;
+
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Put_Line ("Compilation unit at #"
+                   & Hex_Image (Unsigned_32 (Off)) & ":");
+         Read_Word4 (Base, Off, Len);
+         Last := Off + Storage_Offset (Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Abbrev_Off);
+         Read_Byte (Base, Off, Ptr_Sz);
+         Put (' ');
+         Put ("length: " & Hex_Image (Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", abbrev offset: " & Hex_Image (Abbrev_Off));
+         Put (", ptr_sz: " & Hex_Image (Ptr_Sz));
+         New_Line;
+         Level := 0;
+
+         Build_Abbrev_Map (Abbrev_Base + Storage_Offset (Abbrev_Off), Map);
+         loop
+            << Again >> null;
+            exit when Off >= Last;
+            Old_Off := Off;
+            Read_ULEB128 (Base, Off, Num);
+            Put ("<" & Hex_Image (Unsigned_32 (Old_Off)) & ">");
+            Put ("<" & Hex_Image (Level) & ">");
+            Put (" with abbrev #" & Hex_Image (Num));
+            if Num = 0 then
+               Level := Level - 1;
+               New_Line;
+               goto Again;
+            end if;
+            if Num <= Map.all'Last then
+               Abbrev := Map (Num);
+            else
+               Abbrev := Null_Address;
+            end if;
+            if Abbrev = Null_Address then
+               New_Line;
+               Put ("!! abbrev #" & Hex_Image (Num) & " does not exist !!");
+               New_Line;
+               return;
+            end if;
+            Aoff := 0;
+            Read_ULEB128 (Abbrev, Aoff, Tag);
+            if Read_Byte (Abbrev + Aoff) /= 0 then
+               Put (" [has_child]");
+               Level := Level + 1;
+            end if;
+            New_Line;
+
+            --  skip child.
+            Aoff := Aoff + 1;
+            Put (" tag: " & Hex_Image (Tag));
+            Put (" (");
+            Put (Get_Dwarf_Tag_Name (Tag));
+            Put (")");
+            New_Line;
+
+            loop
+               Read_ULEB128 (Abbrev, Aoff, Name);
+               Read_ULEB128 (Abbrev, Aoff, Form);
+               exit when Name = 0 and Form = 0;
+               Put ("  ");
+               Put (Get_Dwarf_At_Name (Name));
+               Set_Col (24);
+               Put (": ");
+               Old_Off := Off;
+               Disp_Dwarf_Form (Base, Off, Form);
+               case Name is
+                  when DW_AT_Encoding =>
+                     Put (": ");
+                     Disp_Dwarf_Encoding (Base, Old_Off, Form);
+                  when DW_AT_Location
+                    | DW_AT_Frame_Base
+                    | DW_AT_Data_Member_Location =>
+                     Put (":");
+                     Disp_Dwarf_Location (Base, Old_Off, Form);
+                  when DW_AT_Language =>
+                     Put (": ");
+                     Disp_Dwarf_Language (Base, Old_Off, Form);
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            end loop;
+         end loop;
+         Unchecked_Deallocation (Map);
+         New_Line;
+      end loop;
+   end Disp_Debug_Info;
+
+   function Get_Phdr_Type_Name (Ptype : Elf_Word) return String is
+   begin
+      case Ptype is
+         when PT_NULL =>
+            return "NULL";
+         when PT_LOAD =>
+            return "LOAD";
+         when PT_DYNAMIC =>
+            return "DYNAMIC";
+         when PT_INTERP =>
+            return "INTERP";
+         when PT_NOTE =>
+            return "NOTE";
+         when PT_SHLIB =>
+            return "SHLIB";
+         when PT_PHDR =>
+            return "PHDR";
+         when PT_TLS =>
+            return "TLS";
+         when PT_NUM =>
+            return "NUM";
+         when PT_GNU_EH_FRAME =>
+            return "GNU_EH_FRAME";
+         when PT_SUNWBSS =>
+            return "SUNWBSS";
+         when PT_SUNWSTACK =>
+            return "SUNWSTACK";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Phdr_Type_Name;
+
+   procedure Disp_Phdr (Phdr : Elf_Phdr)
+   is
+   begin
+      Put ("type  : " & Hex_Image (Phdr.P_Type));
+      Put ("  ");
+      Put (Get_Phdr_Type_Name (Phdr.P_Type));
+      New_Line;
+      Put ("offset: " & Hex_Image (Phdr.P_Offset));
+      Put ("  vaddr: " & Hex_Image (Phdr.P_Vaddr));
+      Put ("  paddr: " & Hex_Image (Phdr.P_Paddr));
+      New_Line;
+      Put ("filesz: " & Hex_Image (Phdr.P_Filesz));
+      Put ("  memsz: " & Hex_Image (Phdr.P_Memsz));
+      Put ("  align: " & Hex_Image (Phdr.P_Align));
+      --New_Line;
+      Put ("  flags: " & Hex_Image (Phdr.P_Flags));
+      Put (" (");
+      if (Phdr.P_Flags and PF_X) /= 0 then
+         Put ('X');
+      end if;
+      if (Phdr.P_Flags and PF_W) /= 0 then
+         Put ('W');
+      end if;
+      if (Phdr.P_Flags and PF_R) /= 0 then
+         Put ('R');
+      end if;
+      Put (")");
+      New_Line;
+   end Disp_Phdr;
+
+   procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      B : Unsigned_8;
+
+      Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Info_Off : Unsigned_32;
+      Info_Length : Unsigned_32;
+      Last : Storage_Offset;
+      Ioff : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Len);
+         Last := Off + Storage_Offset (Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Info_Off);
+         Read_Word4 (Base, Off, Info_Length);
+         Put ("length: " & Hex_Image (Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", offset: " & Hex_Image (Info_Off));
+         Put (", length: " & Hex_Image (Info_Length));
+         New_Line;
+
+         loop
+            Read_Word4 (Base, Off, Ioff);
+            Put ("  ");
+            Put (Hex_Image (Ioff));
+            if Ioff /= 0 then
+               Put (": ");
+               loop
+                  Read_Byte (Base, Off, B);
+                  exit when B = 0;
+                  Put (Character'Val (B));
+               end loop;
+            end if;
+            New_Line;
+            exit when Ioff = 0;
+         end loop;
+      end loop;
+   end Disp_Debug_Pubnames;
+
+   procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      Set_Len : Unsigned_32;
+      Ver : Unsigned_16;
+      Info_Off : Unsigned_32;
+      Last : Storage_Offset;
+      Addr_Sz : Unsigned_8;
+      Seg_Sz : Unsigned_8;
+      Pad : Unsigned_32;
+
+      Addr : Unsigned_32;
+      Len : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Set_Len);
+         Last := Off + Storage_Offset (Set_Len);
+         Read_Word2 (Base, Off, Ver);
+         Read_Word4 (Base, Off, Info_Off);
+         Read_Byte (Base, Off, Addr_Sz);
+         Read_Byte (Base, Off, Seg_Sz);
+         Read_Word4 (Base, Off, Pad);
+         Put ("length: " & Hex_Image (Set_Len));
+         Put (", version: " & Hex_Image (Ver));
+         Put (", offset: " & Hex_Image (Info_Off));
+         Put (", ptr_sz: " & Hex_Image (Addr_Sz));
+         Put (", seg_sz: " & Hex_Image (Seg_Sz));
+         New_Line;
+
+         loop
+            Read_Word4 (Base, Off, Addr);
+            Read_Word4 (Base, Off, Len);
+            Put ("  ");
+            Put (Hex_Image (Addr));
+            Put ('+');
+            Put (Hex_Image (Len));
+            New_Line;
+            exit when Addr = 0 and Len = 0;
+         end loop;
+      end loop;
+   end Disp_Debug_Aranges;
+
+   procedure Disp_String (Base : Address; Off : in out Storage_Offset)
+   is
+      B : Unsigned_8;
+   begin
+      loop
+         B := Read_Byte (Base + Off);
+         Off := Off + 1;
+         exit when B = 0;
+         Put (Character'Val (B));
+      end loop;
+   end Disp_String;
+
+   procedure Read_String (Base : Address; Off : in out Storage_Offset)
+   is
+      B : Unsigned_8;
+   begin
+      loop
+         Read_Byte (Base, Off, B);
+         exit when B = 0;
+      end loop;
+   end Read_String;
+
+   function Get_Dwarf_LNS_Name (Lns : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Lns is
+         when DW_LNS_Copy =>
+            return "copy";
+         when DW_LNS_Advance_Pc =>
+            return "advance_pc";
+         when DW_LNS_Advance_Line =>
+            return "advance_line";
+         when DW_LNS_Set_File =>
+            return "set_file";
+         when DW_LNS_Set_Column =>
+            return "set_column";
+         when DW_LNS_Negate_Stmt =>
+            return "negate_stmt";
+         when DW_LNS_Set_Basic_Block =>
+            return "set_basic_block";
+         when DW_LNS_Const_Add_Pc =>
+            return "const_add_pc";
+         when DW_LNS_Fixed_Advance_Pc =>
+            return "fixed_advance_pc";
+         when DW_LNS_Set_Prologue_End =>
+            return "set_prologue_end";
+         when DW_LNS_Set_Epilogue_Begin =>
+            return "set_epilogue_begin";
+         when DW_LNS_Set_Isa =>
+            return "set_isa";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_LNS_Name;
+
+   procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half)
+   is
+      use Dwarf;
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      type Opc_Length_Type is array (Unsigned_8 range <>) of Unsigned_8;
+      type Opc_Length_Acc is access Opc_Length_Type;
+      Opc_Length : Opc_Length_Acc;
+
+      Total_Len : Unsigned_32;
+      Version : Unsigned_16;
+      Prolog_Len : Unsigned_32;
+      Min_Insn_Len : Unsigned_8;
+      Dflt_Is_Stmt : Unsigned_8;
+      Line_Base : Unsigned_8;
+      Line_Range : Unsigned_8;
+      Opc_Base : Unsigned_8;
+
+      B : Unsigned_8;
+      Arg : Unsigned_32;
+
+      Old_Off : Storage_Offset;
+      File_Dir : Unsigned_32;
+      File_Time : Unsigned_32;
+      File_Len : Unsigned_32;
+
+      Ext_Len : Unsigned_32;
+      Ext_Opc : Unsigned_8;
+
+      Last : Storage_Offset;
+
+      Pc : Unsigned_32;
+      Line : Unsigned_32;
+      Line_Base2 : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Total_Len);
+         Last := Off + Storage_Offset (Total_Len);
+         Read_Word2 (Base, Off, Version);
+         Read_Word4 (Base, Off, Prolog_Len);
+         Read_Byte (Base, Off, Min_Insn_Len);
+         Read_Byte (Base, Off, Dflt_Is_Stmt);
+         Read_Byte (Base, Off, Line_Base);
+         Read_Byte (Base, Off, Line_Range);
+         Read_Byte (Base, Off, Opc_Base);
+
+         Pc := 0;
+         Line := 1;
+
+         Put ("length: " & Hex_Image (Total_Len));
+         Put (", version: " & Hex_Image (Version));
+         Put (", prolog_len: " & Hex_Image (Prolog_Len));
+         New_Line;
+         Put (" minimum_instruction_len: " & Hex_Image (Min_Insn_Len));
+         Put (", default_is_stmt: " & Hex_Image (Dflt_Is_Stmt));
+         New_Line;
+         Put (" line_base: " & Hex_Image (Line_Base));
+         Put (", line_range: " & Hex_Image (Line_Range));
+         Put (", opc_base: " & Hex_Image (Opc_Base));
+         New_Line;
+         Line_Base2 := Unsigned_32 (Line_Base);
+         if (Line_Base and 16#80#) /= 0 then
+            Line_Base2 := Line_Base2 or 16#Ff_Ff_Ff_00#;
+         end if;
+         Put_Line ("standard_opcode_length:");
+         Opc_Length := new Opc_Length_Type (1 .. Opc_Base - 1);
+         for I in 1 .. Opc_Base - 1 loop
+            Read_Byte (Base, Off, B);
+            Put (' ');
+            Put (Hex_Image (I));
+            Put (" => ");
+            Put (Hex_Image (B));
+            Opc_Length (I) := B;
+            New_Line;
+         end loop;
+         Put_Line ("include_directories:");
+         loop
+            B := Read_Byte (Base + Off);
+            exit when B = 0;
+            Put (' ');
+            Disp_String (Base, Off);
+            New_Line;
+         end loop;
+         Off := Off + 1;
+         Put_Line ("file_names:");
+         loop
+            B := Read_Byte (Base + Off);
+            exit when B = 0;
+            Old_Off := Off;
+            Read_String (Base, Off);
+            Read_ULEB128 (Base, Off, File_Dir);
+            Read_ULEB128 (Base, Off, File_Time);
+            Read_ULEB128 (Base, Off, File_Len);
+            Put (' ');
+            Put (Hex_Image (File_Dir));
+            Put (' ');
+            Put (Hex_Image (File_Time));
+            Put (' ');
+            Put (Hex_Image (File_Len));
+            Put (' ');
+            Disp_String (Base, Old_Off);
+            New_Line;
+         end loop;
+         Off := Off + 1;
+
+         while Off < Last loop
+            Put ("  ");
+            Read_Byte (Base, Off, B);
+            Put (Hex_Image (B));
+            Old_Off := Off;
+            if B < Opc_Base then
+               case B is
+                  when 0 =>
+                     Put (" (extended)");
+                     Read_ULEB128 (Base, Off, Ext_Len);
+                     Put (", len: ");
+                     Put (Hex_Image (Ext_Len));
+                     Old_Off := Off;
+                     Read_Byte (Base, Off, Ext_Opc);
+                     Put (" opc:");
+                     Put (Hex_Image (Ext_Opc));
+                     Off := Old_Off + Storage_Offset (Ext_Len);
+                  when others =>
+                     Put (" (");
+                     Put (Get_Dwarf_LNS_Name (B));
+                     Put (")");
+                     Set_Col (20);
+                     for J in 1 .. Opc_Length (B) loop
+                        Read_ULEB128 (Base, Off, Arg);
+                        Put (" ");
+                        Put (Hex_Image (Arg));
+                     end loop;
+               end case;
+               case B is
+                  when DW_LNS_Copy =>
+                     Put (" pc=");
+                     Put (Hex_Image (Pc));
+                     Put (", line=");
+                     Put (Unsigned_32'Image (Line));
+                  when DW_LNS_Advance_Pc =>
+                     Read_ULEB128 (Base, Old_Off, Arg);
+                     Pc := Pc + Arg * Unsigned_32 (Min_Insn_Len);
+                     Put ("  pc=");
+                     Put (Hex_Image (Pc));
+                  when DW_LNS_Advance_Line =>
+                     Read_SLEB128 (Base, Old_Off, Arg);
+                     Line := Line + Arg;
+                     Put ("  line=");
+                     Put (Unsigned_32'Image (Line));
+                  when DW_LNS_Set_File =>
+                     null;
+                  when DW_LNS_Set_Column =>
+                     null;
+                  when DW_LNS_Negate_Stmt =>
+                     null;
+                  when DW_LNS_Set_Basic_Block =>
+                     null;
+                  when DW_LNS_Const_Add_Pc =>
+                     Pc := Pc + Unsigned_32 ((255 - Opc_Base) / Line_Range)
+                       * Unsigned_32 (Min_Insn_Len);
+                     Put ("  pc=");
+                     Put (Hex_Image (Pc));
+                  when others =>
+                     null;
+               end case;
+               New_Line;
+            else
+               B := B - Opc_Base;
+               Pc := Pc + Unsigned_32 (B / Line_Range)
+                 * Unsigned_32 (Min_Insn_Len);
+               Line := Line + Line_Base2 + Unsigned_32 (B mod Line_Range);
+               Put (" pc=");
+               Put (Hex_Image (Pc));
+               Put (", line=");
+               Put (Unsigned_32'Image (Line));
+               New_Line;
+            end if;
+         end loop;
+      end loop;
+   end Disp_Debug_Line;
+
+   function Get_Dwarf_Cfi_Name (Cfi : Unsigned_8) return String
+   is
+      use Dwarf;
+   begin
+      case Cfi is
+         when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
+            return "advance_loc";
+         when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
+            return "offset";
+         when DW_CFA_Restore_Min .. DW_CFA_Restore_Max =>
+            return "restore";
+         when DW_CFA_Nop =>
+            return "nop";
+         when DW_CFA_Set_Loc =>
+            return "set_loc";
+         when DW_CFA_Advance_Loc1 =>
+            return "advance_loc1";
+         when DW_CFA_Advance_Loc2 =>
+            return "advance_loc2";
+         when DW_CFA_Advance_Loc4 =>
+            return "advance_loc4";
+         when DW_CFA_Offset_Extended =>
+            return "offset_extended";
+         when DW_CFA_Restore_Extended =>
+            return "restore_extended";
+         when DW_CFA_Undefined =>
+            return "undefined";
+         when DW_CFA_Same_Value =>
+            return "same_value";
+         when DW_CFA_Register =>
+            return "register";
+         when DW_CFA_Remember_State =>
+            return "remember_state";
+         when DW_CFA_Restore_State =>
+            return "restore_state";
+         when DW_CFA_Def_Cfa =>
+            return "def_cfa";
+         when DW_CFA_Def_Cfa_Register =>
+            return "def_cfa_register";
+         when DW_CFA_Def_Cfa_Offset =>
+            return "def_cfa_offset";
+         when DW_CFA_Def_Cfa_Expression =>
+            return "def_cfa_expression";
+         when others =>
+            return "?unknown?";
+      end case;
+   end Get_Dwarf_Cfi_Name;
+
+   procedure Disp_Cfi (Base : Address; Length : Storage_Count)
+   is
+      use Dwarf;
+      L : Storage_Offset;
+      Op : Unsigned_8;
+      Off : Unsigned_32;
+      Reg : Unsigned_32;
+   begin
+      L := 0;
+      while L < Length loop
+         Op := Read_Byte (Base + L);
+         Put (" ");
+         Put (Hex_Image (Op));
+         Put (" ");
+         Put (Get_Dwarf_Cfi_Name (Op));
+         Put (" ");
+         L := L + 1;
+         case Op is
+            when DW_CFA_Nop =>
+               null;
+            when DW_CFA_Advance_Loc_Min .. DW_CFA_Advance_Loc_Max =>
+               Put (Hex_Image (Op and 16#3f#));
+            when DW_CFA_Offset_Min .. DW_CFA_Offset_Max =>
+               Read_ULEB128 (Base, L, Off);
+               Put ("reg:");
+               Put (Hex_Image (Op and 16#3f#));
+               Put (", offset:");
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa =>
+               Read_ULEB128 (Base, L, Reg);
+               Read_ULEB128 (Base, L, Off);
+               Put ("reg:");
+               Put (Hex_Image (Reg));
+               Put (", offset:");
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa_Offset =>
+               Read_ULEB128 (Base, L, Off);
+               Put (Hex_Image (Off));
+            when DW_CFA_Def_Cfa_Register =>
+               Read_ULEB128 (Base, L, Reg);
+               Put ("reg:");
+               Put (Hex_Image (Reg));
+            when others =>
+               Put ("?unknown?");
+               New_Line;
+               exit;
+         end case;
+         New_Line;
+      end loop;
+   end Disp_Cfi;
+
+   procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+      Old_Off : Storage_Offset;
+
+      Length : Unsigned_32;
+      Cie_Id : Unsigned_32;
+      Version : Unsigned_8;
+      Augmentation : Unsigned_8;
+      Code_Align : Unsigned_32;
+      Data_Align : Unsigned_32;
+      Ret_Addr_Reg : Unsigned_8;
+
+      Init_Loc : Unsigned_32;
+      Addr_Rng : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Word4 (Base, Off, Length);
+         Old_Off := Off;
+
+         Read_Word4 (Base, Off, Cie_Id);
+         if Cie_Id = 16#Ff_Ff_Ff_Ff# then
+            Read_Byte (Base, Off, Version);
+            Read_Byte (Base, Off, Augmentation);
+            Put ("length: ");
+            Put (Hex_Image (Length));
+            Put (", CIE_id: ");
+            Put (Hex_Image (Cie_Id));
+            Put (", version: ");
+            Put (Hex_Image (Version));
+            if Augmentation /= 0 then
+               Put (" +augmentation");
+               New_Line;
+            else
+               New_Line;
+               Read_ULEB128 (Base, Off, Code_Align);
+               Read_SLEB128 (Base, Off, Data_Align);
+               Read_Byte (Base, Off, Ret_Addr_Reg);
+               Put ("code_align: ");
+               Put (Hex_Image (Code_Align));
+               Put (", data_align: ");
+               Put (Hex_Image (Data_Align));
+               Put (", ret_addr_reg: ");
+               Put (Hex_Image (Ret_Addr_Reg));
+               New_Line;
+               Put ("initial instructions:");
+               New_Line;
+               Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
+            end if;
+         else
+            Read_Word4 (Base, Off, Init_Loc);
+            Read_Word4 (Base, Off, Addr_Rng);
+            Put ("length: ");
+            Put (Hex_Image (Length));
+            Put (", CIE_pointer: ");
+            Put (Hex_Image (Cie_Id));
+            Put (", address_range: ");
+            Put (Hex_Image (Init_Loc));
+            Put ("-");
+            Put (Hex_Image (Init_Loc + Addr_Rng));
+            New_Line;
+            Put ("instructions:");
+            New_Line;
+            Disp_Cfi (Base + Off, Old_Off + Storage_Offset (Length) - Off);
+         end if;
+         Off := Old_Off + Storage_Offset (Length);
+      end loop;
+   end Disp_Debug_Frame;
+
+   procedure Read_Coded (Base : Address;
+                         Offset : in out Storage_Offset;
+                         Code : Unsigned_8;
+                         Val : out Unsigned_32)
+   is
+      use Dwarf;
+
+      V2 : Unsigned_16;
+   begin
+      if Code = DW_EH_PE_Omit then
+         return;
+      end if;
+      case Code and DW_EH_PE_Format_Mask is
+         when DW_EH_PE_Uleb128 =>
+            Read_ULEB128 (Base, Offset, Val);
+         when DW_EH_PE_Udata2 =>
+            Read_Word2 (Base, Offset, V2);
+            Val := Unsigned_32 (V2);
+         when DW_EH_PE_Udata4 =>
+            Read_Word4 (Base, Offset, Val);
+         when DW_EH_PE_Sleb128 =>
+            Read_SLEB128 (Base, Offset, Val);
+         when DW_EH_PE_Sdata2 =>
+            Read_Word2 (Base, Offset, V2);
+            Val := Unsigned_32 (V2);
+            if (V2 and 16#80_00#) /= 0 then
+               Val := Val or 16#Ff_Ff_00_00#;
+            end if;
+         when DW_EH_PE_Sdata4 =>
+            Read_Word4 (Base, Offset, Val);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Read_Coded;
+
+   procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half)
+   is
+      Shdr : Elf_Shdr_Acc;
+      Base : Address;
+      Off : Storage_Offset;
+
+      Version : Unsigned_8;
+      Eh_Frame_Ptr_Enc : Unsigned_8;
+      Fde_Count_Enc : Unsigned_8;
+      Table_Enc : Unsigned_8;
+
+      Eh_Frame_Ptr : Unsigned_32;
+      Fde_Count : Unsigned_32;
+
+      Loc : Unsigned_32;
+      Addr : Unsigned_32;
+   begin
+      Shdr := Get_Shdr (File, Index);
+      Base := Get_Section_Base (File, Shdr.all);
+
+      Off := 0;
+      while Off < Storage_Offset (Shdr.Sh_Size) loop
+         Read_Byte (Base, Off, Version);
+         Read_Byte (Base, Off, Eh_Frame_Ptr_Enc);
+         Read_Byte (Base, Off, Fde_Count_Enc);
+         Read_Byte (Base, Off, Table_Enc);
+         Put ("version: ");
+         Put (Hex_Image (Version));
+         Put (", encodings: ptr:");
+         Put (Hex_Image (Eh_Frame_Ptr_Enc));
+         Put (" count:");
+         Put (Hex_Image (Fde_Count_Enc));
+         Put (" table:");
+         Put (Hex_Image (Table_Enc));
+         New_Line;
+         Read_Coded (Base, Off, Eh_Frame_Ptr_Enc, Eh_Frame_Ptr);
+         Read_Coded (Base, Off, Fde_Count_Enc, Fde_Count);
+         Put ("eh_frame_ptr: ");
+         Put (Hex_Image (Eh_Frame_Ptr));
+         Put (", fde_count: ");
+         Put (Hex_Image (Fde_Count));
+         New_Line;
+         for I in 1 .. Fde_Count loop
+            Read_Coded (Base, Off, Table_Enc, Loc);
+            Read_Coded (Base, Off, Table_Enc, Addr);
+            Put ("  init loc: ");
+            Put (Hex_Image (Loc));
+            Put (", addr : ");
+            Put (Hex_Image (Addr));
+            New_Line;
+         end loop;
+      end loop;
+   end Disp_Eh_Frame_Hdr;
+end Elfdumper;
diff --git a/src/ortho/mcode/elfdumper.ads b/src/ortho/mcode/elfdumper.ads
new file mode 100644
index 000000000..0227f0f41
--- /dev/null
+++ b/src/ortho/mcode/elfdumper.ads
@@ -0,0 +1,164 @@
+--  ELF dumper (library).
+--  Copyright (C) 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; use System;
+with Elf_Common; use Elf_Common;
+with Elf_Arch; use Elf_Arch;
+with Ada.Unchecked_Conversion;
+
+package Elfdumper is
+   procedure Disp_Ehdr (Ehdr : Elf_Ehdr);
+
+   type Strtab_Fat_Type is array (Elf_Size) of Character;
+   type Strtab_Fat_Acc is access all Strtab_Fat_Type;
+
+   type Strtab_Type is record
+      Base : Strtab_Fat_Acc;
+      Length : Elf_Size;
+   end record;
+
+   Null_Strtab : constant Strtab_Type := (null, 0);
+
+   Nul : constant Character := Character'Val (0);
+
+   function Get_String (Strtab : Strtab_Type; N : Elf_Size)
+                       return String;
+
+   procedure Disp_Shdr (Shdr : Elf_Shdr; Sh_Strtab : Strtab_Type);
+
+   type Elf_Shdr_Array is array (Elf_Half range <>) of Elf_Shdr;
+
+   type Elf_File is limited private;
+   type Elf_File_Status is
+     (
+      --  No error.
+      Status_Ok,
+
+      --  Cannot open file.
+      Status_Open_Failure,
+
+      Status_Bad_File,
+      Status_Memory,
+      Status_Read_Error,
+      Status_Bad_Magic,
+      Status_Bad_Class
+      );
+
+   procedure Open_File (File : out Elf_File; Filename : String);
+
+   function Get_Status (File : Elf_File) return Elf_File_Status;
+
+   type Elf_Ehdr_Acc is access all Elf_Ehdr;
+
+   function Get_Ehdr (File : Elf_File) return Elf_Ehdr_Acc;
+
+   procedure Load_Shdr (File : in out Elf_File);
+
+   type Elf_Shdr_Acc is access all Elf_Shdr;
+
+   function Get_Shdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Shdr_Acc;
+
+   function Get_Shdr_Type_Name (Stype : Elf_Word) return String;
+
+   procedure Load_Phdr (File : in out Elf_File);
+
+   type Elf_Phdr_Acc is access all Elf_Phdr;
+
+   function Get_Phdr (File : Elf_File; Index : Elf_Half)
+                     return Elf_Phdr_Acc;
+
+   function Get_Segment_Base (File : Elf_File; Index : Elf_Half)
+                             return Address;
+
+   function Get_Sh_Strtab (File : Elf_File) return Strtab_Type;
+
+   procedure Disp_Sym (File : Elf_File;
+                       Sym : Elf_Sym;
+                       Strtab : Strtab_Type);
+
+   procedure Disp_Symtab (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Strtab (File : Elf_File; Index : Elf_Half);
+
+   function Get_Section_Name (File : Elf_File; Index : Elf_Half)
+                             return String;
+
+   function Get_Section_By_Name (File : Elf_File; Name : String)
+                                return Elf_Half;
+
+   procedure Disp_Debug_Abbrev (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Info (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Pubnames (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Aranges (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Line (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Debug_Frame (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Eh_Frame_Hdr (File : Elf_File; Index : Elf_Half);
+
+   procedure Disp_Phdr (Phdr : Elf_Phdr);
+
+   procedure Disp_Segment_Note (File : Elf_File; Index : Elf_Half);
+   procedure Disp_Section_Note (File : Elf_File; Index : Elf_Half);
+
+   procedure Disp_Dynamic (File : Elf_File; Index : Elf_Half);
+private
+   use System;
+
+   function To_Strtab_Fat_Acc is new Ada.Unchecked_Conversion
+     (Address, Strtab_Fat_Acc);
+
+   type String_Acc is access String;
+
+   function To_Elf_Ehdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Ehdr_Acc);
+
+   function To_Elf_Phdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Phdr_Acc);
+
+   function To_Elf_Shdr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Shdr_Acc);
+
+   type Elf_Sym_Acc is access all Elf_Sym;
+   function To_Elf_Sym_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Sym_Acc);
+
+   type Elf_Shdr_Arr is array (Elf_Half) of Elf_Shdr;
+
+   type Elf_Shdr_Arr_Acc is access all Elf_Shdr_Arr;
+   function To_Elf_Shdr_Arr_Acc is new Ada.Unchecked_Conversion
+     (Address, Elf_Shdr_Arr_Acc);
+
+   type Elf_File is record
+      --  Name of the file.
+      Filename : String_Acc;
+
+      --  Status, used to report errors.
+      Status : Elf_File_Status;
+
+      --  Length of the file.
+      Length : Elf_Off;
+
+      --  File contents.
+      Base : Address;
+
+      Ehdr : Elf_Ehdr_Acc;
+
+      Shdr_Base : Address;
+      Sh_Strtab : Strtab_Type;
+
+      Phdr_Base : Address;
+   end record;
+end Elfdumper;
diff --git a/src/ortho/mcode/hex_images.adb b/src/ortho/mcode/hex_images.adb
new file mode 100644
index 000000000..a9dca324d
--- /dev/null
+++ b/src/ortho/mcode/hex_images.adb
@@ -0,0 +1,71 @@
+--  To hexadecimal conversions.
+--  Copyright (C) 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 Ada.Unchecked_Conversion;
+
+package body Hex_Images is
+   type Hex_Str_Type is array (0 .. 15) of Character;
+   Hexdigits : constant Hex_Str_Type := "0123456789abcdef";
+
+   function Hex_Image (B : Unsigned_8) return String is
+      Res : String (1 .. 2);
+   begin
+      for I in 1 .. 2 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (B, 8 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Conv is new Ada.Unchecked_Conversion
+     (Source => Integer_32, Target => Unsigned_32);
+
+   function Hex_Image (W : Unsigned_32) return String is
+      Res : String (1 .. 8);
+   begin
+      for I in 1 .. 8 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 32 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Unsigned_64) return String is
+      Res : String (1 .. 16);
+   begin
+      for I in 1 .. 16 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 64 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Unsigned_16) return String is
+      Res : String (1 .. 4);
+   begin
+      for I in 1 .. 4 loop
+         Res (I) := Hexdigits
+           (Natural (Shift_Right (W, 16 - 4 * I) and 16#0f#));
+      end loop;
+      return Res;
+   end Hex_Image;
+
+   function Hex_Image (W : Integer_32) return String is
+   begin
+      return Hex_Image (Conv (W));
+   end Hex_Image;
+end Hex_Images;
diff --git a/src/ortho/mcode/hex_images.ads b/src/ortho/mcode/hex_images.ads
new file mode 100644
index 000000000..830d2ec43
--- /dev/null
+++ b/src/ortho/mcode/hex_images.ads
@@ -0,0 +1,26 @@
+--  To hexadecimal conversions.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Hex_Images is
+   function Hex_Image (W : Integer_32) return String;
+   function Hex_Image (W : Unsigned_32) return String;
+   function Hex_Image (B : Unsigned_8) return String;
+   function Hex_Image (W : Unsigned_16) return String;
+   function Hex_Image (W : Unsigned_64) return String;
+end Hex_Images;
diff --git a/src/ortho/mcode/memsegs.ads b/src/ortho/mcode/memsegs.ads
new file mode 100644
index 000000000..ff7f8947e
--- /dev/null
+++ b/src/ortho/mcode/memsegs.ads
@@ -0,0 +1,3 @@
+with Memsegs_Mmap;
+package Memsegs renames Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/memsegs_c.c b/src/ortho/mcode/memsegs_c.c
new file mode 100644
index 000000000..f0a0e27d5
--- /dev/null
+++ b/src/ortho/mcode/memsegs_c.c
@@ -0,0 +1,133 @@
+/*  Memory segment handling.
+    Copyright (C) 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.
+*/
+#ifndef WINNT
+
+#define _GNU_SOURCE
+#include <sys/mman.h>
+#include <stddef.h>
+/* #include <stdio.h> */
+
+/* TODO: init (get pagesize)
+    round size,
+   set rights.
+*/
+
+#ifdef __APPLE__
+#define MAP_ANONYMOUS MAP_ANON
+#else
+#define HAVE_MREMAP
+#endif
+
+#ifndef HAVE_MREMAP
+#include <string.h>
+#endif
+
+void *
+mmap_malloc (int size)
+{
+  void *res;
+  res = mmap (NULL, size, PROT_READ | PROT_WRITE,
+	      MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+  /* printf ("mmap (%d) = %p\n", size, res); */
+  if (res == MAP_FAILED)
+    return NULL;
+  return res;
+}
+
+void *
+mmap_realloc (void *ptr, int old_size, int size)
+{
+  void *res;
+#ifdef HAVE_MREMAP
+  res = mremap (ptr, old_size, size, MREMAP_MAYMOVE);
+#else
+  res = mmap (NULL, size, PROT_READ | PROT_WRITE,
+	      MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+  if (res == MAP_FAILED)
+    return NULL;
+  memcpy (res, ptr, old_size);
+  munmap (ptr, old_size);
+#endif
+  /* printf ("mremap (%p, %d, %d) = %p\n", ptr, old_size, size, res); */
+#if 0
+  if (res == MAP_FAILED)
+    return NULL;
+#endif
+  return res;
+}
+
+void
+mmap_free (void * ptr, int size)
+{
+  munmap (ptr, size);
+}
+
+void
+mmap_rx (void *ptr, int size)
+{
+  mprotect (ptr, size, PROT_READ | PROT_EXEC);
+}
+
+#else
+#include <windows.h>
+
+void *
+mmap_malloc (int size)
+{
+  void *res;
+  res = VirtualAlloc (NULL, size, 
+		      MEM_COMMIT | MEM_RESERVE,
+		      PAGE_READWRITE);
+  return res;
+}
+
+void *
+mmap_realloc (void *ptr, int old_size, int size)
+{
+  void *res;
+
+  res = VirtualAlloc (NULL, size, 
+		      MEM_COMMIT | MEM_RESERVE,
+		      PAGE_READWRITE);
+
+  if (ptr != NULL)
+    {
+      CopyMemory (res, ptr, size > old_size ? old_size : size);
+      VirtualFree (ptr, old_size, MEM_RELEASE);
+    }
+
+  return res;
+}
+
+void
+mmap_free (void * ptr, int size)
+{
+  VirtualFree (ptr, size, MEM_RELEASE);
+}
+
+void
+mmap_rx (void *ptr, int size)
+{
+  DWORD old;
+
+  /* This is not supported on every version.
+     In case of failure, this should still work.  */
+  VirtualProtect (ptr, size,  PAGE_EXECUTE_READ, &old);
+}
+#endif
diff --git a/src/ortho/mcode/memsegs_mmap.adb b/src/ortho/mcode/memsegs_mmap.adb
new file mode 100644
index 000000000..1ee8e7bcf
--- /dev/null
+++ b/src/ortho/mcode/memsegs_mmap.adb
@@ -0,0 +1,64 @@
+--  Memory segments.
+--  Copyright (C) 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.
+package body Memsegs_Mmap is
+   function Mmap_Malloc (Size : Natural) return Address;
+   pragma Import (C, Mmap_Malloc, "mmap_malloc");
+
+   function Mmap_Realloc (Ptr : Address; Old_Size : Natural; Size : Natural)
+                         return Address;
+   pragma Import (C, Mmap_Realloc, "mmap_realloc");
+
+   procedure Mmap_Free (Ptr : Address; Size : Natural);
+   pragma Import (C, Mmap_Free, "mmap_free");
+
+   procedure Mmap_Rx (Ptr : Address; Size : Natural);
+   pragma Import (C, Mmap_Rx, "mmap_rx");
+
+   function Create return Memseg_Type is
+   begin
+      return (Base => Null_Address, Size => 0);
+   end Create;
+
+   procedure Resize (Seg : in out Memseg_Type; Size : Natural) is
+   begin
+      if Seg.Size = 0 then
+         Seg.Base := Mmap_Malloc (Size);
+      else
+         Seg.Base := Mmap_Realloc (Seg.Base, Seg.Size, Size);
+      end if;
+      Seg.Size := Size;
+   end Resize;
+
+   function Get_Address (Seg : Memseg_Type) return Address is
+   begin
+      return Seg.Base;
+   end Get_Address;
+
+   procedure Delete (Seg : in out Memseg_Type) is
+   begin
+      Mmap_Free (Seg.Base, Seg.Size);
+      Seg.Base := Null_Address;
+      Seg.Size := 0;
+   end Delete;
+
+   procedure Set_Rx (Seg : in out Memseg_Type) is
+   begin
+      Mmap_Rx (Seg.Base, Seg.Size);
+   end Set_Rx;
+end Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/memsegs_mmap.ads b/src/ortho/mcode/memsegs_mmap.ads
new file mode 100644
index 000000000..ba7d76618
--- /dev/null
+++ b/src/ortho/mcode/memsegs_mmap.ads
@@ -0,0 +1,49 @@
+--  Memory segments.
+--  Copyright (C) 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; use System;
+
+package Memsegs_Mmap is
+   --  A memseg is a growable memory space.  It can be resized with Resize.
+   --  After each operation the base address can change and must be get
+   --  with Get_Address.
+   type Memseg_Type is private;
+
+   --  Create a new memseg.
+   function Create return Memseg_Type;
+
+   --  Resize the memseg.
+   procedure Resize (Seg : in out Memseg_Type; Size : Natural);
+
+   --  Get the base address.
+   function Get_Address (Seg : Memseg_Type) return Address;
+
+   --  Free all the memory and initialize the memseg.
+   procedure Delete (Seg : in out Memseg_Type);
+
+   --  Set the protection to read+execute.
+   procedure Set_Rx (Seg : in out Memseg_Type);
+
+   pragma Inline (Create);
+   pragma Inline (Get_Address);
+private
+   type Memseg_Type is record
+      Base : Address := Null_Address;
+      Size : Natural := 0;
+   end record;
+end Memsegs_Mmap;
+
diff --git a/src/ortho/mcode/ortho_code-abi.ads b/src/ortho/mcode/ortho_code-abi.ads
new file mode 100644
index 000000000..e75b08509
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-abi.ads
@@ -0,0 +1,3 @@
+with Ortho_Code.X86.Abi;
+
+package Ortho_Code.Abi renames Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-binary.adb b/src/ortho/mcode/ortho_code-binary.adb
new file mode 100644
index 000000000..7bb6bdd28
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-binary.adb
@@ -0,0 +1,37 @@
+--  Interface with binary writer for mcode.
+--  Copyright (C) 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 Ortho_Code.Decls;
+with Ortho_Code.Exprs;
+
+package body Ortho_Code.Binary is
+   function Get_Decl_Symbol (Decl : O_Dnode) return Symbol
+   is
+   begin
+      return To_Symbol (Decls.Get_Decl_Info (Decl));
+   end Get_Decl_Symbol;
+
+   function Get_Label_Symbol (Label : O_Enode) return Symbol is
+   begin
+      return To_Symbol (Exprs.Get_Label_Info (Label));
+   end Get_Label_Symbol;
+
+   procedure Set_Label_Symbol (Label : O_Enode; Sym : Symbol) is
+   begin
+      Exprs.Set_Label_Info (Label, To_Int32 (Sym));
+   end Set_Label_Symbol;
+end Ortho_Code.Binary;
diff --git a/src/ortho/mcode/ortho_code-binary.ads b/src/ortho/mcode/ortho_code-binary.ads
new file mode 100644
index 000000000..58c79d3b2
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-binary.ads
@@ -0,0 +1,31 @@
+--  Interface with binary writer for mcode.
+--  Copyright (C) 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 Binary_File; use Binary_File;
+
+package Ortho_Code.Binary is
+   function To_Symbol is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Symbol);
+
+   function To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Symbol, Target => Int32);
+
+   function Get_Decl_Symbol (Decl : O_Dnode) return Symbol;
+   function Get_Label_Symbol (Label : O_Enode) return Symbol;
+   procedure Set_Label_Symbol (Label : O_Enode; Sym : Symbol);
+end Ortho_Code.Binary;
+
diff --git a/src/ortho/mcode/ortho_code-consts.adb b/src/ortho/mcode/ortho_code-consts.adb
new file mode 100644
index 000000000..d09a13c34
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-consts.adb
@@ -0,0 +1,559 @@
+--  Mcode back-end for ortho - Constants handling.
+--  Copyright (C) 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 Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Ada.Text_IO;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Debug;
+
+package body Ortho_Code.Consts is
+   type Cnode_Common is record
+      Kind : OC_Kind;
+      Lit_Type : O_Tnode;
+   end record;
+   for Cnode_Common use record
+      Kind at 0 range 0 .. 31;
+      Lit_Type at 4 range 0 .. 31;
+   end record;
+   for Cnode_Common'Size use 64;
+
+   type Cnode_Signed is record
+      Val : Integer_64;
+   end record;
+   for Cnode_Signed'Size use 64;
+
+   type Cnode_Unsigned is record
+      Val : Unsigned_64;
+   end record;
+   for Cnode_Unsigned'Size use 64;
+
+   type Cnode_Float is record
+      Val : IEEE_Float_64;
+   end record;
+   for Cnode_Float'Size use 64;
+
+   type Cnode_Enum is record
+      Id : O_Ident;
+      Val : Uns32;
+   end record;
+   for Cnode_Enum'Size use 64;
+
+   type Cnode_Addr is record
+      Decl : O_Dnode;
+      Pad : Int32;
+   end record;
+   for Cnode_Addr'Size use 64;
+
+   type Cnode_Aggr is record
+      Els : Int32;
+      Nbr : Int32;
+   end record;
+   for Cnode_Aggr'Size use 64;
+
+   type Cnode_Sizeof is record
+      Atype : O_Tnode;
+      Pad : Int32;
+   end record;
+   for Cnode_Sizeof'Size use 64;
+
+   type Cnode_Union is record
+      El : O_Cnode;
+      Field : O_Fnode;
+   end record;
+   for Cnode_Union'Size use 64;
+
+   package Cnodes is new GNAT.Table
+     (Table_Component_Type => Cnode_Common,
+      Table_Index_Type => O_Cnode,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Const_Kind (Cst : O_Cnode) return OC_Kind is
+   begin
+      return Cnodes.Table (Cst).Kind;
+   end Get_Const_Kind;
+
+   function Get_Const_Type (Cst : O_Cnode) return O_Tnode is
+   begin
+      return Cnodes.Table (Cst).Lit_Type;
+   end Get_Const_Type;
+
+   function Get_Const_U64 (Cst : O_Cnode) return Unsigned_64
+   is
+      function To_Cnode_Unsigned is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Unsigned);
+   begin
+      return To_Cnode_Unsigned (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_U64;
+
+   function Get_Const_I64 (Cst : O_Cnode) return Integer_64
+   is
+      function To_Cnode_Signed is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Signed);
+   begin
+      return To_Cnode_Signed (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_I64;
+
+   function Get_Const_F64 (Cst : O_Cnode) return IEEE_Float_64
+   is
+      function To_Cnode_Float is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Float);
+   begin
+      return To_Cnode_Float (Cnodes.Table (Cst + 1)).Val;
+   end Get_Const_F64;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Signed, Target => Cnode_Common);
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Signed,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Signed'(Val => Value)));
+      return Res;
+   end New_Signed_Literal;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Unsigned_64, Target => Cnode_Common);
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Unsigned,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Value));
+      return Res;
+   end New_Unsigned_Literal;
+
+--    function Get_Const_Literal (Cst : O_Cnode) return Uns32 is
+--    begin
+--       return Cnodes.Table (Cst).Val;
+--    end Get_Const_Literal;
+
+   function To_Uns64 is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Uns64);
+
+   function Get_Const_U32 (Cst : O_Cnode) return Uns32 is
+   begin
+      return Uns32 (To_Uns64 (Cnodes.Table (Cst + 1)));
+   end Get_Const_U32;
+
+   function Get_Const_R64 (Cst : O_Cnode) return Uns64 is
+   begin
+      return To_Uns64 (Cnodes.Table (Cst + 1));
+   end Get_Const_R64;
+
+   function Get_Const_Low (Cst : O_Cnode) return Uns32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return Uns32 (V and 16#Ffff_Ffff#);
+   end Get_Const_Low;
+
+   function Get_Const_High (Cst : O_Cnode) return Uns32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#);
+   end Get_Const_High;
+
+   function Get_Const_Low (Cst : O_Cnode) return Int32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return To_Int32 (Uns32 (V and 16#Ffff_Ffff#));
+   end Get_Const_Low;
+
+   function Get_Const_High (Cst : O_Cnode) return Int32
+   is
+      V : Uns64;
+   begin
+      V := Get_Const_R64 (Cst);
+      return To_Int32 (Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#));
+   end Get_Const_High;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode
+   is
+      Res : O_Cnode;
+
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Float, Target => Cnode_Common);
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Float,
+                                   Lit_Type => Ltype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Float'(Val => Value)));
+      return Res;
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Null,
+                                   Lit_Type => Ltype));
+      return Cnodes.Last;
+   end New_Null_Access;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Addr, Target => Cnode_Common);
+
+   function To_Cnode_Addr is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Addr);
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl,
+                                                  Pad => 0)));
+      return Res;
+   end New_Global_Unchecked_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl,
+                                                  Pad => 0)));
+      return Res;
+   end New_Global_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Subprg_Address,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Subprg,
+                                                  Pad => 0)));
+      return Res;
+   end New_Subprogram_Address;
+
+   function Get_Const_Decl (Cst : O_Cnode) return O_Dnode is
+   begin
+      return To_Cnode_Addr (Cnodes.Table (Cst + 1)).Decl;
+   end Get_Const_Decl;
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Enum, Target => Cnode_Common);
+
+   function To_Cnode_Enum is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Enum);
+
+   --function Get_Named_Literal_Id (Lit : O_Cnode) return O_Ident is
+   --begin
+   --   return To_Cnode_Enum (Cnodes.Table (Lit + 1)).Id;
+   --end Get_Named_Literal_Id;
+
+   function New_Named_Literal
+     (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode)
+     return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Cnodes.Append (Cnode_Common'(Kind => OC_Lit,
+                                   Lit_Type => Atype));
+      Res := Cnodes.Last;
+      Cnodes.Append (To_Cnode_Common (Cnode_Enum'(Id => Id,
+                                                  Val => Val)));
+      if Prev /= O_Cnode_Null then
+         if Prev + 2 /= Res then
+            raise Syntax_Error;
+         end if;
+      end if;
+      return Res;
+   end New_Named_Literal;
+
+   function Get_Lit_Ident (L : O_Cnode) return O_Ident is
+   begin
+      return To_Cnode_Enum (Cnodes.Table (L + 1)).Id;
+   end Get_Lit_Ident;
+
+   function Get_Lit_Value (L : O_Cnode) return Uns32 is
+   begin
+      return To_Cnode_Enum (Cnodes.Table (L + 1)).Val;
+   end Get_Lit_Value;
+
+   function Get_Lit_Chain (L : O_Cnode) return O_Cnode is
+   begin
+      return L + 2;
+   end Get_Lit_Chain;
+
+   package Els is new GNAT.Table
+     (Table_Component_Type => O_Cnode,
+      Table_Index_Type => Int32,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function To_Cnode_Common is new Ada.Unchecked_Conversion
+     (Source => Cnode_Aggr, Target => Cnode_Common);
+
+   function To_Cnode_Aggr is new Ada.Unchecked_Conversion
+     (Source => Cnode_Common, Target => Cnode_Aggr);
+
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode)
+   is
+      Val : Int32;
+      Num : Uns32;
+   begin
+      Num := Get_Type_Record_Nbr_Fields (Atype);
+      Val := Els.Allocate (Integer (Num));
+
+      Cnodes.Append (Cnode_Common'(Kind => OC_Record,
+                                   Lit_Type => Atype));
+      List := (Res => Cnodes.Last,
+               Rec_Field => Get_Type_Record_Fields (Atype),
+               El => Val);
+      Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val,
+                                                  Nbr => Int32 (Num))));
+   end Start_Record_Aggr;
+
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode)
+   is
+   begin
+      Els.Table (List.El) := Value;
+      List.El := List.El + 1;
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode) is
+   begin
+      Res := List.Res;
+   end Finish_Record_Aggr;
+
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+      Val : Int32;
+      Num : Uns32;
+   begin
+      Num := Get_Type_Subarray_Length (Atype);
+      Val := Els.Allocate (Integer (Num));
+
+      Cnodes.Append (Cnode_Common'(Kind => OC_Array,
+                                   Lit_Type => Atype));
+      List := (Res => Cnodes.Last,
+               El => Val);
+      Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val,
+                                                  Nbr => Int32 (Num))));
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode)
+   is
+   begin
+      Els.Table (List.El) := Value;
+      List.El := List.El + 1;
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode)
+   is
+   begin
+      Res := List.Res;
+   end Finish_Array_Aggr;
+
+   function Get_Const_Aggr_Length (Cst : O_Cnode) return Int32 is
+   begin
+      return To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Nbr;
+   end Get_Const_Aggr_Length;
+
+   function Get_Const_Aggr_Element (Cst : O_Cnode; N : Int32) return O_Cnode
+   is
+      El : Int32;
+   begin
+      El := To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Els;
+      return Els.Table (El + N);
+   end Get_Const_Aggr_Element;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Union, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Union,
+                                      Lit_Type => Atype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Union'(El => Value,
+                                                      Field => Field)));
+         return Res;
+      else
+         return Value;
+      end if;
+   end New_Union_Aggr;
+
+   function To_Cnode_Union is new Ada.Unchecked_Conversion
+        (Source => Cnode_Common, Target => Cnode_Union);
+
+   function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode is
+   begin
+      return To_Cnode_Union (Cnodes.Table (Cst + 1)).Field;
+   end Get_Const_Union_Field;
+
+   function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode is
+   begin
+      return To_Cnode_Union (Cnodes.Table (Cst + 1)).El;
+   end Get_Const_Union_Value;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Sizeof, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Sizeof,
+                                      Lit_Type => Rtype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype,
+                                                       Pad => 0)));
+         return Res;
+      else
+         return New_Unsigned_Literal
+           (Rtype, Unsigned_64 (Get_Type_Size (Atype)));
+      end if;
+   end New_Sizeof;
+
+   function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode
+   is
+      function To_Cnode_Sizeof is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Sizeof);
+   begin
+      return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
+   end Get_Sizeof_Type;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Sizeof, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Alignof,
+                                      Lit_Type => Rtype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype,
+                                                       Pad => 0)));
+         return Res;
+      else
+         return New_Unsigned_Literal
+           (Rtype, Unsigned_64 (Get_Type_Align_Bytes (Atype)));
+      end if;
+   end New_Alignof;
+
+   function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode
+   is
+      function To_Cnode_Sizeof is new Ada.Unchecked_Conversion
+        (Cnode_Common, Cnode_Sizeof);
+   begin
+      return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
+   end Get_Alignof_Type;
+
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      if Get_Field_Parent (Field) /= Rec_Type then
+         raise Syntax_Error;
+      end if;
+      return New_Unsigned_Literal
+        (Rtype, Unsigned_64 (Get_Field_Offset (Field)));
+   end New_Offsetof;
+
+   procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32) is
+   begin
+      case Get_Const_Kind (Cst) is
+         when OC_Signed
+           | OC_Unsigned
+           | OC_Float =>
+            H := Get_Const_High (Cst);
+            L := Get_Const_Low (Cst);
+         when OC_Null =>
+            H := 0;
+            L := 0;
+         when OC_Lit =>
+            H := 0;
+            L := To_Cnode_Enum (Cnodes.Table (Cst + 1)).Val;
+         when OC_Array
+           | OC_Record
+           | OC_Union
+           | OC_Sizeof
+           | OC_Alignof
+           | OC_Address
+           | OC_Subprg_Address =>
+            raise Syntax_Error;
+      end case;
+   end Get_Const_Bytes;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Cnode := Cnodes.Last;
+      M.Els := Els.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Cnodes.Set_Last (M.Cnode);
+      Els.Set_Last (M.Els);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Cnodes: " & O_Cnode'Image (Cnodes.Last));
+      Put_Line ("Number of Cnodes-Els: " & Int32'Image (Els.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Cnodes.Free;
+      Els.Free;
+   end Finish;
+end Ortho_Code.Consts;
diff --git a/src/ortho/mcode/ortho_code-consts.ads b/src/ortho/mcode/ortho_code-consts.ads
new file mode 100644
index 000000000..0076bc6eb
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-consts.ads
@@ -0,0 +1,158 @@
+--  Mcode back-end for ortho - Constants handling.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Ortho_Code.Consts is
+   type OC_Kind is (OC_Signed, OC_Unsigned, OC_Float, OC_Lit, OC_Null,
+                    OC_Array, OC_Record, OC_Union,
+                    OC_Subprg_Address, OC_Address,
+                    OC_Sizeof, OC_Alignof);
+
+   function Get_Const_Kind (Cst : O_Cnode) return OC_Kind;
+
+   function Get_Const_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get bytes for signed, unsigned, float, lit, null.
+   procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32);
+
+   --  Used to set the length of a constrained type.
+   --  FIXME: check for no overflow.
+   function Get_Const_U32 (Cst : O_Cnode) return Uns32;
+
+   function Get_Const_U64 (Cst : O_Cnode) return Unsigned_64;
+   function Get_Const_I64 (Cst : O_Cnode) return Integer_64;
+
+   function Get_Const_F64 (Cst : O_Cnode) return IEEE_Float_64;
+
+   --  Get the low and high part of a constant.
+   function Get_Const_Low (Cst : O_Cnode) return Uns32;
+   function Get_Const_High (Cst : O_Cnode) return Uns32;
+
+   function Get_Const_Low (Cst : O_Cnode) return Int32;
+   function Get_Const_High (Cst : O_Cnode) return Int32;
+
+   function Get_Const_Aggr_Length (Cst : O_Cnode) return Int32;
+   function Get_Const_Aggr_Element (Cst : O_Cnode; N : Int32) return O_Cnode;
+
+   --  Only available in HLI.
+   function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode;
+   function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode;
+
+   --  Declaration for an address.
+   function Get_Const_Decl (Cst : O_Cnode) return O_Dnode;
+
+   --  Get the type from an OC_Sizeof node.
+   function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get the type from an OC_Alignof node.
+   function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode;
+
+   --  Get the value of a named literal.
+   --function Get_Const_Literal (Cst : O_Cnode) return Uns32;
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode;
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode;
+
+   function New_Named_Literal
+     (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode)
+     return O_Cnode;
+
+   --  For boolean/enum literals.
+   function Get_Lit_Ident (L : O_Cnode) return O_Ident;
+   function Get_Lit_Chain (L : O_Cnode) return O_Cnode;
+   function Get_Lit_Value (L : O_Cnode) return Uns32;
+
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record REC_TYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Array_Aggr_List is record
+      Res : O_Cnode;
+      El : Int32;
+   end record;
+
+   type O_Record_Aggr_List is record
+      Res : O_Cnode;
+      Rec_Field : O_Fnode;
+      El : Int32;
+   end record;
+
+   type Mark_Type is record
+      Cnode : O_Cnode;
+      Els : Int32;
+   end record;
+
+end Ortho_Code.Consts;
diff --git a/src/ortho/mcode/ortho_code-debug.adb b/src/ortho/mcode/ortho_code-debug.adb
new file mode 100644
index 000000000..0f3e01ab9
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-debug.adb
@@ -0,0 +1,143 @@
+--  Mcode back-end for ortho - Internal debugging.
+--  Copyright (C) 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 Ortho_Code.Flags;
+
+package body Ortho_Code.Debug is
+   procedure Disp_Mode (M : Mode_Type)
+   is
+      use Ada.Text_IO;
+   begin
+      case M is
+         when Mode_U8 =>
+            Put ("U8 ");
+         when Mode_U16 =>
+            Put ("U16");
+         when Mode_U32 =>
+            Put ("U32");
+         when Mode_U64 =>
+            Put ("U64");
+         when Mode_I8 =>
+            Put ("I8 ");
+         when Mode_I16 =>
+            Put ("I16");
+         when Mode_I32 =>
+            Put ("I32");
+         when Mode_I64 =>
+            Put ("I64");
+         when Mode_X1 =>
+            Put ("xxx");
+         when Mode_Nil =>
+            Put ("Nil");
+         when Mode_F32 =>
+            Put ("F32");
+         when Mode_F64 =>
+            Put ("F64");
+         when Mode_B2 =>
+            Put ("B2 ");
+         when Mode_Blk =>
+            Put ("Blk");
+         when Mode_P32 =>
+            Put ("P32");
+         when Mode_P64 =>
+            Put ("P64");
+      end case;
+   end Disp_Mode;
+
+   procedure Set_Debug_Be_Flag (C : Character)
+   is
+      use Ada.Text_IO;
+   begin
+      case C is
+         when 'a' =>
+            Flag_Debug_Asm := True;
+         when 'b' =>
+            Flag_Debug_Body := True;
+         when 'B' =>
+            Flag_Debug_Body2 := True;
+         when 'c' =>
+            Flag_Debug_Code := True;
+         when 'C' =>
+            Flag_Debug_Code2 := True;
+         when 'd' =>
+            Flag_Debug_Dump := True;
+         when 'h' =>
+            Flag_Debug_Hex := True;
+         when 'H' =>
+            Flag_Debug_Hli := True;
+         when 'i' =>
+            Flag_Debug_Insn := True;
+         when 's' =>
+            Flag_Debug_Stat := True;
+         when 'k' =>
+            Flag_Debug_Keep := True;
+         when 't' =>
+            Flags.Flag_Type_Name := True;
+         when others =>
+            Put_Line (Standard_Error, "unknown debug be flag '" & C & "'");
+      end case;
+   end Set_Debug_Be_Flag;
+
+   procedure Set_Be_Flag (Str : String)
+   is
+      use Ada.Text_IO;
+
+      subtype Str_Type is String (1 .. Str'Length);
+      S : Str_Type renames Str;
+   begin
+      if S'Length > 11 and then S (1 .. 11) = "--be-debug=" then
+         for I in 12 .. S'Last loop
+            Set_Debug_Be_Flag (S (I));
+         end loop;
+      elsif S'Length > 10 and then S (1 .. 10) = "--be-dump=" then
+         for I in 11 .. S'Last loop
+            case S (I) is
+               when 'c' =>
+                  Flag_Dump_Code := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end dump flag '" & S (I) & "'");
+            end case;
+         end loop;
+      elsif S'Length > 10 and then S (1 .. 10) = "--be-disp=" then
+         for I in 11 .. S'Last loop
+            case S (I) is
+               when 'c' =>
+                  Flag_Disp_Code := True;
+                  Flags.Flag_Type_Name := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end disp flag '" & S (I) & "'");
+            end case;
+         end loop;
+      elsif S'Length > 9 and then S (1 .. 9) = "--be-opt=" then
+         for I in 10 .. S'Last loop
+            case S (I) is
+               when 'O' =>
+                  Flags.Flag_Optimize := True;
+               when 'b' =>
+                  Flags.Flag_Opt_BB := True;
+               when others =>
+                  Put_Line (Standard_Error,
+                            "unknown back-end opt flag '" & S (I) & "'");
+            end case;
+         end loop;
+      else
+         Put_Line (Standard_Error, "unknown back-end option " & Str);
+      end if;
+   end Set_Be_Flag;
+end Ortho_Code.Debug;
diff --git a/src/ortho/mcode/ortho_code-debug.ads b/src/ortho/mcode/ortho_code-debug.ads
new file mode 100644
index 000000000..03f550ac9
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-debug.ads
@@ -0,0 +1,70 @@
+--  Mcode back-end for ortho - Internal debugging.
+--  Copyright (C) 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 Ada.Text_IO;
+
+package Ortho_Code.Debug is
+   package Int32_IO is new Ada.Text_IO.Integer_IO (Ortho_Code.Int32);
+
+   procedure Disp_Mode (M : Mode_Type);
+
+   --  Set a debug flag.
+   procedure Set_Debug_Be_Flag (C : Character);
+
+   --  any '--be-XXX=YY' option.
+   procedure Set_Be_Flag (Str : String);
+
+   --  c: tree created, before any back-end.
+   Flag_Disp_Code : Boolean := False;
+   Flag_Dump_Code : Boolean := False;
+
+   --  a: disp assembly code.
+   Flag_Debug_Asm : Boolean := False;
+
+   --  A: do internal checks (assertions).
+   Flag_Debug_Assert : Boolean := True;
+
+   --  b: disp top-level subprogram body before code generation.
+   Flag_Debug_Body : Boolean := False;
+
+   --  B: disp top-level subprogram body after code generation.
+   Flag_Debug_Body2 : Boolean := False;
+
+   --  c: display generated code.
+   Flag_Debug_Code : Boolean := False;
+
+   --  C: display generated code just before asm.
+   Flag_Debug_Code2 : Boolean := False;
+
+   --  h: disp bytes generated (in hexa).
+   Flag_Debug_Hex : Boolean := False;
+
+   --  H: generate high-level instructions.
+   Flag_Debug_Hli : Boolean := False;
+
+   --  r: raw dump, do not generate code.
+   Flag_Debug_Dump : Boolean := False;
+
+   --  i: disp insns, when generated.
+   Flag_Debug_Insn : Boolean := False;
+
+   --  s: disp stats (number of nodes).
+   Flag_Debug_Stat : Boolean := False;
+
+   --  k: keep all nodes in memory (do not free).
+   Flag_Debug_Keep: Boolean := False;
+end Ortho_Code.Debug;
diff --git a/src/ortho/mcode/ortho_code-decls.adb b/src/ortho/mcode/ortho_code-decls.adb
new file mode 100644
index 000000000..fcbf0b0de
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-decls.adb
@@ -0,0 +1,783 @@
+--  Mcode back-end for ortho - Declarations handling.
+--  Copyright (C) 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 GNAT.Table;
+with Ada.Text_IO;
+with Ortho_Ident;
+with Ortho_Code.Debug; use Ortho_Code.Debug;
+with Ortho_Code.Exprs;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Decls is
+   --  Common fields:
+   --    kind: 4 bits
+   --    storage: 2 bits
+   --    reg : 8 bits
+   --    depth : 16 bits
+   --    flags: addr + 9
+   --  Additionnal fields:
+   --    OD_Type: Id, dtype
+   --    OD_Var: Id, Dtype, symbol
+   --    OD_Local: Id, Dtype, offset/reg
+   --    OD_Const: Id, Dtype, Val, Symbol?
+   --    OD_Function: Id, Dtype [interfaces follows], Symbol
+   --    OD_Procedure: Id [interfaces follows], Symbol
+   --    OD_Interface: Id, Dtype, offset/reg
+   --    OD_Begin: Last
+   --    OD_Body: Decl, Stmt, Parent
+   type Dnode_Common (Kind : OD_Kind := OD_Type) is record
+      Storage : O_Storage;
+
+      --  True if the address of the declaration is taken.
+      Flag_Addr : Boolean;
+
+      Flag2 : Boolean;
+
+      Reg : O_Reg;
+
+      --  Depth of the declaration.
+      Depth : O_Depth;
+
+      case Kind is
+         when OD_Type
+           | OD_Const
+           | OD_Var
+           | OD_Local
+           | OD_Function
+           | OD_Procedure
+           | OD_Interface =>
+            --  Identifier of this declaration.
+            Id : O_Ident;
+            --  Type of this declaration.
+            Dtype : O_Tnode;
+            --  Symbol or offset.
+            Ref : Int32;
+            --  For const: the value.
+            --  For subprg: size of pushed arguments.
+            Info2 : Int32;
+         when OD_Subprg_Ext =>
+            --  Chain of interfaces.
+            Subprg_Inter : O_Dnode;
+
+         when OD_Block =>
+            --  Last declaration of this block.
+            Last : O_Dnode;
+            --  Max stack offset.
+            Block_Max_Stack : Uns32;
+            --  Infos: may be used to store symbols.
+            Block_Info1 : Int32;
+            Block_Info2 : Int32;
+         when OD_Body =>
+            --  Corresponding declaration (function/procedure).
+            Body_Decl : O_Dnode;
+            --  Entry statement for this body.
+            Body_Stmt : O_Enode;
+            --  Parent (as a body) of this body or null if at top level.
+            Body_Parent : O_Dnode;
+            Body_Info : Int32;
+         when OD_Const_Val =>
+            --  Corresponding declaration.
+            Val_Decl : O_Dnode;
+            --  Value.
+            Val_Val : O_Cnode;
+      end case;
+   end record;
+
+   Use_Subprg_Ext : constant Boolean := False;
+
+   pragma Pack (Dnode_Common);
+
+   package Dnodes is new GNAT.Table
+     (Table_Component_Type => Dnode_Common,
+      Table_Index_Type => O_Dnode,
+      Table_Low_Bound => O_Dnode_First,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package TDnodes is new GNAT.Table
+     (Table_Component_Type => O_Dnode,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 1,
+      Table_Increment => 100);
+
+   Context : O_Dnode := O_Dnode_Null;
+
+   function Get_Decl_Type (Decl : O_Dnode) return O_Tnode is
+   begin
+      return Dnodes.Table (Decl).Dtype;
+   end Get_Decl_Type;
+
+   function Get_Decl_Kind (Decl : O_Dnode) return OD_Kind is
+   begin
+      return Dnodes.Table (Decl).Kind;
+   end Get_Decl_Kind;
+
+   function Get_Decl_Storage (Decl : O_Dnode) return O_Storage is
+   begin
+      return Dnodes.Table (Decl).Storage;
+   end Get_Decl_Storage;
+
+   procedure Set_Decl_Storage (Decl : O_Dnode; Storage : O_Storage) is
+   begin
+      Dnodes.Table (Decl).Storage := Storage;
+   end Set_Decl_Storage;
+
+   function Get_Decl_Reg (Decl : O_Dnode) return O_Reg is
+   begin
+      return Dnodes.Table (Decl).Reg;
+   end Get_Decl_Reg;
+
+   procedure Set_Decl_Reg (Decl : O_Dnode; Reg : O_Reg) is
+   begin
+      Dnodes.Table (Decl).Reg := Reg;
+   end Set_Decl_Reg;
+
+   function Get_Decl_Depth (Decl : O_Dnode) return O_Depth is
+   begin
+      return Dnodes.Table (Decl).Depth;
+   end Get_Decl_Depth;
+
+   function Get_Decl_Chain (Decl : O_Dnode) return O_Dnode is
+   begin
+      case Get_Decl_Kind (Decl) is
+         when OD_Block =>
+            return Get_Block_Last (Decl) + 1;
+         when OD_Body =>
+            return Get_Block_Last (Decl + 1) + 1;
+         when OD_Function
+           | OD_Procedure =>
+            if Use_Subprg_Ext then
+               return Decl + 2;
+            else
+               return Decl + 1;
+            end if;
+         when others =>
+            return Decl + 1;
+      end case;
+   end Get_Decl_Chain;
+
+   function Get_Body_Stmt (Bod : O_Dnode) return O_Enode is
+   begin
+      return Dnodes.Table (Bod).Body_Stmt;
+   end Get_Body_Stmt;
+
+   function Get_Body_Decl (Bod : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Bod).Body_Decl;
+   end Get_Body_Decl;
+
+   function Get_Body_Parent (Bod : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Bod).Body_Parent;
+   end Get_Body_Parent;
+
+   function Get_Body_Info (Bod : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Bod).Body_Info;
+   end Get_Body_Info;
+
+   procedure Set_Body_Info (Bod : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Bod).Body_Info := Info;
+   end Set_Body_Info;
+
+   function Get_Decl_Ident (Decl : O_Dnode) return O_Ident is
+   begin
+      return Dnodes.Table (Decl).Id;
+   end Get_Decl_Ident;
+
+   function Get_Decl_Last return O_Dnode is
+   begin
+      return Dnodes.Last;
+   end Get_Decl_Last;
+
+   function Get_Block_Last (Blk : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Blk).Last;
+   end Get_Block_Last;
+
+   function Get_Block_Max_Stack (Blk : O_Dnode) return Uns32 is
+   begin
+      return Dnodes.Table (Blk).Block_Max_Stack;
+   end Get_Block_Max_Stack;
+
+   procedure Set_Block_Max_Stack (Blk : O_Dnode; Max : Uns32) is
+   begin
+      Dnodes.Table (Blk).Block_Max_Stack := Max;
+   end Set_Block_Max_Stack;
+
+   function Get_Block_Info1 (Blk : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Blk).Block_Info1;
+   end Get_Block_Info1;
+
+   procedure Set_Block_Info1 (Blk : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Blk).Block_Info1 := Info;
+   end Set_Block_Info1;
+
+   function Get_Block_Info2 (Blk : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Blk).Block_Info2;
+   end Get_Block_Info2;
+
+   procedure Set_Block_Info2 (Blk : O_Dnode; Info : Int32) is
+   begin
+      Dnodes.Table (Blk).Block_Info2 := Info;
+   end Set_Block_Info2;
+
+   function Get_Subprg_Interfaces (Decl : O_Dnode) return O_Dnode
+   is
+      Res : O_Dnode;
+   begin
+      if Use_Subprg_Ext then
+         Res := Decl + 2;
+      else
+         Res := Decl + 1;
+      end if;
+
+      if Get_Decl_Kind (Res) = OD_Interface then
+         return Res;
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Subprg_Interfaces;
+
+   function Get_Interface_Chain (Decl : O_Dnode) return O_Dnode
+   is
+      Res : constant O_Dnode := Decl + 1;
+   begin
+      if Get_Decl_Kind (Res) = OD_Interface then
+         return Res;
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Interface_Chain;
+
+   function Get_Val_Decl (Decl : O_Dnode) return O_Dnode is
+   begin
+      return Dnodes.Table (Decl).Val_Decl;
+   end Get_Val_Decl;
+
+   function Get_Val_Val (Decl : O_Dnode) return O_Cnode is
+   begin
+      return Dnodes.Table (Decl).Val_Val;
+   end Get_Val_Val;
+
+   Cur_Depth : O_Depth := O_Toplevel;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Type,
+                                   Storage => O_Storage_Private,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      if Flags.Flag_Type_Name then
+         declare
+            L : O_Tnode;
+         begin
+            L := TDnodes.Last;
+            if Atype > L then
+               TDnodes.Set_Last (Atype);
+               TDnodes.Table (L + 1 .. Atype) := (others => O_Dnode_Null);
+            end if;
+         end;
+         TDnodes.Table (Atype) := Dnodes.Last;
+      end if;
+   end New_Type_Decl;
+
+   function Get_Type_Decl (Atype : O_Tnode) return O_Dnode is
+   begin
+      if Atype <= TDnodes.Last then
+         return TDnodes.Table (Atype);
+      else
+         return O_Dnode_Null;
+      end if;
+   end Get_Type_Decl;
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Const,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      if not Flag_Debug_Hli then
+         Expand_Const_Decl (Res);
+      end if;
+   end New_Const_Decl;
+
+   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is
+   begin
+      if Dnodes.Table (Cst).Info2 /= 0 then
+         --  Value was already set.
+         raise Syntax_Error;
+      end if;
+      Dnodes.Table (Cst).Info2 := Int32 (Val);
+      if Flag_Debug_Hli then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Const_Val,
+                                      Storage => O_Storage_Private,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Val_Decl => Cst,
+                                      Val_Val => Val,
+                                      others => False));
+      else
+         Expand_Const_Value (Cst, Val);
+      end if;
+   end New_Const_Value;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode)
+   is
+   begin
+      if Storage = O_Storage_Local then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Local,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Id => Ident,
+                                      Dtype => Atype,
+                                      Ref => 0,
+                                      Info2 => 0,
+                                      others => False));
+         Res := Dnodes.Last;
+      else
+         Dnodes.Append (Dnode_Common'(Kind => OD_Var,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Id => Ident,
+                                      Dtype => Atype,
+                                      Ref => 0,
+                                      Info2 => 0,
+                                      others => False));
+         Res := Dnodes.Last;
+         if not Flag_Debug_Hli then
+            Expand_Var_Decl (Res);
+         end if;
+      end if;
+   end New_Var_Decl;
+
+   Static_Chain_Id : O_Ident := O_Ident_Nul;
+
+   procedure Add_Static_Chain (Interfaces : in out O_Inter_List)
+   is
+      Res : O_Dnode;
+   begin
+      if Static_Chain_Id = O_Ident_Nul then
+         Static_Chain_Id := Ortho_Ident.Get_Identifier ("STATIC_CHAIN");
+      end if;
+
+      New_Interface_Decl (Interfaces, Res, Static_Chain_Id, O_Tnode_Ptr);
+   end Add_Static_Chain;
+
+   procedure Start_Subprogram_Decl (Interfaces : out O_Inter_List)
+   is
+      Storage : O_Storage;
+      Decl : constant O_Dnode := Dnodes.Last;
+   begin
+      Storage := Get_Decl_Storage (Decl);
+      if Cur_Depth /= O_Toplevel then
+         case Storage is
+            when O_Storage_External
+              | O_Storage_Local =>
+               null;
+            when O_Storage_Public =>
+               raise Syntax_Error;
+            when O_Storage_Private =>
+               Storage := O_Storage_Local;
+               Set_Decl_Storage (Decl, Storage);
+         end case;
+      end if;
+      if Use_Subprg_Ext then
+         Dnodes.Append (Dnode_Common'(Kind => OD_Subprg_Ext,
+                                      Storage => Storage,
+                                      Depth => Cur_Depth,
+                                      Reg => R_Nil,
+                                      Subprg_Inter => O_Dnode_Null,
+                                      others => False));
+      end if;
+
+      Start_Subprogram (Decl, Interfaces.Abi);
+      Interfaces.Decl := Decl;
+      if Storage = O_Storage_Local then
+         Add_Static_Chain (Interfaces);
+      end if;
+   end Start_Subprogram_Decl;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Function,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Rtype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Start_Subprogram_Decl (Interfaces);
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Procedure,
+                                   Storage => Storage,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => O_Tnode_Null,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Start_Subprogram_Decl (Interfaces);
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode)
+   is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Interface,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth + 1,
+                                   Reg => R_Nil,
+                                   Id => Ident,
+                                   Dtype => Atype,
+                                   Ref => 0,
+                                   Info2 => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      New_Interface (Res, Interfaces.Abi);
+   end New_Interface_Decl;
+
+   procedure Set_Local_Offset (Decl : O_Dnode; Off : Int32) is
+   begin
+      Dnodes.Table (Decl).Ref := Off;
+   end Set_Local_Offset;
+
+   function Get_Local_Offset (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Ref;
+   end Get_Local_Offset;
+
+   function Get_Inter_Offset (Inter : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Inter).Ref;
+   end Get_Inter_Offset;
+
+   procedure Set_Decl_Info (Decl : O_Dnode; Ref : Int32) is
+   begin
+      Dnodes.Table (Decl).Ref := Ref;
+   end Set_Decl_Info;
+
+   function Get_Decl_Info (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Ref;
+   end Get_Decl_Info;
+
+   procedure Set_Subprg_Stack (Decl : O_Dnode; Val : Int32) is
+   begin
+      Dnodes.Table (Decl).Info2 := Val;
+   end Set_Subprg_Stack;
+
+   function Get_Subprg_Stack (Decl : O_Dnode) return Int32 is
+   begin
+      return Dnodes.Table (Decl).Info2;
+   end Get_Subprg_Stack;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode) is
+   begin
+      Res := Interfaces.Decl;
+      Finish_Subprogram (Res, Interfaces.Abi);
+   end Finish_Subprogram_Decl;
+
+   Cur_Block : O_Dnode := O_Dnode_Null;
+
+   function Start_Declare_Stmt return O_Dnode is
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Block,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Last => O_Dnode_Null,
+                                   Block_Max_Stack => 0,
+                                   Block_Info1 => 0,
+                                   Block_Info2 => 0,
+                                   others => False));
+      Cur_Block := Dnodes.Last;
+      return Cur_Block;
+   end Start_Declare_Stmt;
+
+   procedure Finish_Declare_Stmt (Parent : O_Dnode) is
+   begin
+      Dnodes.Table (Cur_Block).Last := Dnodes.Last;
+      Cur_Block := Parent;
+   end Finish_Declare_Stmt;
+
+   function Start_Subprogram_Body (Decl : O_Dnode; Stmt : O_Enode)
+                                  return O_Dnode
+   is
+      Res : O_Dnode;
+   begin
+      Dnodes.Append (Dnode_Common'(Kind => OD_Body,
+                                   Storage => O_Storage_Local,
+                                   Depth => Cur_Depth,
+                                   Reg => R_Nil,
+                                   Body_Parent => Context,
+                                   Body_Decl => Decl,
+                                   Body_Stmt => Stmt,
+                                   Body_Info => 0,
+                                   others => False));
+      Res := Dnodes.Last;
+      Context := Res;
+      Cur_Depth := Cur_Depth + 1;
+      return Res;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body is
+   begin
+      Cur_Depth := Cur_Depth - 1;
+      Context := Get_Body_Parent (Context);
+   end Finish_Subprogram_Body;
+
+
+--    function Image (Decl : O_Dnode) return String is
+--    begin
+--       return O_Dnode'Image (Decl);
+--    end Image;
+
+   procedure Disp_Decl_Name (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Ident;
+      Id : O_Ident;
+   begin
+      Id := Get_Decl_Ident (Decl);
+      if Is_Equal (Id, O_Ident_Nul) then
+         declare
+            Res : String := O_Dnode'Image (Decl);
+         begin
+            Res (1) := '?';
+            Put (Res);
+         end;
+      else
+         Put (Get_String (Id));
+      end if;
+   end Disp_Decl_Name;
+
+   procedure Disp_Decl_Storage (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+   begin
+      case Get_Decl_Storage (Decl) is
+         when O_Storage_Local =>
+            Put ("local");
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+      end case;
+   end Disp_Decl_Storage;
+
+   procedure Disp_Decl (Indent : Natural; Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Ident;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Set_Col (Count (Indent));
+      Put (Int32 (Decl), 0);
+      Set_Col (Count (7 + Indent));
+      case Get_Decl_Kind (Decl) is
+         when OD_Type =>
+            Put ("type ");
+            Disp_Decl_Name (Decl);
+            Put (" is ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Function =>
+            Disp_Decl_Storage (Decl);
+            Put (" function ");
+            Disp_Decl_Name (Decl);
+            Put (" return ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Procedure =>
+            Disp_Decl_Storage (Decl);
+            Put (" procedure ");
+            Disp_Decl_Name (Decl);
+         when OD_Interface =>
+            Put (" interface ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+            Put (", offset=");
+            Put (Get_Inter_Offset (Decl), 0);
+         when OD_Const =>
+            Disp_Decl_Storage (Decl);
+            Put (" const ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Const_Val =>
+            Put ("constant ");
+            Disp_Decl_Name (Get_Val_Decl (Decl));
+            Put (": ");
+            Put (Int32 (Get_Val_Val (Decl)), 0);
+         when OD_Local =>
+            Put ("local ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+            Put (", offset=");
+            Put (Get_Inter_Offset (Decl), 0);
+         when OD_Var =>
+            Disp_Decl_Storage (Decl);
+            Put (" var ");
+            Disp_Decl_Name (Decl);
+            Put (": ");
+            Put (Int32 (Get_Decl_Type (Decl)), 0);
+         when OD_Body =>
+            Put ("body of ");
+            Put (Int32 (Get_Body_Decl (Decl)), 0);
+            Put (", stmt at ");
+            Put (Int32 (Get_Body_Stmt (Decl)), 0);
+         when OD_Block =>
+            Put ("block until ");
+            Put (Int32 (Get_Block_Last (Decl)), 0);
+         when OD_Subprg_Ext =>
+            Put ("Subprg_Ext");
+--           when others =>
+--              Put (OD_Kind'Image (Get_Decl_Kind (Decl)));
+      end case;
+      New_Line;
+   end Disp_Decl;
+
+   procedure Disp_Decls (Indent : Natural; First, Last : O_Dnode)
+   is
+      N : O_Dnode;
+   begin
+      N := First;
+      while N <= Last loop
+         case Get_Decl_Kind (N) is
+            when OD_Body =>
+               Disp_Decl (Indent, N);
+               Ortho_Code.Exprs.Disp_Subprg_Body
+                 (Indent + 2, Get_Body_Stmt (N));
+               N := N + 1;
+            when OD_Block =>
+               --  Skip inner bindings.
+               N := Get_Block_Last (N) + 1;
+            when others =>
+               Disp_Decl (Indent, N);
+               N := N + 1;
+         end case;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Block (Indent : Natural; Start : O_Dnode)
+   is
+      Last : O_Dnode;
+   begin
+      if Get_Decl_Kind (Start) /= OD_Block then
+         Disp_Decl (Indent, Start);
+         raise Program_Error;
+      end if;
+      Last := Get_Block_Last (Start);
+      Disp_Decl (Indent, Start);
+      Disp_Decls (Indent, Start + 1, Last);
+   end Disp_Block;
+
+   procedure Disp_All_Decls
+   is
+   begin
+      if False then
+         for I in Dnodes.First .. Dnodes.Last loop
+            Disp_Decl (1, I);
+         end loop;
+      end if;
+
+      Disp_Decls (1, Dnodes.First, Dnodes.Last);
+   end Disp_All_Decls;
+
+   procedure Debug_Decl (Decl : O_Dnode) is
+   begin
+      Disp_Decl (1, Decl);
+   end Debug_Decl;
+
+   pragma Unreferenced (Debug_Decl);
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Dnodes: " & O_Dnode'Image (Dnodes.Last));
+      Put_Line ("Number of TDnodes: " & O_Tnode'Image (TDnodes.Last));
+   end Disp_Stats;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Dnode := Dnodes.Last;
+      M.TDnode := TDnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Dnodes.Set_Last (M.Dnode);
+      TDnodes.Set_Last (M.TDnode);
+   end Release;
+
+   procedure Finish is
+   begin
+      Dnodes.Free;
+      TDnodes.Free;
+   end Finish;
+end Ortho_Code.Decls;
diff --git a/src/ortho/mcode/ortho_code-decls.ads b/src/ortho/mcode/ortho_code-decls.ads
new file mode 100644
index 000000000..ad18892fe
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-decls.ads
@@ -0,0 +1,209 @@
+--  Mcode back-end for ortho - Declarations handling.
+--  Copyright (C) 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 Ortho_Code.Abi;
+
+package Ortho_Code.Decls is
+   --  Kind of a declaration.
+   type OD_Kind is (OD_Type,
+                    OD_Const, OD_Const_Val,
+
+                    --  Global and local variables.
+                    OD_Var, OD_Local,
+
+                    --  Subprograms.
+                    OD_Function, OD_Procedure,
+
+                    --  Additional node for a subprogram.  Internal use only.
+                    OD_Subprg_Ext,
+
+                    OD_Interface,
+                    OD_Body,
+                    OD_Block);
+
+   --  Return the kind of declaration DECL.
+   function Get_Decl_Kind (Decl : O_Dnode) return OD_Kind;
+
+   --  Return the type of a declaration.
+   function Get_Decl_Type (Decl : O_Dnode) return O_Tnode;
+
+   --  Return the identifier of a declaration.
+   function Get_Decl_Ident (Decl : O_Dnode) return O_Ident;
+
+   --  Return the storage of a declaration.
+   function Get_Decl_Storage (Decl : O_Dnode) return O_Storage;
+
+   --  Return the depth of a declaration.
+   function Get_Decl_Depth (Decl : O_Dnode) return O_Depth;
+
+   --  Register for the declaration.
+   function Get_Decl_Reg (Decl : O_Dnode) return O_Reg;
+   procedure Set_Decl_Reg (Decl : O_Dnode; Reg : O_Reg);
+
+   --  Return the next decl (in the same scope) after DECL.
+   --  This skips declarations in an inner block.
+   function Get_Decl_Chain (Decl : O_Dnode) return O_Dnode;
+
+   --  Get the last declaration.
+   function Get_Decl_Last return O_Dnode;
+
+   --  Return the subprogram declaration correspondig to body BOD.
+   function Get_Body_Decl (Bod : O_Dnode) return O_Dnode;
+
+   --  Return the parent of a body.
+   function Get_Body_Parent (Bod : O_Dnode) return O_Dnode;
+
+   --  Get the entry statement of body DECL.
+   function Get_Body_Stmt (Bod : O_Dnode) return O_Enode;
+
+   --  Get/Set the info field of a body.
+   function Get_Body_Info (Bod : O_Dnode) return Int32;
+   procedure Set_Body_Info (Bod : O_Dnode; Info : Int32);
+
+   --  Get the last declaration of block BLK.
+   function Get_Block_Last (Blk : O_Dnode) return O_Dnode;
+
+   --  Get/Set the block max stack offset.
+   function Get_Block_Max_Stack (Blk : O_Dnode) return Uns32;
+   procedure Set_Block_Max_Stack (Blk : O_Dnode; Max : Uns32);
+
+   --  Info on blocks.
+   function Get_Block_Info1 (Blk : O_Dnode) return Int32;
+   procedure Set_Block_Info1 (Blk : O_Dnode; Info : Int32);
+   function Get_Block_Info2 (Blk : O_Dnode) return Int32;
+   procedure Set_Block_Info2 (Blk : O_Dnode; Info : Int32);
+
+   --  Get the declaration and the value associated with a constant value.
+   function Get_Val_Decl (Decl : O_Dnode) return O_Dnode;
+   function Get_Val_Val (Decl : O_Dnode) return O_Cnode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   --  If Flag_Type_Name is set, a map from type to name is maintained.
+   function Get_Type_Decl (Atype : O_Tnode) return O_Dnode;
+
+   --  Set/Get the offset (or register) of interface or local DECL.
+   --  To be used by ABI.
+   procedure Set_Local_Offset (Decl : O_Dnode; Off : Int32);
+   function Get_Local_Offset (Decl : O_Dnode) return Int32;
+
+   --  Get/Set user info on subprogram, variable, constant declaration.
+   procedure Set_Decl_Info (Decl : O_Dnode; Ref : Int32);
+   function Get_Decl_Info (Decl : O_Dnode) return Int32;
+
+   --  Get/Set the stack size of subprogram arguments.
+   procedure Set_Subprg_Stack (Decl : O_Dnode; Val : Int32);
+   function Get_Subprg_Stack (Decl : O_Dnode) return Int32;
+
+   --  Get the first interface of a subprogram declaration.
+   function Get_Subprg_Interfaces (Decl : O_Dnode) return O_Dnode;
+
+   --  Get the next interface.
+   --  End of interface chain when result is O_Dnode_Null.
+   function Get_Interface_Chain (Decl : O_Dnode) return O_Dnode;
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value to CST.
+   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   type O_Inter_List is limited private;
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+
+   --  Start subprogram body of DECL.  STMT is the corresponding statement.
+   --  Return the declaration for the body.
+   function Start_Subprogram_Body (Decl : O_Dnode; Stmt : O_Enode)
+                                  return O_Dnode;
+   procedure Finish_Subprogram_Body;
+
+   --  Start a declarative region.
+   function Start_Declare_Stmt return O_Dnode;
+   procedure Finish_Declare_Stmt (Parent : O_Dnode);
+
+   procedure Disp_All_Decls;
+   procedure Disp_Block (Indent : Natural; Start : O_Dnode);
+   procedure Disp_Decl_Name (Decl : O_Dnode);
+   procedure Disp_Decl (Indent : Natural; Decl : O_Dnode);
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Inter_List is record
+      --  The declaration of the subprogram.
+      Decl : O_Dnode;
+
+      --  Last declared parameter.
+      Last_Param : O_Dnode;
+
+      --  Data for ABI.
+      Abi : Ortho_Code.Abi.O_Abi_Subprg;
+   end record;
+
+   type Mark_Type is record
+      Dnode : O_Dnode;
+      TDnode : O_Tnode;
+   end record;
+
+end Ortho_Code.Decls;
diff --git a/src/ortho/mcode/ortho_code-disps.adb b/src/ortho/mcode/ortho_code-disps.adb
new file mode 100644
index 000000000..9e8ac1272
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-disps.adb
@@ -0,0 +1,790 @@
+--  Mcode back-end for ortho - Internal tree dumper.
+--  Copyright (C) 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 Ada.Text_IO; use Ada.Text_IO;
+with Ortho_Code.Debug;
+with Ortho_Code.Consts;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Flags;
+with Ortho_Ident;
+with Interfaces;
+
+package body Ortho_Code.Disps is
+   procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode);
+   procedure Disp_Expr (Expr : O_Enode);
+
+   procedure Disp_Indent (Indent : Natural)
+   is
+   begin
+      Put ((1 .. 2 * Indent => ' '));
+   end Disp_Indent;
+
+   procedure Disp_Ident (Id : O_Ident)
+   is
+      use Ortho_Ident;
+   begin
+      Put (Get_String (Id));
+   end Disp_Ident;
+
+   procedure Disp_Storage (Storage : O_Storage) is
+   begin
+      case Storage is
+         when O_Storage_External =>
+            Put ("external");
+         when O_Storage_Public =>
+            Put ("public");
+         when O_Storage_Private =>
+            Put ("private");
+         when O_Storage_Local =>
+            Put ("local");
+      end case;
+   end Disp_Storage;
+
+   procedure Disp_Label (Label : O_Enode)
+   is
+      N : Int32;
+   begin
+      case Get_Expr_Kind (Label) is
+         when OE_Label =>
+            Put ("label");
+            N := Int32 (Label);
+         when OE_Loop =>
+            Put ("loop");
+            N := Int32 (Label);
+         when OE_BB =>
+            Put ("BB");
+            N := Get_BB_Number (Label);
+         when others =>
+            raise Program_Error;
+      end case;
+      Put (Int32'Image (N));
+      Put (":");
+   end Disp_Label;
+
+   procedure Disp_Call (Call : O_Enode)
+   is
+      Arg : O_Enode;
+   begin
+      Decls.Disp_Decl_Name (Get_Call_Subprg (Call));
+
+      Arg := Get_Arg_Link (Call);
+      if Arg /= O_Enode_Null then
+         Put (" (");
+         loop
+            Disp_Expr (Get_Expr_Operand (Arg));
+            Arg := Get_Arg_Link (Arg);
+            exit when Arg = O_Enode_Null;
+            Put (", ");
+         end loop;
+         Put (")");
+      end if;
+   end Disp_Call;
+
+   procedure Put_Trim (Str : String) is
+   begin
+      if Str (Str'First) = ' ' then
+         Put (Str (Str'First + 1 .. Str'Last));
+      else
+         Put (Str);
+      end if;
+   end Put_Trim;
+
+   procedure Disp_Typed_Lit (Lit : O_Cnode; Val : String)
+   is
+      use Ortho_Code.Consts;
+   begin
+      Disp_Type (Get_Const_Type (Lit));
+      Put ("'[");
+      Put_Trim (Val);
+      Put (']');
+   end Disp_Typed_Lit;
+
+   procedure Disp_Lit (Lit : O_Cnode)
+   is
+      use Interfaces;
+      use Ortho_Code.Consts;
+   begin
+      case Get_Const_Kind (Lit) is
+         when OC_Unsigned =>
+            Disp_Typed_Lit (Lit, Unsigned_64'Image (Get_Const_U64 (Lit)));
+         when OC_Signed =>
+            Disp_Typed_Lit (Lit, Integer_64'Image (Get_Const_I64 (Lit)));
+         when OC_Subprg_Address =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'subprg_addr (");
+            Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
+            Put (")");
+         when OC_Address =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'address (");
+            Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
+            Put (")");
+         when OC_Sizeof =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'sizeof (");
+            Disp_Type (Get_Sizeof_Type (Lit));
+            Put (")");
+         when OC_Null =>
+            Disp_Type (Get_Const_Type (Lit));
+            Put ("'[null]");
+         when OC_Lit =>
+            declare
+               L : O_Cnode;
+            begin
+               L := Types.Get_Type_Enum_Lit
+                 (Get_Const_Type (Lit), Get_Lit_Value (Lit));
+               Disp_Typed_Lit
+                 (Lit, Ortho_Ident.Get_String (Get_Lit_Ident (L)));
+            end;
+         when OC_Array =>
+            Put ('{');
+            for I in 1 .. Get_Const_Aggr_Length (Lit) loop
+               if I /= 1 then
+                  Put (", ");
+               end if;
+               Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
+            end loop;
+            Put ('}');
+         when OC_Record =>
+            declare
+               use Ortho_Code.Types;
+               F : O_Fnode;
+            begin
+               F := Get_Type_Record_Fields (Get_Const_Type (Lit));
+               Put ('{');
+               for I in 1 .. Get_Const_Aggr_Length (Lit) loop
+                  if I /= 1 then
+                     Put (", ");
+                  end if;
+                  Put ('.');
+                  Disp_Ident (Get_Field_Ident (F));
+                  Put (" = ");
+                  Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
+                  F := Get_Field_Chain (F);
+               end loop;
+               Put ('}');
+            end;
+         when OC_Union =>
+            Put ('{');
+            Put ('.');
+            Disp_Ident (Types.Get_Field_Ident (Get_Const_Union_Field (Lit)));
+            Put ('=');
+            Disp_Lit (Get_Const_Union_Value (Lit));
+            Put ('}');
+         when others =>
+            Put ("*lit " & OC_Kind'Image (Get_Const_Kind (Lit)) & '*');
+      end case;
+   end Disp_Lit;
+
+   procedure Disp_Expr (Expr : O_Enode)
+   is
+      Kind : OE_Kind;
+   begin
+      Kind := Get_Expr_Kind (Expr);
+      case Kind is
+         when OE_Const =>
+            case Get_Expr_Mode (Expr) is
+               when Mode_I8
+                 | Mode_I16
+                 | Mode_I32 =>
+                  Put_Trim (Int32'Image (To_Int32 (Get_Expr_Low (Expr))));
+               when Mode_U8
+                 | Mode_U16
+                 | Mode_U32 =>
+                  Put_Trim (Uns32'Image (Get_Expr_Low (Expr)));
+               when others =>
+                  Put ("const:");
+                  Debug.Disp_Mode (Get_Expr_Mode (Expr));
+            end case;
+         when OE_Lit =>
+            Disp_Lit (Get_Expr_Lit (Expr));
+         when OE_Case_Expr =>
+            Put ("{case}");
+         when OE_Kind_Dyadic
+           | OE_Kind_Cmp
+           | OE_Add
+           | OE_Mul
+           | OE_Shl =>
+            Put ("(");
+            Disp_Expr (Get_Expr_Left (Expr));
+            Put (' ');
+            case Kind is
+               when OE_Eq =>
+                  Put ('=');
+               when OE_Neq =>
+                  Put ("/=");
+               when OE_Lt =>
+                  Put ("<");
+               when OE_Gt =>
+                  Put (">");
+               when OE_Ge =>
+                  Put (">=");
+               when OE_Le =>
+                  Put ("<=");
+               when OE_Add =>
+                  Put ('+');
+               when OE_Mul =>
+                  Put ('*');
+               when OE_Add_Ov =>
+                  Put ("+#");
+               when OE_Sub_Ov =>
+                  Put ("-#");
+               when OE_Mul_Ov =>
+                  Put ("*#");
+               when OE_Shl =>
+                  Put ("<<");
+               when OE_And =>
+                  Put ("and");
+               when OE_Or =>
+                  Put ("or");
+               when others =>
+                  Put (OE_Kind'Image (Kind));
+            end case;
+            Put (' ');
+            Disp_Expr (Get_Expr_Right (Expr));
+            Put (")");
+         when OE_Not =>
+            Put ("not ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Neg_Ov =>
+            Put ("neg ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Abs_Ov =>
+            Put ("abs ");
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Indir =>
+            declare
+               Op : O_Enode;
+            begin
+               Op := Get_Expr_Operand (Expr);
+               case Get_Expr_Kind (Op) is
+                  when OE_Addrg
+                    | OE_Addrl =>
+                     Decls.Disp_Decl_Name (Get_Addr_Object (Op));
+                  when others =>
+                     --Put ("*");
+                     Disp_Expr (Op);
+               end case;
+            end;
+         when OE_Addrl
+           | OE_Addrg =>
+            -- Put ('@');
+            Decls.Disp_Decl_Name (Get_Addr_Object (Expr));
+         when OE_Call =>
+            Disp_Call (Expr);
+         when OE_Alloca =>
+            Put ("alloca (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Conv =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'conv (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Conv_Ptr =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'address (");
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (")");
+         when OE_Typed =>
+            Disp_Type (Get_Conv_Type (Expr));
+            Put ("'");
+            --  Note: there is always parenthesis around comparison.
+            Disp_Expr (Get_Expr_Operand (Expr));
+         when OE_Record_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (".");
+            Disp_Ident (Types.Get_Field_Ident (Get_Ref_Field (Expr)));
+         when OE_Access_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put (".all");
+         when OE_Index_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put ('[');
+            Disp_Expr (Get_Ref_Index (Expr));
+            Put (']');
+         when OE_Slice_Ref =>
+            Disp_Expr (Get_Expr_Operand (Expr));
+            Put ('[');
+            Disp_Expr (Get_Ref_Index (Expr));
+            Put ("...]");
+         when OE_Get_Stack =>
+            Put ("%sp");
+         when OE_Get_Frame =>
+            Put ("%fp");
+         when others =>
+            Put_Line (Standard_Error, "disps.disp_expr: unknown expr "
+                      & OE_Kind'Image (Kind));
+      end case;
+   end Disp_Expr;
+
+   procedure Disp_Fields (Indent : Natural; Atype : O_Tnode)
+   is
+      use Types;
+      Nbr : Uns32;
+      F : O_Fnode;
+   begin
+      Nbr := Get_Type_Record_Nbr_Fields (Atype);
+      F := Get_Type_Record_Fields (Atype);
+      for I in 1 .. Nbr loop
+         Disp_Indent (Indent);
+         Disp_Ident (Get_Field_Ident (F));
+         Put (": ");
+         Disp_Type (Get_Field_Type (F));
+         Put (";");
+         New_Line;
+         F := Get_Field_Chain (F);
+      end loop;
+   end Disp_Fields;
+
+   procedure Disp_Type (Atype : O_Tnode; Force : Boolean := False)
+   is
+      use Types;
+      Kind : OT_Kind;
+      Decl : O_Dnode;
+   begin
+      if not Force then
+         Decl := Decls.Get_Type_Decl (Atype);
+         if Decl /= O_Dnode_Null then
+            Decls.Disp_Decl_Name (Decl);
+            return;
+         end if;
+      end if;
+
+      Kind := Get_Type_Kind (Atype);
+      case Kind is
+         when OT_Signed =>
+            Put ("signed (");
+            Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
+            Put (")");
+         when OT_Unsigned =>
+            Put ("unsigned (");
+            Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
+            Put (")");
+         when OT_Float =>
+            Put ("float");
+         when OT_Access =>
+            Put ("access");
+            declare
+               Acc_Type : O_Tnode;
+            begin
+               Acc_Type := Get_Type_Access_Type (Atype);
+               if Acc_Type /= O_Tnode_Null then
+                  Put (' ');
+                  Disp_Type (Acc_Type);
+               end if;
+            end;
+         when OT_Ucarray =>
+            Put ("array [");
+            Disp_Type (Get_Type_Ucarray_Index (Atype));
+            Put ("] of ");
+            Disp_Type (Get_Type_Ucarray_Element (Atype));
+         when OT_Subarray =>
+            Put ("subarray ");
+            Disp_Type (Get_Type_Subarray_Base (Atype));
+            Put ("[");
+            Put_Trim (Uns32'Image (Get_Type_Subarray_Length (Atype)));
+            Put ("]");
+         when OT_Record =>
+            Put_Line ("record");
+            Disp_Fields (1, Atype);
+            Put ("end record");
+         when OT_Union =>
+            Put_Line ("union");
+            Disp_Fields (1, Atype);
+            Put ("end union");
+         when OT_Boolean =>
+            declare
+               Lit : O_Cnode;
+            begin
+               Put ("boolean {");
+               Lit := Get_Type_Bool_False (Atype);
+               Disp_Ident (Consts.Get_Lit_Ident (Lit));
+               Put (", ");
+               Lit := Get_Type_Bool_True (Atype);
+               Disp_Ident (Consts.Get_Lit_Ident (Lit));
+               Put ("}");
+            end;
+         when OT_Enum =>
+            declare
+               use Consts;
+               Lit : O_Cnode;
+            begin
+               Put ("enum {");
+               Lit := Get_Type_Enum_Lits (Atype);
+               for I in 1 .. Get_Type_Enum_Nbr_Lits (Atype) loop
+                  if I /= 1 then
+                     Put (", ");
+                  end if;
+                  Disp_Ident (Get_Lit_Ident (Lit));
+                  Put (" =");
+                  Put (Uns32'Image (I - 1));
+                  Lit := Get_Lit_Chain (Lit);
+               end loop;
+               Put ('}');
+            end;
+         when OT_Complete =>
+            Put ("-- complete: ");
+            Disp_Type (Get_Type_Complete_Type (Atype));
+      end case;
+   end Disp_Type;
+
+   procedure Disp_Decl_Storage (Decl : O_Dnode) is
+   begin
+      Disp_Storage (Decls.Get_Decl_Storage (Decl));
+      Put (' ');
+   end Disp_Decl_Storage;
+
+   procedure Disp_Subprg_Decl (Indent : Natural; Decl : O_Dnode)
+   is
+      use Decls;
+      Kind : OD_Kind;
+      Inter : O_Dnode;
+   begin
+      Disp_Decl_Storage (Decl);
+      Kind := Get_Decl_Kind (Decl);
+      case Kind is
+         when OD_Function =>
+            Put ("function ");
+         when OD_Procedure =>
+            Put ("procedure ");
+         when others =>
+            raise Program_Error;
+      end case;
+
+      Disp_Decl_Name (Decl);
+      Inter := Get_Subprg_Interfaces (Decl);
+      Put (" (");
+      New_Line;
+      if Inter /= O_Dnode_Null then
+         loop
+            Disp_Indent (Indent + 1);
+            Disp_Decl_Name (Inter);
+            Put (": ");
+            Disp_Type (Get_Decl_Type (Inter));
+            Inter := Get_Interface_Chain (Inter);
+            exit when Inter = O_Dnode_Null;
+            Put (";");
+            New_Line;
+         end loop;
+      else
+         Disp_Indent (Indent + 1);
+      end if;
+      Put (")");
+      if Kind = OD_Function then
+         New_Line;
+         Disp_Indent (Indent + 1);
+         Put ("return ");
+         Disp_Type (Get_Decl_Type (Decl));
+      end if;
+   end Disp_Subprg_Decl;
+
+   procedure Disp_Decl (Indent : Natural;
+                        Decl : O_Dnode;
+                        Nl : Boolean := False)
+   is
+      use Decls;
+      Kind : OD_Kind;
+      Dtype : O_Tnode;
+   begin
+      Kind := Get_Decl_Kind (Decl);
+      if Kind = OD_Interface then
+         return;
+      end if;
+      Disp_Indent (Indent);
+      case Kind is
+         when OD_Type =>
+            Dtype := Get_Decl_Type (Decl);
+            Put ("type ");
+            Disp_Decl_Name (Decl);
+            Put (" is ");
+            Disp_Type (Dtype, True);
+            Put_Line (";");
+         when OD_Local
+           | OD_Var =>
+            Disp_Decl_Storage (Decl);
+            Put ("var ");
+            Disp_Decl_Name (Decl);
+            Put (" : ");
+            Dtype := Get_Decl_Type (Decl);
+            Disp_Type (Dtype);
+            if True then
+               Put (" {size="
+                    & Uns32'Image (Types.Get_Type_Size (Dtype)) & "}");
+            end if;
+            Put_Line (";");
+         when OD_Const =>
+            Disp_Decl_Storage (Decl);
+            Put ("constant ");
+            Disp_Decl_Name (Decl);
+            Put (" : ");
+            Disp_Type (Get_Decl_Type (Decl));
+            Put_Line (";");
+         when OD_Const_Val =>
+            Put ("constant ");
+            Disp_Decl_Name (Get_Val_Decl (Decl));
+            Put (" := ");
+            Disp_Lit (Get_Val_Val (Decl));
+            Put_Line (";");
+         when OD_Function
+           | OD_Procedure =>
+            Disp_Subprg_Decl (Indent, Decl);
+            Put_Line (";");
+         when OD_Interface =>
+            null;
+         when OD_Body =>
+            --  Put ("body ");
+            Disp_Subprg_Decl (Indent, Get_Body_Decl (Decl));
+            -- Disp_Decl_Name (Get_Body_Decl (Decl));
+            New_Line;
+            Disp_Subprg (Indent, Get_Body_Stmt (Decl));
+         when OD_Block | OD_Subprg_Ext =>
+            null;
+      end case;
+      if Nl then
+         New_Line;
+      end if;
+   end Disp_Decl;
+
+   procedure Disp_Stmt (Indent : in out Natural; Stmt : O_Enode)
+   is
+      use Decls;
+      Expr : O_Enode;
+   begin
+      case Get_Expr_Kind (Stmt) is
+         when OE_Beg =>
+            Disp_Indent (Indent);
+            Put_Line ("declare");
+            declare
+               Last : O_Dnode;
+               Decl : O_Dnode;
+            begin
+               Decl := Get_Block_Decls (Stmt);
+               Last := Get_Block_Last (Decl);
+               Decl := Decl + 1;
+               while Decl <= Last loop
+                  case Get_Decl_Kind (Decl) is
+                     when OD_Block =>
+                        Decl := Get_Block_Last (Decl) + 1;
+                     when others =>
+                        Disp_Decl (Indent + 1, Decl, False);
+                        Decl := Decl + 1;
+                  end case;
+               end loop;
+            end;
+            Disp_Indent (Indent);
+            Put_Line ("begin");
+            Indent := Indent + 1;
+         when OE_End =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end;");
+         when OE_Line =>
+            Disp_Indent (Indent);
+            Put_Line ("--#" & Int32'Image (Get_Expr_Line_Number (Stmt)));
+         when OE_BB =>
+            Disp_Indent (Indent);
+            Put_Line ("# BB" & Int32'Image (Get_BB_Number (Stmt)));
+         when OE_Asgn =>
+            Disp_Indent (Indent);
+            Disp_Expr (Get_Assign_Target (Stmt));
+            Put (" := ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put_Line (";");
+         when OE_Call =>
+            Disp_Indent (Indent);
+            Disp_Call (Stmt);
+            Put_Line (";");
+         when OE_Jump_F =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (" if not ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Jump_T =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (" if ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Jump =>
+            Disp_Indent (Indent);
+            Put ("jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Label =>
+            Disp_Indent (Indent);
+            Disp_Label (Stmt);
+            New_Line;
+         when OE_Ret =>
+            Disp_Indent (Indent);
+            Put ("return");
+            Expr := Get_Expr_Operand (Stmt);
+            if Expr /= O_Enode_Null then
+               Put (" ");
+               Disp_Expr (Expr);
+            end if;
+            Put_Line (";");
+         when OE_Set_Stack =>
+            Disp_Indent (Indent);
+            Put ("%sp := ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put_Line (";");
+         when OE_Leave =>
+            Disp_Indent (Indent);
+            Put_Line ("# leave");
+         when OE_If =>
+            Disp_Indent (Indent);
+            Put ("if ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put (" then");
+            New_Line;
+            Indent := Indent + 1;
+         when OE_Else =>
+            Disp_Indent (Indent - 1);
+            Put ("else");
+            New_Line;
+         when OE_Endif =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end if;");
+         when OE_Loop =>
+            Disp_Indent (Indent);
+            Disp_Label (Stmt);
+            New_Line;
+            Indent := Indent + 1;
+         when OE_Exit =>
+            Disp_Indent (Indent);
+            Put ("exit ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (";");
+            New_Line;
+         when OE_Next =>
+            Disp_Indent (Indent);
+            Put ("next ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            Put (";");
+            New_Line;
+         when OE_Eloop =>
+            Indent := Indent - 1;
+            Disp_Indent (Indent);
+            Put_Line ("end loop;");
+         when OE_Case =>
+            Disp_Indent (Indent);
+            Put ("case ");
+            Disp_Expr (Get_Expr_Operand (Stmt));
+            Put (" is");
+            New_Line;
+            if Debug.Flag_Debug_Hli then
+               Indent := Indent + 2;
+            end if;
+         when OE_Case_Branch =>
+            Disp_Indent (Indent - 1);
+            Put ("when ");
+            declare
+               C : O_Enode;
+               L, H : O_Enode;
+            begin
+               C := Get_Case_Branch_Choice (Stmt);
+               loop
+                  L := Get_Expr_Left (C);
+                  H := Get_Expr_Right (C);
+                  if L = O_Enode_Null then
+                     Put ("others");
+                  else
+                     Disp_Expr (L);
+                     if H /= O_Enode_Null then
+                        Put (" ... ");
+                        Disp_Expr (H);
+                     end if;
+                  end if;
+                  C := Get_Case_Choice_Link (C);
+                  exit when C = O_Enode_Null;
+                  New_Line;
+                  Disp_Indent (Indent - 1);
+                  Put ("  | ");
+               end loop;
+               Put (" =>");
+               New_Line;
+            end;
+         when OE_Case_End =>
+            Indent := Indent - 2;
+            Disp_Indent (Indent);
+            Put ("end case;");
+            New_Line;
+         when others =>
+            Put_Line (Standard_Error, "debug.disp_stmt: unknown statement " &
+                      OE_Kind'Image (Get_Expr_Kind (Stmt)));
+      end case;
+   end Disp_Stmt;
+
+   procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode)
+   is
+      Stmt : O_Enode;
+      N_Ident : Natural := Ident;
+   begin
+      Stmt := S_Entry;
+      loop
+         Stmt := Get_Stmt_Link (Stmt);
+         Disp_Stmt (N_Ident, Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+      end loop;
+   end Disp_Subprg;
+
+   Last_Decl : O_Dnode := O_Dnode_First;
+
+   procedure Disp_Decls_Until (Last : O_Dnode; Nl : Boolean := False) is
+   begin
+      while Last_Decl <= Last loop
+         Disp_Decl (0, Last_Decl, Nl);
+         Last_Decl := Last_Decl + 1;
+      end loop;
+   end Disp_Decls_Until;
+
+   procedure Disp_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+      use Decls;
+   begin
+      Disp_Decls_Until (Subprg.D_Body, True);
+      if Get_Decl_Kind (Last_Decl) /= OD_Block then
+         raise Program_Error;
+      end if;
+      if Debug.Flag_Debug_Keep then
+         --  If nodes are kept, the next declaration to be displayed (at top
+         --   level) is the one that follow the subprogram block.
+         Last_Decl := Get_Block_Last (Last_Decl) + 1;
+      else
+         --  If nodes are not kept, this subprogram block will be freed, and
+         --  the next declaration is the block itself.
+         Last_Decl := Subprg.D_Body;
+      end if;
+   end Disp_Subprg;
+
+   procedure Init is
+   begin
+      Flags.Flag_Type_Name := True;
+   end Init;
+
+   procedure Finish is
+   begin
+      Disp_Decls_Until (Decls.Get_Decl_Last, True);
+   end Finish;
+
+end Ortho_Code.Disps;
diff --git a/src/ortho/mcode/ortho_code-disps.ads b/src/ortho/mcode/ortho_code-disps.ads
new file mode 100644
index 000000000..5ae4d8697
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-disps.ads
@@ -0,0 +1,25 @@
+--  Mcode back-end for ortho - Internal tree dumper.
+--  Copyright (C) 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 Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.Disps is
+   procedure Disp_Subprg (Subprg : Subprogram_Data_Acc);
+   procedure Disp_Type (Atype : O_Tnode; Force : Boolean := False);
+   procedure Init;
+   procedure Finish;
+end Ortho_Code.Disps;
diff --git a/src/ortho/mcode/ortho_code-dwarf.adb b/src/ortho/mcode/ortho_code-dwarf.adb
new file mode 100644
index 000000000..ad67d1ff6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-dwarf.adb
@@ -0,0 +1,1351 @@
+--  Mcode back-end for ortho - Dwarf generator.
+--  Copyright (C) 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 GNAT.Directory_Operations;
+with GNAT.Table;
+with Interfaces; use Interfaces;
+with Binary_File; use Binary_File;
+with Dwarf; use Dwarf;
+with Ada.Text_IO;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Consts;
+with Ortho_Code.Flags;
+with Ortho_Ident;
+with Ortho_Code.Binary;
+
+package body Ortho_Code.Dwarf is
+   --  Dwarf debugging format.
+   --  Debugging.
+   Line1_Sect : Section_Acc := null;
+   Line_Last : Int32 := 0;
+   Line_Pc : Pc_Type := 0;
+
+   --  Constant.
+   Min_Insn_Len : constant := 1;
+   Line_Base : constant := 1;
+   Line_Range : constant := 4;
+   Line_Opcode_Base : constant := 13;
+   Line_Max_Addr : constant := (255 - Line_Opcode_Base) / Line_Range;
+   -- + Line_Base;
+
+   Cur_File : Natural := 0;
+   Last_File : Natural := 0;
+
+   Orig_Sym : Symbol;
+   End_Sym : Symbol;
+   Abbrev_Sym : Symbol;
+   Info_Sym : Symbol;
+   Line_Sym : Symbol;
+
+   Line_Sect : Section_Acc;
+   Abbrev_Sect : Section_Acc;
+   Info_Sect : Section_Acc;
+   Aranges_Sect : Section_Acc;
+
+   Abbrev_Last : Unsigned_32;
+
+--     procedure Gen_String (Str : String)
+--     is
+--     begin
+--        for I in Str'Range loop
+--           Gen_B8 (Character'Pos (Str (I)));
+--        end loop;
+--     end Gen_String;
+
+   procedure Gen_String_Nul (Str : String)
+   is
+   begin
+      Prealloc (Str'Length + 1);
+      for I in Str'Range loop
+         Gen_B8 (Character'Pos (Str (I)));
+      end loop;
+      Gen_B8 (0);
+   end Gen_String_Nul;
+
+   procedure Gen_Sleb128 (V : Int32)
+   is
+      V1 : Uns32 := To_Uns32 (V);
+      V2 : Uns32;
+      B : Byte;
+      function Shift_Right_Arithmetic (Value : Uns32; Amount : Natural)
+                                      return Uns32;
+      pragma Import (Intrinsic, Shift_Right_Arithmetic);
+   begin
+      loop
+         B := Byte (V1 and 16#7F#);
+         V2 := Shift_Right_Arithmetic (V1, 7);
+         if (V2 = 0 and (B and 16#40#) = 0)
+           or (V2 = -1 and (B and 16#40#) /= 0)
+         then
+            Gen_B8 (B);
+            exit;
+         else
+            Gen_B8 (B or 16#80#);
+            V1 := V2;
+         end if;
+      end loop;
+   end Gen_Sleb128;
+
+   procedure Gen_Uleb128 (V : Unsigned_32)
+   is
+      V1 : Unsigned_32 := V;
+      B : Byte;
+   begin
+      loop
+         B := Byte (V1 and 16#7f#);
+         V1 := Shift_Right (V1, 7);
+         if V1 /= 0 then
+            Gen_B8 (B or 16#80#);
+         else
+            Gen_B8 (B);
+            exit;
+         end if;
+      end loop;
+   end Gen_Uleb128;
+
+--     procedure New_Debug_Line_Decl (Line : Int32)
+--     is
+--     begin
+--        Line_Last := Line;
+--     end New_Debug_Line_Decl;
+
+   procedure Set_Line_Stmt (Line : Int32)
+   is
+      Pc : Pc_Type;
+      D_Pc : Pc_Type;
+      D_Ln : Int32;
+   begin
+      if Line = Line_Last then
+         return;
+      end if;
+      Pc := Get_Current_Pc;
+
+      D_Pc := (Pc - Line_Pc) / Min_Insn_Len;
+      D_Ln := Line - Line_Last;
+
+      --  Always emit line information, since missing info can distrub the
+      --  user.
+      --  As an optimization, we could try to emit the highest line for the
+      --  same PC, since GDB seems to handle this way.
+      if False and D_Pc = 0 then
+         return;
+      end if;
+
+      Set_Current_Section (Line1_Sect);
+      Prealloc (32);
+
+      if Cur_File /= Last_File then
+         Gen_B8 (Byte (DW_LNS_Set_File));
+         Gen_Uleb128 (Unsigned_32 (Cur_File));
+         Last_File := Cur_File;
+      elsif Cur_File = 0 then
+         return;
+      end if;
+
+      if D_Ln < Line_Base or D_Ln >= (Line_Base + Line_Range) then
+         --  Emit an advance line.
+         Gen_B8 (Byte (DW_LNS_Advance_Line));
+         Gen_Sleb128 (Int32 (D_Ln - Line_Base));
+         D_Ln := Line_Base;
+      end if;
+      if D_Pc >= Line_Max_Addr then
+         --  Emit an advance addr.
+         Gen_B8 (Byte (DW_LNS_Advance_Pc));
+         Gen_Uleb128 (Unsigned_32 (D_Pc));
+         D_Pc := 0;
+      end if;
+      Gen_B8 (Line_Opcode_Base
+              + Byte (D_Pc) * Line_Range
+              + Byte (D_Ln - Line_Base));
+
+      --Set_Current_Section (Text_Sect);
+      Line_Pc := Pc;
+      Line_Last := Line;
+   end Set_Line_Stmt;
+
+
+   type String_Acc is access constant String;
+
+   type Dir_Chain;
+   type Dir_Chain_Acc is access Dir_Chain;
+   type Dir_Chain is record
+      Name : String_Acc;
+      Next : Dir_Chain_Acc;
+   end record;
+
+   type File_Chain;
+   type File_Chain_Acc is access File_Chain;
+   type File_Chain is record
+      Name : String_Acc;
+      Dir : Natural;
+      Next : File_Chain_Acc;
+   end record;
+
+   Dirs : Dir_Chain_Acc := null;
+   Files : File_Chain_Acc := null;
+
+   procedure Set_Filename (Dir : String; File : String)
+   is
+      D : Natural;
+      F : Natural;
+      D_C : Dir_Chain_Acc;
+      F_C : File_Chain_Acc;
+   begin
+      --  Find directory.
+      if Dir = "" then
+         --  Current directory.
+         D := 0;
+      elsif Dirs = null then
+         --  First directory.
+         Dirs := new Dir_Chain'(Name => new String'(Dir),
+                                Next => null);
+         D := 1;
+      else
+         --  Find a directory.
+         D_C := Dirs;
+         D := 1;
+         loop
+            exit when D_C.Name.all = Dir;
+            D := D + 1;
+            if D_C.Next = null then
+               D_C.Next := new Dir_Chain'(Name => new String'(Dir),
+                                          Next => null);
+               exit;
+            else
+               D_C := D_C.Next;
+            end if;
+         end loop;
+      end if;
+
+      --  Find file.
+      F := 1;
+      if Files = null then
+         --  first file.
+         Files := new File_Chain'(Name => new String'(File),
+                                  Dir => D,
+                                  Next => null);
+      else
+         F_C := Files;
+         loop
+            exit when F_C.Name.all = File and F_C.Dir = D;
+            F := F + 1;
+            if F_C.Next = null then
+               F_C.Next := new File_Chain'(Name => new String'(File),
+                                           Dir => D,
+                                           Next => null);
+               exit;
+            else
+               F_C := F_C.Next;
+            end if;
+         end loop;
+      end if;
+      Cur_File := F;
+   end Set_Filename;
+
+   procedure Gen_Abbrev_Header (Tag : Unsigned_32; Child : Byte) is
+   begin
+      Gen_Uleb128 (Tag);
+      Gen_B8 (Child);
+   end Gen_Abbrev_Header;
+
+   procedure Gen_Abbrev_Tuple (Attr : Unsigned_32; Form : Unsigned_32) is
+   begin
+      Gen_Uleb128 (Attr);
+      Gen_Uleb128 (Form);
+   end Gen_Abbrev_Tuple;
+
+   procedure Init
+   is
+   begin
+      --  Generate type names.
+      Flags.Flag_Type_Name := True;
+
+
+      Orig_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Orig_Sym, False);
+      End_Sym := Create_Local_Symbol;
+
+      Create_Section (Line1_Sect, ".debug_line-1", Section_Debug);
+      Set_Current_Section (Line1_Sect);
+
+      --  Write Address.
+      Gen_B8 (0); -- extended opcode
+      Gen_B8 (5); -- length: 1 + 4
+      Gen_B8 (Byte (DW_LNE_Set_Address));
+      Gen_Ua_32 (Orig_Sym, 0);
+
+      Line_Last := 1;
+
+      Create_Section (Line_Sect, ".debug_line", Section_Debug);
+      Set_Section_Info (Line_Sect, null, 0, 0);
+      Set_Current_Section (Line_Sect);
+      Line_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Line_Sym, False);
+
+      --  Abbrevs.
+      Create_Section (Abbrev_Sect, ".debug_abbrev", Section_Debug);
+      Set_Section_Info (Abbrev_Sect, null, 0, 0);
+      Set_Current_Section (Abbrev_Sect);
+
+      Abbrev_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Abbrev_Sym, False);
+
+      Gen_Uleb128 (1);
+      Gen_Abbrev_Header (DW_TAG_Compile_Unit, DW_CHILDREN_Yes);
+
+      Gen_Abbrev_Tuple (DW_AT_Stmt_List, DW_FORM_Data4);
+      Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+      Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+      Gen_Abbrev_Tuple (DW_AT_Producer, DW_FORM_String);
+      Gen_Abbrev_Tuple (DW_AT_Comp_Dir, DW_FORM_String);
+      Gen_Abbrev_Tuple (0, 0);
+
+      Abbrev_Last := 1;
+
+      --  Info.
+      Create_Section (Info_Sect, ".debug_info", Section_Debug);
+      Set_Section_Info (Info_Sect, null, 0, 0);
+      Set_Current_Section (Info_Sect);
+      Info_Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Info_Sym, False);
+
+      Gen_32 (7);  --  Length: to be patched.
+      Gen_16 (2);  --  version
+      Gen_Ua_32 (Abbrev_Sym, 0); --  Abbrev offset
+      Gen_B8 (4);  --  Ptr size.
+
+      --  Compile_unit.
+      Gen_Uleb128 (1);
+      Gen_Ua_32 (Line_Sym, 0);
+      Gen_Ua_32 (Orig_Sym, 0);
+      Gen_Ua_32 (End_Sym, 0);
+      Gen_String_Nul ("T.Gingold ortho_mcode (2004)");
+      Gen_String_Nul (GNAT.Directory_Operations.Get_Current_Dir);
+   end Init;
+
+   procedure Emit_Decl (Decl : O_Dnode);
+
+   --  Next node to be emitted.
+   Last_Decl : O_Dnode := O_Dnode_First;
+
+   procedure Emit_Decls_Until (Last : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      while Last_Decl < Last loop
+         Emit_Decl (Last_Decl);
+         Last_Decl := Get_Decl_Chain (Last_Decl);
+      end loop;
+   end Emit_Decls_Until;
+
+   procedure Finish
+   is
+      Length : Pc_Type;
+      Last : O_Dnode;
+   begin
+      Set_Symbol_Pc (End_Sym, False);
+      Length := Get_Current_Pc;
+
+      Last := Decls.Get_Decl_Last;
+      Emit_Decls_Until (Last);
+      if Last_Decl <= Last then
+         Emit_Decl (Last);
+      end if;
+
+      --  Finish abbrevs.
+      Set_Current_Section (Abbrev_Sect);
+      Gen_Uleb128 (0);
+
+      --  Emit header.
+      Set_Current_Section (Line_Sect);
+
+      --  Unit_Length (to be patched).
+      Gen_32 (0);
+      --  version
+      Gen_16 (2);
+      --  header_length (to be patched).
+      Gen_32 (5 + 12 + 1);
+      --  minimum_instruction_length.
+      Gen_B8 (Min_Insn_Len);
+      --  default_is_stmt
+      Gen_B8 (1);
+      --  line base
+      Gen_B8 (Line_Base);
+      --  line range
+      Gen_B8 (Line_Range);
+      --  opcode base
+      Gen_B8 (Line_Opcode_Base);
+      --  standard_opcode_length.
+      Gen_B8 (0); --  copy
+      Gen_B8 (1); --  advance pc
+      Gen_B8 (1); --  advance line
+      Gen_B8 (1); --  set file
+      Gen_B8 (1); --  set column
+      Gen_B8 (0); --  negate stmt
+      Gen_B8 (0); --  set basic block
+      Gen_B8 (0); --  const add pc
+      Gen_B8 (1); --  fixed advance pc
+      Gen_B8 (0); --  set prologue end
+      Gen_B8 (0); --  set epilogue begin
+      Gen_B8 (1); --  set isa
+      --if Line_Opcode_Base /= 13 then
+      --   raise Program_Error;
+      --end if;
+
+      --  include directories
+      declare
+         D : Dir_Chain_Acc;
+      begin
+         D := Dirs;
+         while D /= null loop
+            Gen_String_Nul (D.Name.all);
+            D := D.Next;
+         end loop;
+         Gen_B8 (0); -- last entry.
+      end;
+
+      --  file_names.
+      declare
+         F : File_Chain_Acc;
+      begin
+         F := Files;
+         while F /= null loop
+            Gen_String_Nul (F.Name.all);
+            Gen_Uleb128 (Unsigned_32 (F.Dir));
+            Gen_B8 (0);  --  time
+            Gen_B8 (0);  --  length
+            F := F.Next;
+         end loop;
+         Gen_B8 (0);  --  last entry.
+      end;
+
+      --  Set prolog length
+      Patch_32 (6, Unsigned_32 (Get_Current_Pc - 6));
+
+      Merge_Section (Line_Sect, Line1_Sect);
+
+      --  Emit end of sequence.
+      Gen_B8 (0); -- extended opcode
+      Gen_B8 (1); -- length: 1
+      Gen_B8 (Byte (DW_LNE_End_Sequence));
+
+      --  Set total length.
+      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
+
+      --  Info.
+      Set_Current_Section (Info_Sect);
+      --  Finish child.
+      Gen_Uleb128 (0);
+      --  Set total length.
+      Patch_32 (0, Unsigned_32 (Get_Current_Pc - 4));
+
+      --  Aranges
+      Create_Section (Aranges_Sect, ".debug_aranges", Section_Debug);
+      Set_Section_Info (Aranges_Sect, null, 0, 0);
+      Set_Current_Section (Aranges_Sect);
+
+      Gen_32 (28);  --  Length.
+      Gen_16 (2);  --  version
+      Gen_Ua_32 (Info_Sym, 0); --  info offset
+      Gen_B8 (4);  --  Ptr size.
+      Gen_B8 (0);  --  seg desc size.
+      Gen_32 (0);  --  pad
+      Gen_Ua_32 (Orig_Sym, 0); --  text offset
+      Gen_32 (Unsigned_32 (Length));
+      Gen_32 (0); --  End
+      Gen_32 (0);
+   end Finish;
+
+   procedure Generate_Abbrev (Abbrev : out Unsigned_32) is
+   begin
+      Abbrev_Last := Abbrev_Last + 1;
+      Abbrev := Abbrev_Last;
+
+      Set_Current_Section (Abbrev_Sect);
+      --  FIXME: should be enough ?
+      Prealloc (128);
+      Gen_Uleb128 (Abbrev);
+   end Generate_Abbrev;
+
+   procedure Gen_Info_Header (Abbrev : Unsigned_32) is
+   begin
+      Set_Current_Section (Info_Sect);
+      Gen_Uleb128 (Abbrev);
+   end Gen_Info_Header;
+
+   function Gen_Info_Sibling return Pc_Type
+   is
+      Pc : Pc_Type;
+   begin
+      Pc := Get_Current_Pc;
+      Gen_32 (0);
+      return Pc;
+   end Gen_Info_Sibling;
+
+   procedure Patch_Info_Sibling (Pc : Pc_Type) is
+   begin
+      Patch_32 (Pc, Unsigned_32 (Get_Current_Pc));
+   end Patch_Info_Sibling;
+
+   Abbrev_Base_Type : Unsigned_32 := 0;
+   Abbrev_Base_Type_Name : Unsigned_32 := 0;
+   Abbrev_Pointer : Unsigned_32 := 0;
+   Abbrev_Pointer_Name : Unsigned_32 := 0;
+   Abbrev_Uncomplete_Pointer : Unsigned_32 := 0;
+   Abbrev_Uncomplete_Pointer_Name : Unsigned_32 := 0;
+   Abbrev_Ucarray : Unsigned_32 := 0;
+   Abbrev_Ucarray_Name : Unsigned_32 := 0;
+   Abbrev_Uc_Subrange : Unsigned_32 := 0;
+   Abbrev_Subarray : Unsigned_32 := 0;
+   Abbrev_Subarray_Name : Unsigned_32 := 0;
+   Abbrev_Subrange : Unsigned_32 := 0;
+   Abbrev_Struct : Unsigned_32 := 0;
+   Abbrev_Struct_Name : Unsigned_32 := 0;
+   Abbrev_Union : Unsigned_32 := 0;
+   Abbrev_Union_Name : Unsigned_32 := 0;
+   Abbrev_Member : Unsigned_32 := 0;
+   Abbrev_Enum : Unsigned_32 := 0;
+   Abbrev_Enum_Name : Unsigned_32 := 0;
+   Abbrev_Enumerator : Unsigned_32 := 0;
+
+   package TOnodes is new GNAT.Table
+     (Table_Component_Type => Pc_Type,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   procedure Emit_Type_Ref (Atype : O_Tnode)
+   is
+      Off : Pc_Type;
+   begin
+      Off := TOnodes.Table (Atype);
+      if Off = Null_Pc then
+         raise Program_Error;
+      end if;
+      Gen_32 (Unsigned_32 (Off));
+   end Emit_Type_Ref;
+
+   procedure Emit_Ident (Id : O_Ident)
+   is
+      use Ortho_Ident;
+      L : Natural;
+   begin
+      L := Get_String_Length (Id);
+      Prealloc (Pc_Type (L) + 128);
+      Gen_String_Nul (Get_String (Id));
+   end Emit_Ident;
+
+   procedure Add_Type_Ref (Atype : O_Tnode; Pc : Pc_Type)
+   is
+      Prev : O_Tnode;
+   begin
+      if Atype > TOnodes.Last then
+         --  Expand.
+         Prev := TOnodes.Last;
+         TOnodes.Set_Last (Atype);
+         TOnodes.Table (Prev + 1 .. Atype - 1) := (others => Null_Pc);
+      end if;
+      TOnodes.Table (Atype) := Pc;
+   end Add_Type_Ref;
+
+   procedure Emit_Decl_Ident (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Ident (Get_Decl_Ident (Decl));
+   end Emit_Decl_Ident;
+
+   procedure Emit_Decl_Ident_If_Set (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      if Decl /= O_Dnode_Null then
+         Emit_Ident (Get_Decl_Ident (Decl));
+      end if;
+   end Emit_Decl_Ident_If_Set;
+
+   procedure Emit_Type (Atype : O_Tnode);
+
+   procedure Emit_Base_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Encoding, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Base_Type = 0 then
+            Generate_Abbrev (Abbrev_Base_Type);
+            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Base_Type);
+      else
+         if Abbrev_Base_Type_Name = 0 then
+            Generate_Abbrev (Abbrev_Base_Type_Name);
+            Gen_Abbrev_Header (DW_TAG_Base_Type, DW_CHILDREN_No);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Base_Type_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+
+      case Get_Type_Kind (Atype) is
+         when OT_Signed =>
+            Gen_B8 (DW_ATE_Signed);
+         when OT_Unsigned =>
+            Gen_B8 (DW_ATE_Unsigned);
+         when OT_Float =>
+            Gen_B8 (DW_ATE_Float);
+         when others =>
+            raise Program_Error;
+      end case;
+      Gen_B8 (Byte (Get_Type_Size (Atype)));
+   end Emit_Base_Type;
+
+   procedure Emit_Access_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      procedure Finish_Gen_Abbrev_Uncomplete is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev_Uncomplete;
+
+      Dtype : O_Tnode;
+      D_Pc : Pc_Type;
+   begin
+      Dtype := Get_Type_Access_Type (Atype);
+
+      if Dtype = O_Tnode_Null then
+         if Decl = O_Dnode_Null then
+            if Abbrev_Uncomplete_Pointer = 0 then
+               Generate_Abbrev (Abbrev_Uncomplete_Pointer);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Finish_Gen_Abbrev_Uncomplete;
+            end if;
+            Gen_Info_Header (Abbrev_Uncomplete_Pointer);
+         else
+            if Abbrev_Uncomplete_Pointer_Name = 0 then
+               Generate_Abbrev (Abbrev_Uncomplete_Pointer_Name);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+               Finish_Gen_Abbrev_Uncomplete;
+            end if;
+            Gen_Info_Header (Abbrev_Uncomplete_Pointer_Name);
+            Emit_Decl_Ident (Decl);
+         end if;
+         Gen_B8 (Byte (Get_Type_Size (Atype)));
+      else
+         if Decl = O_Dnode_Null then
+            if Abbrev_Pointer = 0 then
+               Generate_Abbrev (Abbrev_Pointer);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Finish_Gen_Abbrev;
+            end if;
+            Gen_Info_Header (Abbrev_Pointer);
+         else
+            if Abbrev_Pointer_Name = 0 then
+               Generate_Abbrev (Abbrev_Pointer_Name);
+               Gen_Abbrev_Header (DW_TAG_Pointer_Type, DW_CHILDREN_No);
+               Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+               Finish_Gen_Abbrev;
+            end if;
+            Gen_Info_Header (Abbrev_Pointer_Name);
+            Emit_Decl_Ident (Decl);
+         end if;
+         Gen_B8 (Byte (Get_Type_Size (Atype)));
+         --  Break possible loops: generate the access entry...
+         D_Pc := Get_Current_Pc;
+         Gen_32 (0);
+         --  ... generate the designated type ...
+         Emit_Type (Dtype);
+         --  ... and write its reference.
+         Patch_32 (D_Pc, Unsigned_32 (TOnodes.Table (Dtype)));
+      end if;
+   end Emit_Access_Type;
+
+   procedure Emit_Ucarray_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Ucarray = 0 then
+            Generate_Abbrev (Abbrev_Ucarray);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Ucarray);
+      else
+         if Abbrev_Ucarray_Name = 0 then
+            Generate_Abbrev (Abbrev_Ucarray_Name);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Ucarray_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+      Emit_Type_Ref (Get_Type_Ucarray_Element (Atype));
+
+      if Abbrev_Uc_Subrange = 0 then
+         Generate_Abbrev (Abbrev_Uc_Subrange);
+         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Uc_Subrange);
+      Emit_Type_Ref (Get_Type_Ucarray_Index (Atype));
+
+      Gen_Uleb128 (0);
+   end Emit_Ucarray_Type;
+
+   procedure Emit_Subarray_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      Base : O_Tnode;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Subarray = 0 then
+            Generate_Abbrev (Abbrev_Subarray);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Subarray);
+      else
+         if Abbrev_Subarray_Name = 0 then
+            Generate_Abbrev (Abbrev_Subarray_Name);
+            Gen_Abbrev_Header (DW_TAG_Array_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Subarray_Name);
+         Emit_Decl_Ident (Decl);
+      end if;
+
+      Base := Get_Type_Subarray_Base (Atype);
+
+      Emit_Type_Ref (Get_Type_Ucarray_Element (Base));
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
+
+      if Abbrev_Subrange = 0 then
+         Generate_Abbrev (Abbrev_Subrange);
+         Gen_Abbrev_Header (DW_TAG_Subrange_Type, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Lower_Bound, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (DW_AT_Count, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Subrange);
+      Emit_Type_Ref (Get_Type_Ucarray_Index (Base));
+      Gen_B8 (0);
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Subarray_Length (Atype)));
+
+      Gen_Uleb128 (0);
+   end Emit_Subarray_Type;
+
+   procedure Emit_Members (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      Nbr : Uns32;
+      F : O_Fnode;
+      Loc_Pc : Pc_Type;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Member = 0 then
+         Generate_Abbrev (Abbrev_Member);
+
+         Gen_Abbrev_Header (DW_TAG_Member, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Data_Member_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Set_Current_Section (Info_Sect);
+      Sibling_Pc := Gen_Info_Sibling;
+      Emit_Decl_Ident_If_Set (Decl);
+      Gen_Uleb128 (Unsigned_32 (Get_Type_Size (Atype)));
+
+      Nbr := Get_Type_Record_Nbr_Fields (Atype);
+      F := Get_Type_Record_Fields (Atype);
+      while Nbr > 0 loop
+         Gen_Uleb128 (Abbrev_Member);
+         Emit_Ident (Get_Field_Ident (F));
+         Emit_Type_Ref (Get_Field_Type (F));
+
+         --  Location.
+         Loc_Pc := Get_Current_Pc;
+         Gen_B8 (3);
+         Gen_B8 (DW_OP_Plus_Uconst);
+         Gen_Uleb128 (Unsigned_32 (Get_Field_Offset (F)));
+         Patch_B8 (Loc_Pc, Unsigned_8 (Get_Current_Pc - (Loc_Pc + 1)));
+
+         F := Get_Field_Chain (F);
+         Nbr := Nbr - 1;
+      end loop;
+
+      --  end of children.
+      Gen_Uleb128 (0);
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Members;
+
+   procedure Emit_Record_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Struct = 0 then
+            Generate_Abbrev (Abbrev_Struct);
+
+            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Struct);
+      else
+         if Abbrev_Struct_Name = 0 then
+            Generate_Abbrev (Abbrev_Struct_Name);
+
+            Gen_Abbrev_Header (DW_TAG_Structure_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Struct_Name);
+      end if;
+      Emit_Members (Atype, Decl);
+   end Emit_Record_Type;
+
+   procedure Emit_Union_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+   begin
+      if Decl = O_Dnode_Null then
+         if Abbrev_Union = 0 then
+            Generate_Abbrev (Abbrev_Union);
+
+            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Union);
+      else
+         if Abbrev_Union_Name = 0 then
+            Generate_Abbrev (Abbrev_Union_Name);
+
+            Gen_Abbrev_Header (DW_TAG_Union_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Union_Name);
+      end if;
+      Emit_Members (Atype, Decl);
+   end Emit_Union_Type;
+
+   procedure Emit_Enum_Type (Atype : O_Tnode; Decl : O_Dnode)
+   is
+      use Ortho_Code.Types;
+      use Ortho_Code.Consts;
+      procedure Finish_Gen_Abbrev is
+      begin
+         Gen_Abbrev_Tuple (DW_AT_Byte_Size, DW_FORM_Data1);
+         Gen_Abbrev_Tuple (0, 0);
+      end Finish_Gen_Abbrev;
+
+      procedure Emit_Enumerator (L : O_Cnode) is
+      begin
+         Gen_Uleb128 (Abbrev_Enumerator);
+         Emit_Ident (Get_Lit_Ident (L));
+         Gen_Uleb128 (Unsigned_32 (Get_Lit_Value (L)));
+      end Emit_Enumerator;
+
+      Nbr : Uns32;
+      L : O_Cnode;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Enumerator = 0 then
+         Generate_Abbrev (Abbrev_Enumerator);
+
+         Gen_Abbrev_Header (DW_TAG_Enumerator, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Const_Value, DW_FORM_Udata);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+      if Decl = O_Dnode_Null then
+         if Abbrev_Enum = 0 then
+            Generate_Abbrev (Abbrev_Enum);
+            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Enum);
+      else
+         if Abbrev_Enum_Name = 0 then
+            Generate_Abbrev (Abbrev_Enum_Name);
+            Gen_Abbrev_Header (DW_TAG_Enumeration_Type, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Finish_Gen_Abbrev;
+         end if;
+         Gen_Info_Header (Abbrev_Enum_Name);
+      end if;
+
+      Sibling_Pc := Gen_Info_Sibling;
+      Emit_Decl_Ident_If_Set (Decl);
+      Gen_B8 (Byte (Get_Type_Size (Atype)));
+      case Get_Type_Kind (Atype) is
+         when OT_Enum =>
+            Nbr := Get_Type_Enum_Nbr_Lits (Atype);
+            L := Get_Type_Enum_Lits (Atype);
+            while Nbr > 0 loop
+               Emit_Enumerator (L);
+
+               L := Get_Lit_Chain (L);
+               Nbr := Nbr - 1;
+            end loop;
+         when OT_Boolean =>
+            Emit_Enumerator (Get_Type_Bool_False (Atype));
+            Emit_Enumerator (Get_Type_Bool_True (Atype));
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  End of children.
+      Gen_Uleb128 (0);
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Enum_Type;
+
+   procedure Emit_Type (Atype : O_Tnode)
+   is
+      use Ortho_Code.Types;
+      use Ada.Text_IO;
+      Kind : OT_Kind;
+      Decl : O_Dnode;
+   begin
+      --  If already emitted, then return.
+      if Atype <= TOnodes.Last
+        and then TOnodes.Table (Atype) /= Null_Pc
+      then
+         return;
+      end if;
+
+      Kind := Get_Type_Kind (Atype);
+
+      --  First step: emit inner types (if any).
+      case Kind is
+         when OT_Signed
+           | OT_Unsigned
+           | OT_Float
+           | OT_Boolean
+           | OT_Enum =>
+            null;
+         when OT_Access =>
+            null;
+         when OT_Ucarray =>
+            Emit_Type (Get_Type_Ucarray_Index (Atype));
+            Emit_Type (Get_Type_Ucarray_Element (Atype));
+         when OT_Subarray =>
+            Emit_Type (Get_Type_Subarray_Base (Atype));
+         when OT_Record
+           | OT_Union =>
+            declare
+               Nbr : Uns32;
+               F : O_Fnode;
+            begin
+               Nbr := Get_Type_Record_Nbr_Fields (Atype);
+               F := Get_Type_Record_Fields (Atype);
+               while Nbr > 0 loop
+                  Emit_Type (Get_Field_Type (F));
+                  F := Get_Field_Chain (F);
+                  Nbr := Nbr - 1;
+               end loop;
+            end;
+         when OT_Complete =>
+            null;
+      end case;
+
+      Set_Current_Section (Info_Sect);
+      Add_Type_Ref (Atype, Get_Current_Pc);
+
+      Decl := Decls.Get_Type_Decl (Atype);
+
+      --  Second step: emit info.
+      case Kind is
+         when OT_Signed
+           | OT_Unsigned
+           | OT_Float =>
+            Emit_Base_Type (Atype, Decl);
+            -- base types.
+         when OT_Access =>
+            Emit_Access_Type (Atype, Decl);
+         when OT_Ucarray =>
+            Emit_Ucarray_Type (Atype, Decl);
+         when OT_Subarray =>
+            Emit_Subarray_Type (Atype, Decl);
+         when OT_Record =>
+            Emit_Record_Type (Atype, Decl);
+         when OT_Union =>
+            Emit_Union_Type (Atype, Decl);
+         when OT_Enum
+           | OT_Boolean =>
+            Emit_Enum_Type (Atype, Decl);
+         when OT_Complete =>
+            null;
+      end case;
+   end Emit_Type;
+
+   procedure Emit_Decl_Type (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Type_Ref (Get_Decl_Type (Decl));
+   end Emit_Decl_Type;
+
+   Abbrev_Variable : Unsigned_32 := 0;
+   Abbrev_Const : Unsigned_32 := 0;
+
+   procedure Emit_Local_Location (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Pc : Pc_Type;
+   begin
+      Pc := Get_Current_Pc;
+      Gen_B8 (2);
+      Gen_B8 (DW_OP_Fbreg);
+      Gen_Sleb128 (Get_Decl_Info (Decl));
+      Patch_B8 (Pc, Unsigned_8 (Get_Current_Pc - (Pc + 1)));
+   end Emit_Local_Location;
+
+   procedure Emit_Global_Location (Decl : O_Dnode)
+   is
+      use Ortho_Code.Binary;
+   begin
+      Gen_B8 (5);
+      Gen_B8 (DW_OP_Addr);
+      Gen_Ua_32 (Get_Decl_Symbol (Decl), 0);
+   end Emit_Global_Location;
+
+   procedure Emit_Variable (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Dtype : O_Tnode;
+   begin
+      if Get_Decl_Ident (Decl) = O_Ident_Nul then
+         return;
+      end if;
+
+      if Abbrev_Variable = 0 then
+         Generate_Abbrev (Abbrev_Variable);
+         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Dtype := Get_Decl_Type (Decl);
+      Emit_Type (Dtype);
+
+      Gen_Info_Header (Abbrev_Variable);
+      Emit_Decl_Ident (Decl);
+      Emit_Type_Ref (Dtype);
+      case Get_Decl_Kind (Decl) is
+         when OD_Local =>
+            Emit_Local_Location (Decl);
+         when OD_Var =>
+            Emit_Global_Location (Decl);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Emit_Variable;
+
+   procedure Emit_Const (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Dtype : O_Tnode;
+   begin
+      if Abbrev_Const = 0 then
+         Generate_Abbrev (Abbrev_Const);
+         --  FIXME: should be a TAG_Constant, however, GDB does not support it.
+         --  work-around: could use a const_type.
+         Gen_Abbrev_Header (DW_TAG_Variable, DW_CHILDREN_No);
+
+         Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+         Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Dtype := Get_Decl_Type (Decl);
+      Emit_Type (Dtype);
+      Gen_Info_Header (Abbrev_Const);
+      Emit_Decl_Ident (Decl);
+      Emit_Type_Ref (Dtype);
+      Emit_Global_Location (Decl);
+   end Emit_Const;
+
+   procedure Emit_Type_Decl (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+   begin
+      Emit_Type (Get_Decl_Type (Decl));
+   end Emit_Type_Decl;
+
+   Subprg_Sym : Symbol;
+
+   Abbrev_Block : Unsigned_32 := 0;
+
+   procedure Emit_Block_Decl (Decl : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Last : O_Dnode;
+      Sdecl : O_Dnode;
+      Sibling_Pc : Pc_Type;
+   begin
+      if Abbrev_Block = 0 then
+         Generate_Abbrev (Abbrev_Block);
+
+         Gen_Abbrev_Header (DW_TAG_Lexical_Block, DW_CHILDREN_Yes);
+         Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+         Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+         Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+         Gen_Abbrev_Tuple (0, 0);
+      end if;
+
+      Gen_Info_Header (Abbrev_Block);
+      Sibling_Pc := Gen_Info_Sibling;
+
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info1 (Decl)));
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Block_Info2 (Decl)));
+
+      --  Emit decls for children.
+      Last := Get_Block_Last (Decl);
+      Sdecl := Decl + 1;
+      while Sdecl <= Last loop
+         Emit_Decl (Sdecl);
+         Sdecl := Get_Decl_Chain (Sdecl);
+      end loop;
+
+      --  End of children.
+      Set_Current_Section (Info_Sect);
+      Gen_Uleb128 (0);
+
+      Patch_Info_Sibling (Sibling_Pc);
+   end Emit_Block_Decl;
+
+   Abbrev_Function : Unsigned_32 := 0;
+   Abbrev_Procedure : Unsigned_32 := 0;
+   Abbrev_Interface : Unsigned_32 := 0;
+
+   procedure Emit_Subprg_Body (Bod : O_Dnode)
+   is
+      use Ortho_Code.Decls;
+      Kind : OD_Kind;
+      Decl : O_Dnode;
+      Idecl : O_Dnode;
+      Prev_Subprg_Sym : Symbol;
+      Sibling_Pc : Pc_Type;
+   begin
+      Decl := Get_Body_Decl (Bod);
+      Kind := Get_Decl_Kind (Decl);
+
+      --  Emit interfaces type.
+      Idecl := Get_Subprg_Interfaces (Decl);
+      while Idecl /= O_Dnode_Null loop
+         Emit_Type (Get_Decl_Type (Idecl));
+         Idecl := Get_Interface_Chain (Idecl);
+      end loop;
+
+      if Kind = OD_Function then
+         Emit_Type (Get_Decl_Type (Decl));
+         if Abbrev_Function = 0 then
+            Generate_Abbrev (Abbrev_Function);
+
+            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+
+            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+         Gen_Info_Header (Abbrev_Function);
+      else
+         if Abbrev_Procedure = 0 then
+            Generate_Abbrev (Abbrev_Procedure);
+
+            Gen_Abbrev_Header (DW_TAG_Subprogram, DW_CHILDREN_Yes);
+            Gen_Abbrev_Tuple (DW_AT_Sibling, DW_FORM_Ref4);
+
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Low_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_High_Pc, DW_FORM_Addr);
+            Gen_Abbrev_Tuple (DW_AT_Frame_Base, DW_FORM_Block1);
+            --Gen_Abbrev_Tuple (DW_AT_Return_Addr, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+         Gen_Info_Header (Abbrev_Procedure);
+      end if;
+
+      Sibling_Pc := Gen_Info_Sibling;
+
+      if Kind = OD_Function then
+         Emit_Decl_Type (Decl);
+      end if;
+
+      Emit_Decl_Ident (Decl);
+      Prev_Subprg_Sym := Subprg_Sym;
+      Subprg_Sym := Binary.Get_Decl_Symbol (Decl);
+      Gen_Ua_32 (Subprg_Sym, 0);
+      Gen_Ua_32 (Subprg_Sym, Integer_32 (Get_Body_Info (Bod)));
+
+      --  Frame base.
+      Gen_B8 (1);
+      Gen_B8 (DW_OP_Reg5);
+
+      --  Interfaces.
+      Idecl := Get_Subprg_Interfaces (Decl);
+      if Idecl /= O_Dnode_Null then
+         if Abbrev_Interface = 0 then
+            Generate_Abbrev (Abbrev_Interface);
+
+            Gen_Abbrev_Header (DW_TAG_Formal_Parameter, DW_CHILDREN_No);
+            Gen_Abbrev_Tuple (DW_AT_Type, DW_FORM_Ref4);
+            Gen_Abbrev_Tuple (DW_AT_Name, DW_FORM_String);
+            Gen_Abbrev_Tuple (DW_AT_Location, DW_FORM_Block1);
+            Gen_Abbrev_Tuple (0, 0);
+         end if;
+
+         loop
+            Gen_Info_Header (Abbrev_Interface);
+            Emit_Decl_Type (Idecl);
+            Emit_Decl_Ident (Idecl);
+
+            Emit_Local_Location (Idecl);
+
+            Idecl := Get_Interface_Chain (Idecl);
+            exit when Idecl = O_Dnode_Null;
+         end loop;
+      end if;
+
+      --  Internal declarations.
+      Emit_Block_Decl (Bod + 1);
+
+      --  End of children.
+      Gen_Uleb128 (0);
+
+      Patch_Info_Sibling (Sibling_Pc);
+
+      Subprg_Sym := Prev_Subprg_Sym;
+   end Emit_Subprg_Body;
+
+   procedure Emit_Decl (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Decls;
+   begin
+      case Get_Decl_Kind (Decl) is
+         when OD_Type =>
+            Emit_Type_Decl (Decl);
+         when OD_Local
+           | OD_Var =>
+            Emit_Variable (Decl);
+         when OD_Const =>
+            Emit_Const (Decl);
+         when OD_Function
+           | OD_Procedure
+           | OD_Interface =>
+            null;
+         when OD_Body =>
+            Emit_Subprg_Body (Decl);
+         when OD_Block =>
+            Emit_Block_Decl (Decl);
+         when others =>
+            Put_Line ("dwarf.emit_decl: emit "
+                      & OD_Kind'Image (Get_Decl_Kind (Decl)));
+      end case;
+   end Emit_Decl;
+
+   procedure Emit_Subprg (Bod : O_Dnode) is
+   begin
+      Emit_Decls_Until (Bod);
+      Emit_Decl (Bod);
+      Last_Decl := Decls.Get_Decl_Chain (Bod);
+   end Emit_Subprg;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Last_Decl := Last_Decl;
+      M.Last_Tnode := TOnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Last_Decl := M.Last_Decl;
+      TOnodes.Set_Last (M.Last_Tnode);
+   end Release;
+
+end Ortho_Code.Dwarf;
+
diff --git a/src/ortho/mcode/ortho_code-dwarf.ads b/src/ortho/mcode/ortho_code-dwarf.ads
new file mode 100644
index 000000000..c120bcfe1
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-dwarf.ads
@@ -0,0 +1,41 @@
+--  Mcode back-end for ortho - Dwarf generator.
+--  Copyright (C) 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.
+package Ortho_Code.Dwarf is
+   procedure Init;
+   procedure Finish;
+
+   --  For a body.
+   procedure Emit_Subprg (Bod : O_Dnode);
+
+   --  Emit all debug info until but not including LAST.
+   procedure Emit_Decls_Until (Last : O_Dnode);
+
+   --  For a line in a subprogram.
+   procedure Set_Line_Stmt (Line : Int32);
+   procedure Set_Filename (Dir : String; File : String);
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+private
+   type Mark_Type is record
+      Last_Decl : O_Dnode;
+      Last_Tnode : O_Tnode;
+   end record;
+end Ortho_Code.Dwarf;
diff --git a/src/ortho/mcode/ortho_code-exprs.adb b/src/ortho/mcode/ortho_code-exprs.adb
new file mode 100644
index 000000000..b2dfa1a67
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-exprs.adb
@@ -0,0 +1,1663 @@
+--  Mcode back-end for ortho - Expressions and control handling.
+--  Copyright (C) 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 Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.Table;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Debug; use Ortho_Code.Debug;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Code.Disps;
+with Ortho_Code.Opts;
+with Ortho_Code.Flags;
+
+package body Ortho_Code.Exprs is
+
+   type Enode_Pad is mod 256;
+
+   type Enode_Common is record
+      Kind : OE_Kind; --  about 1 byte (6 bits)
+      Reg : O_Reg; --  1 byte
+      Mode : Mode_Type; -- 4 bits
+      Ref : Boolean;
+      Flag1 : Boolean;
+      Flag2 : Boolean;
+      Flag3 : Boolean;
+      Pad : Enode_Pad;
+      Arg1 : O_Enode;
+      Arg2 : O_Enode;
+      Info : Int32;
+   end record;
+   pragma Pack (Enode_Common);
+   for Enode_Common'Size use 4*32;
+   for Enode_Common'Alignment use 4;
+
+   package Enodes is new GNAT.Table
+     (Table_Component_Type => Enode_Common,
+      Table_Index_Type => O_Enode,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   function Get_Expr_Kind (Enode : O_Enode) return OE_Kind is
+   begin
+      return Enodes.Table (Enode).Kind;
+   end Get_Expr_Kind;
+
+   function Get_Expr_Mode (Enode : O_Enode) return Mode_Type is
+   begin
+      return Enodes.Table (Enode).Mode;
+   end Get_Expr_Mode;
+
+   function Get_Enode_Type (Enode : O_Enode) return O_Tnode is
+   begin
+      return O_Tnode (Enodes.Table (Enode).Info);
+   end Get_Enode_Type;
+
+   function Get_Expr_Reg (Enode : O_Enode) return O_Reg is
+   begin
+      return Enodes.Table (Enode).Reg;
+   end Get_Expr_Reg;
+
+   procedure Set_Expr_Reg (Enode : O_Enode; Reg : O_Reg) is
+   begin
+      Enodes.Table (Enode).Reg := Reg;
+   end Set_Expr_Reg;
+
+   function Get_Expr_Operand (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Expr_Operand;
+
+   procedure Set_Expr_Operand (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Val;
+   end Set_Expr_Operand;
+
+   function Get_Expr_Left (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Expr_Left;
+
+   function Get_Expr_Right (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Expr_Right;
+
+   procedure Set_Expr_Left (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Val;
+   end Set_Expr_Left;
+
+   procedure Set_Expr_Right (Enode : O_Enode; Val : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Val;
+   end Set_Expr_Right;
+
+   function Get_Expr_Low (Cst : O_Enode) return Uns32 is
+   begin
+      return To_Uns32 (Int32 (Enodes.Table (Cst).Arg1));
+   end Get_Expr_Low;
+
+   function Get_Expr_High (Cst : O_Enode) return Uns32 is
+   begin
+      return To_Uns32 (Int32 (Enodes.Table (Cst).Arg2));
+   end Get_Expr_High;
+
+   function Get_Assign_Target (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Assign_Target;
+
+   procedure Set_Assign_Target (Enode : O_Enode; Targ : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Targ;
+   end Set_Assign_Target;
+
+   function Get_Expr_Lit (Lit : O_Enode) return O_Cnode is
+   begin
+      return O_Cnode (Enodes.Table (Lit).Arg1);
+   end Get_Expr_Lit;
+
+   function Get_Conv_Type (Enode : O_Enode) return O_Tnode is
+   begin
+      return O_Tnode (Enodes.Table (Enode).Arg2);
+   end Get_Conv_Type;
+
+   --  Leave node corresponding to the entry.
+   function Get_Entry_Leave (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg1;
+   end Get_Entry_Leave;
+
+   procedure Set_Entry_Leave (Enode : O_Enode; Leave : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg1 := Leave;
+   end Set_Entry_Leave;
+
+   function Get_Jump_Label (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Jump_Label;
+
+   procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Label;
+   end Set_Jump_Label;
+
+   function Get_Addr_Object (Enode : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Enode).Arg1);
+   end Get_Addr_Object;
+
+   function Get_Addrl_Frame (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Addrl_Frame;
+
+   procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode) is
+   begin
+      Enodes.Table (Enode).Arg2 := Frame;
+   end Set_Addrl_Frame;
+
+   function Get_Call_Subprg (Enode : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Enode).Arg1);
+   end Get_Call_Subprg;
+
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Enode).Arg1);
+   end Get_Stack_Adjust;
+
+   function Get_Arg_Link (Enode : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Enode).Arg2;
+   end Get_Arg_Link;
+
+   function Get_Block_Decls (Blk : O_Enode) return O_Dnode is
+   begin
+      return O_Dnode (Enodes.Table (Blk).Arg2);
+   end Get_Block_Decls;
+
+   function Get_Block_Parent (Blk : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Blk).Arg1;
+   end Get_Block_Parent;
+
+   function Get_Block_Has_Alloca (Blk : O_Enode) return Boolean is
+   begin
+      return Enodes.Table (Blk).Flag1;
+   end Get_Block_Has_Alloca;
+
+   procedure Set_Block_Has_Alloca (Blk : O_Enode; Flag : Boolean) is
+   begin
+      Enodes.Table (Blk).Flag1 := Flag;
+   end Set_Block_Has_Alloca;
+
+   function Get_End_Beg (Blk : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Blk).Arg1;
+   end Get_End_Beg;
+
+   function Get_Label_Info (Label : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Label).Arg2);
+   end Get_Label_Info;
+
+   procedure Set_Label_Info (Label : O_Enode; Info : Int32) is
+   begin
+      Enodes.Table (Label).Arg2 := O_Enode (Info);
+   end Set_Label_Info;
+
+   function Get_Label_Block (Label : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Label).Arg1;
+   end Get_Label_Block;
+
+   function Get_Spill_Info (Spill : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Spill).Arg2);
+   end Get_Spill_Info;
+
+   procedure Set_Spill_Info (Spill : O_Enode; Info : Int32) is
+   begin
+      Enodes.Table (Spill).Arg2 := O_Enode (Info);
+   end Set_Spill_Info;
+
+   --  Get the statement link.
+   function Get_Stmt_Link (Stmt : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Enodes.Table (Stmt).Info);
+   end Get_Stmt_Link;
+
+   procedure Set_Stmt_Link (Stmt : O_Enode; Next : O_Enode) is
+   begin
+      Enodes.Table (Stmt).Info := Int32 (Next);
+   end Set_Stmt_Link;
+
+   function Get_BB_Next (Stmt : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Stmt).Arg1;
+   end Get_BB_Next;
+   pragma Unreferenced (Get_BB_Next);
+
+   procedure Set_BB_Next (Stmt : O_Enode; Next : O_Enode) is
+   begin
+      Enodes.Table (Stmt).Arg1 := Next;
+   end Set_BB_Next;
+
+   function Get_BB_Number (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg2);
+   end Get_BB_Number;
+
+   function Get_Loop_Level (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Loop_Level;
+
+   procedure Set_Loop_Level (Stmt : O_Enode; Level : Int32) is
+   begin
+      Enodes.Table (Stmt).Arg1 := O_Enode (Level);
+   end Set_Loop_Level;
+
+   procedure Set_Case_Branch (C : O_Enode; Branch : O_Enode) is
+   begin
+      Enodes.Table (C).Arg2 := Branch;
+   end Set_Case_Branch;
+
+   procedure Set_Case_Branch_Choice (Branch : O_Enode; Choice : O_Enode) is
+   begin
+      Enodes.Table (Branch).Arg1 := Choice;
+   end Set_Case_Branch_Choice;
+
+   function Get_Case_Branch_Choice (Branch : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Branch).Arg1;
+   end Get_Case_Branch_Choice;
+
+   procedure Set_Case_Choice_Link (Choice : O_Enode; N_Choice : O_Enode) is
+   begin
+      Enodes.Table (Choice).Info := Int32 (N_Choice);
+   end Set_Case_Choice_Link;
+
+   function Get_Case_Choice_Link (Choice : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Enodes.Table (Choice).Info);
+   end Get_Case_Choice_Link;
+
+   function Get_Ref_Field (Ref : O_Enode) return O_Fnode is
+   begin
+      return O_Fnode (Enodes.Table (Ref).Arg2);
+   end Get_Ref_Field;
+
+   function Get_Ref_Index (Ref : O_Enode) return O_Enode is
+   begin
+      return Enodes.Table (Ref).Arg2;
+   end Get_Ref_Index;
+
+   function Get_Expr_Line_Number (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Expr_Line_Number;
+
+   function Get_Intrinsic_Operation (Stmt : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Stmt).Arg1);
+   end Get_Intrinsic_Operation;
+
+   Last_Stmt : O_Enode := O_Enode_Null;
+
+   procedure Link_Stmt (Stmt : O_Enode) is
+   begin
+      if Last_Stmt = O_Enode_Null then
+         raise Program_Error;
+      end if;
+      Set_Stmt_Link (Last_Stmt, Stmt);
+      Last_Stmt := Stmt;
+   end Link_Stmt;
+
+   function New_Enode (Kind : OE_Kind;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode
+   is
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Type_Mode (Rtype);
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => Int32 (Rtype)));
+      return Enodes.Last;
+   end New_Enode;
+
+   function New_Enode (Kind : OE_Kind;
+                       Mode : Mode_Type;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => Int32 (Rtype)));
+      return Enodes.Last;
+   end New_Enode;
+
+   procedure New_Enode_Stmt (Kind : OE_Kind; Arg1 : O_Enode; Arg2 : O_Enode)
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode_Nil,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => 0));
+      Link_Stmt (Enodes.Last);
+   end New_Enode_Stmt;
+
+   procedure New_Enode_Stmt
+     (Kind : OE_Kind; Mode : Mode_Type; Arg1 : O_Enode; Arg2 : O_Enode)
+   is
+   begin
+      Enodes.Append (Enode_Common'(Kind => Kind,
+                                   Reg => 0,
+                                   Mode => Mode,
+                                   Ref => False,
+                                   Flag1 => False,
+                                   Flag2 => False,
+                                   Flag3 => False,
+                                   Pad => 0,
+                                   Arg1 => Arg1,
+                                   Arg2 => Arg2,
+                                   Info => 0));
+      Link_Stmt (Enodes.Last);
+   end New_Enode_Stmt;
+
+   Bb_Num : Int32 := 0;
+   Last_Bb : O_Enode := O_Enode_Null;
+
+   procedure Create_BB is
+   begin
+      New_Enode_Stmt (OE_BB, Mode_Nil, O_Enode_Null, O_Enode (Bb_Num));
+      if Last_Bb /= O_Enode_Null then
+         Set_BB_Next (Last_Bb, Enodes.Last);
+      end if;
+      Last_Bb := Enodes.Last;
+      Bb_Num := Bb_Num + 1;
+   end Create_BB;
+
+   procedure Start_BB is
+   begin
+      if Flags.Flag_Opt_BB then
+         Create_BB;
+      end if;
+   end Start_BB;
+   pragma Inline (Start_BB);
+
+   procedure Check_Ref (E : O_Enode) is
+   begin
+      if Enodes.Table (E).Ref then
+         raise Syntax_Error;
+      end if;
+      Enodes.Table (E).Ref := True;
+   end Check_Ref;
+
+   procedure Check_Ref (E : O_Lnode) is
+   begin
+      Check_Ref (O_Enode (E));
+   end Check_Ref;
+
+   procedure Check_Value_Type (Val : O_Enode; Vtype : O_Tnode) is
+   begin
+      if Get_Enode_Type (Val) /= Vtype then
+         raise Syntax_Error;
+      end if;
+   end Check_Value_Type;
+
+   function New_Const_U32 (Val : Uns32; Vtype : O_Tnode) return O_Enode
+   is
+   begin
+      return New_Enode (OE_Const, Vtype,
+                        O_Enode (To_Int32 (Val)), O_Enode_Null);
+   end New_Const_U32;
+
+   Last_Decl : O_Dnode := 2;
+   Cur_Block : O_Enode := O_Enode_Null;
+
+   procedure Start_Declare_Stmt
+   is
+      Res : O_Enode;
+   begin
+      New_Enode_Stmt (OE_Beg, Cur_Block, O_Enode_Null);
+      Res := Enodes.Last;
+      Enodes.Table (Res).Arg2 := O_Enode
+        (Ortho_Code.Decls.Start_Declare_Stmt);
+      Cur_Block := Res;
+   end Start_Declare_Stmt;
+
+   function New_Stack (Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Enode (OE_Get_Stack, Rtype, O_Enode_Null, O_Enode_Null);
+   end New_Stack;
+
+   procedure New_Stack_Restore (Blk : O_Enode)
+   is
+      Save_Asgn : O_Enode;
+      Save_Var : O_Dnode;
+   begin
+      Save_Asgn := Get_Stmt_Link (Blk);
+      Save_Var := Get_Addr_Object (Get_Assign_Target (Save_Asgn));
+      New_Enode_Stmt (OE_Set_Stack, New_Value (New_Obj (Save_Var)),
+                      O_Enode_Null);
+   end New_Stack_Restore;
+
+   procedure Finish_Declare_Stmt
+   is
+      Parent : O_Dnode;
+   begin
+      if Get_Block_Has_Alloca (Cur_Block) then
+         New_Stack_Restore (Cur_Block);
+      end if;
+      New_Enode_Stmt (OE_End, Cur_Block, O_Enode_Null);
+      Cur_Block := Get_Block_Parent (Cur_Block);
+      if Cur_Block = O_Enode_Null then
+         Parent := O_Dnode_Null;
+      else
+         Parent := Get_Block_Decls (Cur_Block);
+      end if;
+      Ortho_Code.Decls.Finish_Declare_Stmt (Parent);
+   end Finish_Declare_Stmt;
+
+   function New_Label return O_Enode is
+   begin
+      return New_Enode (OE_Label, Mode_Nil, O_Tnode_Null,
+                        Cur_Block, O_Enode_Null);
+   end New_Label;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode)
+   is
+      Start : O_Enode;
+      D_Body : O_Dnode;
+      Data : Subprogram_Data_Acc;
+   begin
+      if Cur_Subprg = null then
+         Abi.Start_Body (Func);
+      end if;
+
+      Start := New_Enode (OE_Entry, Mode_Nil, O_Tnode_Null,
+                          Last_Stmt, O_Enode_Null);
+      D_Body := Decls.Start_Subprogram_Body (Func, Start);
+
+      --  Create the corresponding decl.
+      Enodes.Table (Start).Arg2 := O_Enode (D_Body);
+
+      --  Create the data record.
+      Data := new Subprogram_Data'(Parent => Cur_Subprg,
+                                   First_Child => null,
+                                   Last_Child => null,
+                                   Brother => null,
+                                   Depth => Get_Decl_Depth (Func),
+                                   D_Decl => Func,
+                                   E_Entry => Start,
+                                   D_Body => D_Body,
+                                   Exit_Label => O_Enode_Null,
+                                   Last_Stmt => O_Enode_Null,
+                                   Stack_Max => 0);
+
+      if not Flag_Debug_Hli then
+         Data.Exit_Label := New_Label;
+      end if;
+
+      --  Link the record.
+      if Cur_Subprg = null then
+         --  A top-level subprogram.
+         if First_Subprg = null then
+            First_Subprg := Data;
+         else
+            Last_Subprg.Brother := Data;
+         end if;
+         Last_Subprg := Data;
+      else
+         --  A nested subprogram.
+         if Cur_Subprg.First_Child = null then
+            Cur_Subprg.First_Child := Data;
+         else
+            Cur_Subprg.Last_Child.Brother := Data;
+         end if;
+         Cur_Subprg.Last_Child := Data;
+
+         --  Also save last_stmt.
+         Cur_Subprg.Last_Stmt := Last_Stmt;
+      end if;
+
+      Cur_Subprg := Data;
+      Last_Stmt := Start;
+
+      Start_Declare_Stmt;
+
+      --  Create a basic block for the beginning of the subprogram.
+      Start_BB;
+
+      --  Disp declarations.
+      if Cur_Subprg.Parent = null then
+         if Ortho_Code.Debug.Flag_Debug_Body
+           or Ortho_Code.Debug.Flag_Debug_Code
+         then
+            while Last_Decl <= D_Body loop
+               case Get_Decl_Kind (Last_Decl) is
+                  when OD_Block =>
+                     --  Skip blocks.
+                     Disp_Decl (1, Last_Decl);
+                     Last_Decl := Get_Block_Last (Last_Decl) + 1;
+                  when others =>
+                     Disp_Decl (1, Last_Decl);
+                     Last_Decl := Last_Decl + 1;
+               end case;
+            end loop;
+         end if;
+      end if;
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+   is
+      Parent : Subprogram_Data_Acc;
+   begin
+      Finish_Declare_Stmt;
+
+      --  Create a new basic block for the epilog.
+      Start_BB;
+
+      if not Flag_Debug_Hli then
+         Link_Stmt (Cur_Subprg.Exit_Label);
+      end if;
+
+      New_Enode_Stmt (OE_Leave, O_Enode_Null, O_Enode_Null);
+
+      --  Save last statement.
+      Cur_Subprg.Last_Stmt := Enodes.Last;
+      --  Set Leave of Entry.
+      Set_Entry_Leave (Cur_Subprg.E_Entry, Enodes.Last);
+
+      Decls.Finish_Subprogram_Body;
+
+      Parent := Cur_Subprg.Parent;
+
+      if Flags.Flag_Optimize then
+         Opts.Optimize_Subprg (Cur_Subprg);
+      end if;
+
+      if Parent = null then
+         --  This is a top-level subprogram.
+         if Ortho_Code.Debug.Flag_Disp_Code then
+            Disps.Disp_Subprg (Cur_Subprg);
+         end if;
+         if Ortho_Code.Debug.Flag_Dump_Code then
+            Disp_Subprg_Body (1, Cur_Subprg.E_Entry);
+         end if;
+         if not Ortho_Code.Debug.Flag_Debug_Dump then
+            Abi.Finish_Body (Cur_Subprg);
+         end if;
+      end if;
+
+      --  Restore Cur_Subprg.
+      Cur_Subprg := Parent;
+
+      --  Restore Last_Stmt.
+      if Cur_Subprg = null then
+         Last_Stmt := O_Enode_Null;
+      else
+         Last_Stmt := Cur_Subprg.Last_Stmt;
+      end if;
+   end Finish_Subprogram_Body;
+
+   function Get_Inner_Alloca (Label : O_Enode) return O_Enode
+   is
+      Res : O_Enode := O_Enode_Null;
+      Blk : O_Enode;
+      Last_Blk : constant O_Enode := Get_Label_Block (Label);
+   begin
+      Blk := Cur_Block;
+      while Blk /= Last_Blk loop
+         if Get_Block_Has_Alloca (Blk) then
+            Res := Blk;
+         end if;
+         Blk := Get_Block_Parent (Blk);
+      end loop;
+      return Res;
+   end Get_Inner_Alloca;
+
+   procedure Emit_Jmp (Code : OE_Kind; Expr : O_Enode; Label : O_Enode)
+   is
+   begin
+      --  Discard jump after jump.
+      if Code /= OE_Jump or else Get_Expr_Kind (Last_Stmt) /= OE_Jump then
+         New_Enode_Stmt (Code, Expr, Label);
+      end if;
+   end Emit_Jmp;
+
+
+   --  If there is stack allocated memory to be freed, free it.
+   --  Then jump to LABEL.
+   procedure New_Allocb_Jump (Label : O_Enode)
+   is
+      Inner_Alloca : O_Enode;
+   begin
+      Inner_Alloca := Get_Inner_Alloca (Label);
+      if Inner_Alloca /= O_Enode_Null then
+         New_Stack_Restore (Inner_Alloca);
+      end if;
+      Emit_Jmp (OE_Jump, O_Enode_Null, Label);
+   end New_Allocb_Jump;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode
+   is
+      L_Type : O_Tnode;
+      H, L : Uns32;
+   begin
+      L_Type := Get_Const_Type (Lit);
+      if Flag_Debug_Hli then
+         return New_Enode (OE_Lit, L_Type, O_Enode (Lit), O_Enode_Null);
+      else
+         case Get_Const_Kind (Lit) is
+            when OC_Signed
+              | OC_Unsigned
+              | OC_Float
+              | OC_Null
+              | OC_Lit =>
+               Get_Const_Bytes (Lit, H, L);
+               return New_Enode
+                 (OE_Const, L_Type,
+                  O_Enode (To_Int32 (L)), O_Enode (To_Int32 (H)));
+            when OC_Address
+              | OC_Subprg_Address =>
+               return New_Enode (OE_Addrg, L_Type,
+                                 O_Enode (Get_Const_Decl (Lit)), O_Enode_Null);
+            when OC_Array
+              | OC_Record
+              | OC_Union
+              | OC_Sizeof
+              | OC_Alignof =>
+               raise Syntax_Error;
+         end case;
+      end if;
+   end New_Lit;
+
+   function Get_Static_Chain (Depth : O_Depth) return O_Enode
+   is
+      Cur_Depth : O_Depth := Cur_Subprg.Depth;
+      Subprg : Subprogram_Data_Acc;
+      Res : O_Enode;
+   begin
+      if Depth = Cur_Depth then
+         return New_Enode (OE_Get_Frame, Abi.Mode_Ptr, O_Tnode_Ptr,
+                           O_Enode_Null, O_Enode_Null);
+      else
+         Subprg := Cur_Subprg;
+         Res := O_Enode_Null;
+         loop
+            --  The static chain is the first interface of the subprogram.
+            Res := New_Enode (OE_Addrl, Abi.Mode_Ptr, O_Tnode_Ptr,
+                              O_Enode (Get_Subprg_Interfaces (Subprg.D_Decl)),
+                              Res);
+            Res := New_Enode (OE_Indir, O_Tnode_Ptr, Res, O_Enode_Null);
+            Cur_Depth := Cur_Depth - 1;
+            if Cur_Depth = Depth then
+               return Res;
+            end if;
+            Subprg := Subprg.Parent;
+         end loop;
+      end if;
+   end Get_Static_Chain;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode
+   is
+      O_Type : O_Tnode;
+      Kind : OE_Kind;
+      Chain : O_Enode;
+      Depth : O_Depth;
+   begin
+      O_Type := Get_Decl_Type (Obj);
+      case Get_Decl_Kind (Obj) is
+         when OD_Local
+           | OD_Interface =>
+            Kind := OE_Addrl;
+            --  Local declarations are 1 deeper than their subprogram.
+            Depth := Get_Decl_Depth (Obj) - 1;
+            if Depth /= Cur_Subprg.Depth then
+               Chain := Get_Static_Chain (Depth);
+            else
+               Chain := O_Enode_Null;
+            end if;
+         when OD_Var
+           | OD_Const =>
+            Kind := OE_Addrg;
+            Chain := O_Enode_Null;
+         when others =>
+            raise Program_Error;
+      end case;
+      return O_Lnode (New_Enode (Kind, Abi.Mode_Ptr, O_Type,
+                                 O_Enode (Obj), Chain));
+   end New_Obj;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode
+   is
+      L_Type : O_Tnode;
+   begin
+      L_Type := Get_Enode_Type (Left);
+      if Flag_Debug_Assert then
+         if L_Type /= Get_Enode_Type (Right) then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Mode (L_Type) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Left);
+         Check_Ref (Right);
+      end if;
+
+      return New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)),
+                        L_Type, Left, Right);
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode
+   is
+      O_Type : O_Tnode;
+   begin
+      O_Type := Get_Enode_Type (Operand);
+
+      if Flag_Debug_Assert then
+         if Get_Type_Mode (O_Type) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Operand);
+      end if;
+
+      return New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)), O_Type,
+                        Operand, O_Enode_Null);
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      if Flag_Debug_Assert then
+         if Get_Enode_Type (Left) /= Get_Enode_Type (Right) then
+            raise Syntax_Error;
+         end if;
+         if Get_Expr_Mode (Left) = Mode_Blk then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Kind (Ntype) /= OT_Boolean then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Left);
+         Check_Ref (Right);
+      end if;
+
+      Res := New_Enode (OE_Kind'Val (ON_Op_Kind'Pos (Kind)), Ntype,
+                        Left, Right);
+      if Flag_Debug_Hli then
+         return New_Enode (OE_Typed, Ntype, Res, O_Enode (Ntype));
+      else
+         return Res;
+      end if;
+   end New_Compare_Op;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Const_U32 (Get_Type_Size (Atype), Rtype);
+   end New_Sizeof;
+
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return New_Const_U32 (Get_Field_Offset (Field), Rtype);
+   end New_Offsetof;
+
+   function Is_Pow2 (V : Uns32) return Boolean is
+   begin
+      return (V and -V) = V;
+   end Is_Pow2;
+
+   function Extract_Pow2 (V : Uns32) return Uns32 is
+   begin
+      for I in Natural range 0 .. 31 loop
+         if V = Shift_Left (1, I) then
+            return Uns32 (I);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Extract_Pow2;
+
+   function New_Index_Slice_Element
+     (Arr : O_Lnode; Index : O_Enode; Res_Type : O_Tnode)
+     return O_Lnode
+   is
+      El_Type : O_Tnode;
+      In_Type : O_Tnode;
+      Sz : O_Enode;
+      El_Size : Uns32;
+   begin
+      El_Type := Get_Type_Array_Element (Get_Enode_Type (O_Enode (Arr)));
+      In_Type := Get_Enode_Type (Index);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Index);
+         Check_Ref (Arr);
+      end if;
+
+      --  result := arr + index * sizeof (element).
+      El_Size := Get_Type_Size (El_Type);
+      if El_Size = 1 then
+         Sz := Index;
+      elsif Get_Expr_Kind (Index) = OE_Const then
+         --  FIXME: may recycle previous index?
+         Sz := New_Const_U32 (Get_Expr_Low (Index) * El_Size, In_Type);
+      else
+         if Is_Pow2 (El_Size) then
+            Sz := New_Const_U32 (Extract_Pow2 (El_Size), In_Type);
+            Sz := New_Enode (OE_Shl, In_Type, Index, Sz);
+         else
+            Sz := New_Const_U32 (El_Size, In_Type);
+            Sz := New_Enode (OE_Mul, In_Type, Index, Sz);
+         end if;
+      end if;
+      return O_Lnode (New_Enode (OE_Add, Abi.Mode_Ptr, Res_Type,
+                                 O_Enode (Arr), Sz));
+   end New_Index_Slice_Element;
+
+   function New_Hli_Index_Slice
+     (Kind : OE_Kind; Res_Type : O_Tnode; Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode
+   is
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Index);
+         Check_Ref (Arr);
+      end if;
+      return O_Lnode (New_Enode (Kind, Res_Type, O_Enode (Arr), Index));
+   end New_Hli_Index_Slice;
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+                                return O_Lnode
+   is
+      El_Type : O_Tnode;
+   begin
+      El_Type := Get_Type_Array_Element (Get_Enode_Type (O_Enode (Arr)));
+
+      if Flag_Debug_Hli then
+         return New_Hli_Index_Slice (OE_Index_Ref, El_Type, Arr, Index);
+      else
+         return New_Index_Slice_Element (Arr, Index, El_Type);
+      end if;
+   end New_Indexed_Element;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+                      return O_Lnode
+   is
+   begin
+      if Flag_Debug_Hli then
+         return New_Hli_Index_Slice (OE_Slice_Ref, Res_Type, Arr, Index);
+      else
+         return New_Index_Slice_Element (Arr, Index, Res_Type);
+      end if;
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode
+   is
+      Offset : Uns32;
+      Off : O_Enode;
+      Res_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Rec);
+      end if;
+
+      Res_Type := Get_Field_Type (El);
+      if Flag_Debug_Hli then
+         return O_Lnode (New_Enode (OE_Record_Ref, Res_Type,
+                                    O_Enode (Rec), O_Enode (El)));
+      else
+         Offset := Get_Field_Offset (El);
+         if Offset = 0 then
+            return O_Lnode (New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Res_Type,
+                                       O_Enode (Rec), O_Enode (Res_Type)));
+         else
+            Off := New_Enode (OE_Const, Mode_U32, O_Tnode_Null,
+                              O_Enode (Offset), O_Enode_Null);
+
+            return O_Lnode (New_Enode (OE_Add, Abi.Mode_Ptr, Res_Type,
+                                       O_Enode (Rec), Off));
+         end if;
+      end if;
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode
+   is
+      Acc_Type : O_Tnode;
+      Res_Type : O_Tnode;
+   begin
+      Acc_Type := Get_Enode_Type (Acc);
+
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Acc_Type) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Acc);
+      end if;
+
+      Res_Type := Get_Type_Access_Type (Acc_Type);
+      if Flag_Debug_Hli then
+         return O_Lnode (New_Enode (OE_Access_Ref, Abi.Mode_Ptr, Res_Type,
+                                    Acc, O_Enode_Null));
+      else
+         return O_Lnode (New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Res_Type,
+                                    Acc, O_Enode (Res_Type)));
+      end if;
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Val);
+      end if;
+
+      return New_Enode (OE_Conv, Rtype, Val, O_Enode (Rtype));
+   end New_Convert_Ov;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Atype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Atype,
+                        O_Enode (Lvalue), O_Enode (Atype));
+   end New_Unchecked_Address;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Type_Kind (Atype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         if Get_Base_Type (Get_Enode_Type (O_Enode (Lvalue)))
+           /= Get_Base_Type (Get_Type_Access_Type (Atype))
+         then
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Conv_Ptr, Abi.Mode_Ptr, Atype,
+                        O_Enode (Lvalue), O_Enode (Atype));
+   end New_Address;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Enode is
+   begin
+      raise Program_Error;
+      return O_Enode_Null;
+   end New_Subprogram_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (O_Enode (Lvalue));
+
+      if Flag_Debug_Assert then
+         Check_Ref (Lvalue);
+      end if;
+
+      return New_Enode (OE_Indir, V_Type, O_Enode (Lvalue), O_Enode_Null);
+   end New_Value;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode
+   is
+      Save_Var : O_Dnode;
+      Stmt : O_Enode;
+      St_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         Check_Ref (Size);
+         if Get_Type_Kind (Rtype) /= OT_Access then
+            raise Syntax_Error;
+         end if;
+         if Get_Type_Kind (Get_Enode_Type (Size)) /= OT_Unsigned then
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      if not Get_Block_Has_Alloca (Cur_Block) then
+         Set_Block_Has_Alloca (Cur_Block, True);
+         if Stack_Ptr_Type /= O_Tnode_Null then
+            St_Type := Stack_Ptr_Type;
+         else
+            St_Type := Rtype;
+         end if;
+         --  Add a decl.
+         New_Var_Decl (Save_Var, O_Ident_Nul, O_Storage_Local, St_Type);
+         --  Add insn to save stack ptr.
+         Stmt := New_Enode (OE_Asgn, St_Type,
+                            New_Stack (St_Type),
+                            O_Enode (New_Obj (Save_Var)));
+         if Cur_Block = Last_Stmt then
+            Set_Stmt_Link (Last_Stmt, Stmt);
+            Last_Stmt := Stmt;
+         else
+            Set_Stmt_Link (Stmt, Get_Stmt_Link (Cur_Block));
+            Set_Stmt_Link (Cur_Block, Stmt);
+         end if;
+      end if;
+
+      return New_Enode (OE_Alloca, Rtype, Size, O_Enode (Rtype));
+   end New_Alloca;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode)
+   is
+      Depth : O_Depth;
+      Arg : O_Enode;
+      First_Inter : O_Dnode;
+   begin
+      First_Inter := Get_Subprg_Interfaces (Subprg);
+      if Get_Decl_Storage (Subprg) = O_Storage_Local then
+         Depth := Get_Decl_Depth (Subprg);
+         Arg := New_Enode (OE_Arg, Abi.Mode_Ptr, O_Tnode_Ptr,
+                           Get_Static_Chain (Depth - 1), O_Enode_Null);
+         First_Inter := Get_Interface_Chain (First_Inter);
+      else
+         Arg := O_Enode_Null;
+      end if;
+      Assocs := (Subprg => Subprg,
+                 First_Arg => Arg,
+                 Last_Arg => Arg,
+                 Next_Inter => First_Inter);
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode)
+   is
+      V_Type : O_Tnode;
+      Mode : Mode_Type;
+      N_Mode : Mode_Type;
+      Res : O_Enode;
+   begin
+      V_Type := Get_Enode_Type (Val);
+
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter = O_Dnode_Null then
+            --  More assocs than interfaces.
+            raise Syntax_Error;
+         end if;
+         Check_Value_Type (Val, Get_Decl_Type (Assocs.Next_Inter));
+         Check_Ref (Val);
+      end if;
+
+      --  Follow the C convention call: no parameters shorter than int.
+      Mode := Get_Type_Mode (V_Type);
+      case Mode is
+         when Mode_B2
+           | Mode_U8
+           | Mode_U16 =>
+            N_Mode := Mode_U32;
+         when Mode_I8
+           | Mode_I16 =>
+            N_Mode := Mode_I32;
+         when Mode_P32
+           | Mode_U32
+           | Mode_I32
+           | Mode_U64
+           | Mode_I64
+           | Mode_P64
+           | Mode_F32
+           | Mode_F64 =>
+            N_Mode := Mode;
+         when Mode_Blk
+           | Mode_Nil
+           | Mode_X1 =>
+            raise Program_Error;
+      end case;
+      if N_Mode /= Mode and not Flag_Debug_Hli then
+         Res := New_Enode (OE_Conv, N_Mode, V_Type, Val, O_Enode (V_Type));
+      else
+         Res := Val;
+      end if;
+      Res := New_Enode (OE_Arg, N_Mode, V_Type, Res, O_Enode_Null);
+      if Assocs.Last_Arg /= O_Enode_Null then
+         Enodes.Table (Assocs.Last_Arg).Arg2 := Res;
+      else
+         Assocs.First_Arg := Res;
+      end if;
+      Assocs.Last_Arg := Res;
+      Assocs.Next_Inter := Get_Interface_Chain (Assocs.Next_Inter);
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode
+   is
+      F_Type : O_Tnode;
+   begin
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter /= O_Dnode_Null then
+            --  Not enough assocs.
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      F_Type := Get_Decl_Type (Assocs.Subprg);
+      return New_Enode (OE_Call, F_Type,
+                        O_Enode (Assocs.Subprg), Assocs.First_Arg);
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List) is
+   begin
+      if Flag_Debug_Assert then
+         if Assocs.Next_Inter /= O_Dnode_Null then
+            --  Not enough assocs.
+            raise Syntax_Error;
+         end if;
+      end if;
+      New_Enode_Stmt (OE_Call, O_Enode (Assocs.Subprg), Assocs.First_Arg);
+   end New_Procedure_Call;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+
+      if Flag_Debug_Assert then
+         Check_Value_Type (Value, Get_Enode_Type (O_Enode (Target)));
+         Check_Ref (Value);
+         Check_Ref (Target);
+      end if;
+
+      New_Enode_Stmt (OE_Asgn, Get_Type_Mode (V_Type),
+                      Value, O_Enode (Target));
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Value);
+         Check_Value_Type (Value, Get_Decl_Type (Cur_Subprg.D_Decl));
+      end if;
+
+      New_Enode_Stmt (OE_Ret, Get_Type_Mode (V_Type), Value, O_Enode_Null);
+      if not Flag_Debug_Hli then
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
+      end if;
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Decl_Kind (Cur_Subprg.D_Decl) /= OD_Procedure then
+            raise Syntax_Error;
+         end if;
+      end if;
+
+      if not Flag_Debug_Hli then
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
+      else
+         New_Enode_Stmt (OE_Ret, Mode_Nil, O_Enode_Null, O_Enode_Null);
+      end if;
+   end New_Return_Stmt;
+
+
+   procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode) is
+   begin
+      if Flag_Debug_Assert then
+         if Get_Expr_Mode (Cond) /= Mode_B2 then
+            --  COND must be a boolean.
+            raise Syntax_Error;
+         end if;
+         Check_Ref (Cond);
+      end if;
+
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_If, Cond, O_Enode_Null);
+         Block := (Label_End => O_Enode_Null,
+                   Label_Next => Last_Stmt);
+      else
+         Block := (Label_End => O_Enode_Null,
+                   Label_Next => New_Label);
+         Emit_Jmp (OE_Jump_F, Cond, Block.Label_Next);
+         Start_BB;
+      end if;
+   end Start_If_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Else, O_Enode_Null, O_Enode_Null);
+      else
+         if Block.Label_End = O_Enode_Null then
+            Block.Label_End := New_Label;
+         end if;
+         Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+         Start_BB;
+         Link_Stmt (Block.Label_Next);
+         Block.Label_Next := O_Enode_Null;
+      end if;
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Endif, O_Enode_Null, O_Enode_Null);
+      else
+         --  Create a badic-block after the IF.
+         Start_BB;
+         if Block.Label_Next /= O_Enode_Null then
+            Link_Stmt (Block.Label_Next);
+         end if;
+         if Block.Label_End /= O_Enode_Null then
+            Link_Stmt (Block.Label_End);
+         end if;
+      end if;
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode) is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Loop, O_Enode_Null, O_Enode_Null);
+         Label := (Label_Start => Last_Stmt,
+                   Label_End => O_Enode_Null);
+      else
+         --  Create a basic-block at the beginning of the loop.
+         Start_BB;
+         Label.Label_Start := New_Label;
+         Link_Stmt (Label.Label_Start);
+         Label.Label_End := New_Label;
+      end if;
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Eloop, Label.Label_Start, O_Enode_Null);
+      else
+         Emit_Jmp (OE_Jump, O_Enode_Null, Label.Label_Start);
+         Start_BB;
+         Link_Stmt (Label.Label_End);
+      end if;
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Exit, O_Enode_Null, L.Label_Start);
+      else
+         New_Allocb_Jump (L.Label_End);
+      end if;
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode)
+   is
+   begin
+      if not Flag_Lower_Stmt then
+         New_Enode_Stmt (OE_Next, O_Enode_Null, L.Label_Start);
+      else
+         New_Allocb_Jump (L.Label_Start);
+      end if;
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode)
+   is
+      V_Type : O_Tnode;
+      Mode : Mode_Type;
+      Start : O_Enode;
+   begin
+      V_Type := Get_Enode_Type (Value);
+      Mode := Get_Type_Mode (V_Type);
+
+      if Flag_Debug_Assert then
+         Check_Ref (Value);
+         case Mode is
+            when Mode_U8 .. Mode_U64
+              | Mode_I8 .. Mode_I64
+              | Mode_B2 =>
+               null;
+            when others =>
+               raise Syntax_Error;
+         end case;
+      end if;
+
+      New_Enode_Stmt (OE_Case, Mode, Value, O_Enode_Null);
+      Start := Enodes.Last;
+      if Flag_Debug_Hli then
+         Block := (Expr => Start,
+                   Expr_Type => V_Type,
+                   Last_Node => O_Enode_Null,
+                   Label_End => O_Enode_Null,
+                   Label_Branch => Start);
+      else
+         Block := (Expr => Start,
+                   Expr_Type => V_Type,
+                   Last_Node => Start,
+                   Label_End => New_Label,
+                   Label_Branch => O_Enode_Null);
+      end if;
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block)
+   is
+      B : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         B := New_Enode (OE_Case_Branch, Mode_Nil, O_Tnode_Null,
+                         O_Enode_Null, O_Enode_Null);
+         Link_Stmt (B);
+         --  Link it.
+         Set_Case_Branch (Block.Label_Branch, B);
+         Block.Label_Branch := B;
+      else
+         --  Jump to the end of the case statement.
+         --  If there is already a branch open, this is ok
+         --   (do not fall-through).
+         --  If there is no branch open, then this is the default choice
+         --   (nothing to do).
+         Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+
+         --  Create a label for the code of this branch.
+         Block.Label_Branch := New_Label;
+      end if;
+   end Start_Choice;
+
+   procedure Insert_Choice_Stmt (Block : in out O_Case_Block; Stmt : O_Enode)
+   is
+      Prev : O_Enode;
+   begin
+      Prev := Get_Stmt_Link (Block.Last_Node);
+      Set_Stmt_Link (Block.Last_Node, Stmt);
+      Block.Last_Node := Stmt;
+      if Prev = O_Enode_Null then
+         Last_Stmt := Stmt;
+      else
+         Set_Stmt_Link (Stmt, Prev);
+      end if;
+   end Insert_Choice_Stmt;
+
+   procedure Emit_Choice_Jmp (Block : in out O_Case_Block;
+                              Code : OE_Kind; Expr : O_Enode; Label : O_Enode)
+   is
+      Jmp : O_Enode;
+   begin
+      Jmp := New_Enode (Code, Mode_Nil, O_Tnode_Null, Expr, Label);
+      Insert_Choice_Stmt (Block, Jmp);
+   end Emit_Choice_Jmp;
+
+   --  Create a node containing the value of the case expression.
+   function New_Case_Expr (Block : O_Case_Block) return O_Enode is
+   begin
+      return New_Enode (OE_Case_Expr, Block.Expr_Type,
+                        Block.Expr, O_Enode_Null);
+   end New_Case_Expr;
+
+   procedure New_Hli_Choice (Block : in out O_Case_Block;
+                             Hi, Lo : O_Enode)
+   is
+      Res : O_Enode;
+   begin
+      Res := New_Enode (OE_Case_Choice, Mode_Nil, O_Tnode_Null, Hi, Lo);
+      if Block.Label_End = O_Enode_Null then
+         Set_Case_Branch_Choice (Block.Label_Branch, Res);
+      else
+         Set_Case_Choice_Link (Block.Label_End, Res);
+      end if;
+      Block.Label_End := Res;
+   end New_Hli_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode)
+   is
+      Res : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, New_Lit (Expr), O_Enode_Null);
+      else
+         Res := New_Enode (OE_Eq, Mode_B2, O_Tnode_Null,
+                           New_Case_Expr (Block), New_Lit (Expr));
+         Emit_Choice_Jmp (Block, OE_Jump_T, Res, Block.Label_Branch);
+      end if;
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode)
+   is
+      E1 : O_Enode;
+      E2 : O_Enode;
+      Label : O_Enode;
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, New_Lit (Low), New_Lit (High));
+      else
+         --  Internal label.
+         Label := New_Label;
+         E1 := New_Enode (OE_Lt, Mode_B2, O_Tnode_Null,
+                          New_Case_Expr (Block), New_Lit (Low));
+         Emit_Choice_Jmp (Block, OE_Jump_T, E1, Label);
+         E2 := New_Enode (OE_Le, Mode_B2, O_Tnode_Null,
+                          New_Case_Expr (Block), New_Lit (High));
+         Emit_Choice_Jmp (Block, OE_Jump_T, E2, Block.Label_Branch);
+         Insert_Choice_Stmt (Block, Label);
+      end if;
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         New_Hli_Choice (Block, O_Enode_Null, O_Enode_Null);
+      else
+         --  Jump to the code.
+         Emit_Choice_Jmp (Block, OE_Jump, O_Enode_Null, Block.Label_Branch);
+      end if;
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         Block.Label_End := O_Enode_Null;
+      else
+         --  Put the label of the branch.
+         Start_BB;
+         Link_Stmt (Block.Label_Branch);
+      end if;
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block) is
+   begin
+      if Flag_Debug_Hli then
+         New_Enode_Stmt (OE_Case_End, O_Enode_Null, O_Enode_Null);
+      else
+         --  Jump to the end of the case statement.
+         --  Note: this is not required, since the next instruction is the
+         --   label.
+         --  Emit_Jmp (OE_Jump, O_Enode_Null, Block.Label_End);
+
+         --  Put the label of the end of the case.
+         Start_BB;
+         Link_Stmt (Block.Label_End);
+         Block.Label_End := O_Enode_Null;
+      end if;
+   end Finish_Case_Stmt;
+
+   procedure New_Debug_Line_Stmt (Line : Natural) is
+   begin
+      New_Enode_Stmt (OE_Line, O_Enode (Line), O_Enode_Null);
+   end New_Debug_Line_Stmt;
+
+   procedure Debug_Expr (N : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      Indent : constant Count := Col;
+   begin
+      Put (Int32 (N), 0);
+      Set_Col (Indent + 7);
+      Disp_Mode (Get_Expr_Mode (N));
+      Put ("  ");
+      Put (OE_Kind'Image (Get_Expr_Kind (N)));
+      Set_Col (Indent + 28);
+--       Put (Abi.Image_Insn (Get_Expr_Insn (N)));
+--       Put ("  ");
+      Put (Abi.Image_Reg (Get_Expr_Reg (N)));
+      Put ("  ");
+      Put (Int32 (Enodes.Table (N).Arg1), 7);
+      Put (Int32 (Enodes.Table (N).Arg2), 7);
+      Put (Enodes.Table (N).Info, 7);
+      New_Line;
+   end Debug_Expr;
+
+   procedure Disp_Subprg_Body (Indent : Natural; Subprg : O_Enode)
+   is
+      use Ada.Text_IO;
+      N : O_Enode;
+      N_Indent : Natural;
+   begin
+      N := Subprg;
+      if Get_Expr_Kind (N) /= OE_Entry then
+         raise Program_Error;
+      end if;
+      --  Display the entry.
+      Set_Col (Count (Indent));
+      Debug_Expr (N);
+      --  Display the subprogram, binding.
+      N_Indent := Indent;-- + 1;
+      N := N + 1;
+      loop
+         case Get_Expr_Kind (N) is
+            when OE_Entry =>
+               N := Get_Entry_Leave (N) + 1;
+            when OE_Leave =>
+               Set_Col (Count (Indent));
+               Debug_Expr (N);
+               exit;
+            when others =>
+               Set_Col (Count (N_Indent));
+               Debug_Expr (N);
+               case Get_Expr_Kind (N) is
+                  when OE_Beg =>
+                     Disp_Block (N_Indent + 2,
+                                 O_Dnode (Enodes.Table (N).Arg2));
+                     N_Indent := N_Indent + 1;
+                  when OE_End =>
+                     N_Indent := N_Indent - 1;
+                  when others =>
+                     null;
+               end case;
+               N := N + 1;
+         end case;
+      end loop;
+   end Disp_Subprg_Body;
+
+   procedure Disp_All_Enode is
+   begin
+      for I in Enodes.First .. Enodes.Last loop
+         Debug_Expr (I);
+      end loop;
+   end Disp_All_Enode;
+
+   Max_Enode : O_Enode := O_Enode_Null;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Enode := Enodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Max_Enode := O_Enode'Max (Max_Enode, Enodes.Last);
+      Enodes.Set_Last (M.Enode);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Max_Enode := O_Enode'Max (Max_Enode, Enodes.Last);
+      Put ("Number of Enodes:" & O_Enode'Image (Enodes.Last));
+      Put (", max:" & O_Enode'Image (Max_Enode));
+      New_Line;
+   end Disp_Stats;
+
+   procedure Free_Subprogram_Data (Data : in out Subprogram_Data_Acc)
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Subprogram_Data, Subprogram_Data_Acc);
+      Ch, N_Ch : Subprogram_Data_Acc;
+   begin
+      Ch := Data.First_Child;
+      while Ch /= null loop
+         N_Ch := Ch.Brother;
+         Free_Subprogram_Data (Ch);
+         Ch := N_Ch;
+      end loop;
+      Free (Data);
+   end Free_Subprogram_Data;
+
+   procedure Finish is
+   begin
+      Enodes.Free;
+      Free_Subprogram_Data (First_Subprg);
+   end Finish;
+end Ortho_Code.Exprs;
diff --git a/src/ortho/mcode/ortho_code-exprs.ads b/src/ortho/mcode/ortho_code-exprs.ads
new file mode 100644
index 000000000..9bd4596d7
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-exprs.ads
@@ -0,0 +1,600 @@
+--  Mcode back-end for ortho - Expressions and control handling.
+--  Copyright (C) 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.
+package Ortho_Code.Exprs is
+   type OE_Kind is
+     (
+      OE_Nil,
+
+      --  Dyadic operations.
+      --  ARG1 is left, ARG2 is right.
+      OE_Add_Ov,
+      OE_Sub_Ov,
+      OE_Mul_Ov,
+      OE_Div_Ov,
+      OE_Rem,
+      OE_Mod,
+
+      OE_And,
+      OE_Or,
+      OE_Xor,
+
+      --  Monadic operations.
+      --  ARG1 is expression.
+      OE_Not,
+      OE_Neg_Ov,
+      OE_Abs_Ov,
+
+      --  Comparaison.
+      --  ARG1 is left, ARG2 is right.
+      OE_Eq,
+      OE_Neq,
+      OE_Le,
+      OE_Lt,
+      OE_Ge,
+      OE_Gt,
+
+      --  Without checks, for addresses.
+      OE_Add,
+      OE_Mul,
+      OE_Shl, --  Left shift
+
+      --  A literal.
+      --  ARG1 is low part, ARG2 is high part.
+      OE_Const,
+
+      --  Address of a local variable/parameter.
+      --  ARG1 is object.
+      --  ARG2 is the frame pointer or O_Enode_Null for current frame pointer.
+      OE_Addrl,
+      --  Address of a global variable.
+      --  ARG1 is object.
+      OE_Addrg,
+
+      --  Pointer dereference.
+      --  ARG1 is operand.
+      OE_Indir,
+
+      --  Conversion.
+      --  ARG1 is expression.
+      --  ARG2: type
+      OE_Conv_Ptr,
+      OE_Conv,
+
+      --  Typed expression.
+      OE_Typed,
+
+      --  Local memory allocation.
+      --  ARG1 is size (in bytes).
+      OE_Alloca,
+
+      --  Statements.
+
+      --  Subrogram entry.
+      --  ARG1 is the corresponding Leave (used to skip inner subprograms).
+      --  ARG2 is unused.
+      OE_Entry,
+      --  Subprogram exit.
+      --  ARG1 and ARG2 are unused.
+      OE_Leave,
+
+      --  Declaration blocks.
+      --  ARG1: parent
+      --  ARG2: corresponding declarations.
+      OE_Beg,
+      --  ARG1: corresponding beg
+      --  ARG2: unsused.
+      OE_End,
+
+      --  Assignment.
+      --  ARG1 is value, ARG2 is target (address).
+      OE_Asgn,
+
+      --  Subprogram calls.
+      --  ARG1 is value
+      --  ARG2 is link to the next argument.
+      OE_Arg,
+      --  ARG1 is subprogram
+      --  ARG2 is arguments.
+      OE_Call,
+      --  ARG1 is intrinsic operation.
+      OE_Intrinsic,
+
+      --  Modify the stack pointer value, to align the stack before pushing
+      --  arguments, or to free the stack.
+      --  ARG1 is the signed offset.
+      OE_Stack_Adjust,
+
+      --  Return ARG1 (if not mode_nil) from current subprogram.
+      --  ARG1: expression.
+      OE_Ret,
+
+      --  Line number (for debugging).
+      --  ARG1: line number
+      OE_Line,
+
+      --  High level instructions.
+
+      --  Basic block.
+      --  ARG1: next BB
+      --  ARG2: number
+      OE_BB,
+
+      --  ARG1 is the literal.
+      OE_Lit,
+      --  ARG1: value
+      --  ARG2: first branch (HLI only).
+      OE_Case,
+      --  ARG1: the corresponding OE_Case
+      OE_Case_Expr,
+      --  ARG1: left bound
+      --  ARG2: right bound
+      --  LINK: choice link
+      OE_Case_Choice,
+      --  ARG1: choice link
+      --  ARG2: next branch
+      OE_Case_Branch,
+      --  End of case.
+      OE_Case_End,
+
+      --  ARG1: the condition
+      --  ARG2: the else/endif
+      OE_If,
+      OE_Else,
+      OE_Endif,
+
+      --  ARG1: loop level.
+      OE_Loop,
+      --  ARG1: loop.
+      OE_Eloop,
+      --  ARG2: loop.
+      OE_Next,
+      OE_Exit,
+
+      --  ARG1: the record
+      --  ARG2: the field
+      OE_Record_Ref,
+
+      --  ARG1: the expression.
+      OE_Access_Ref,
+
+      --  ARG1: the array
+      --  ARG2: the index
+      OE_Index_Ref,
+      OE_Slice_Ref,
+
+      --  Low level instructions.
+
+      --  Label.
+      --  ARG1: current block (used for alloca), only during tree building.
+      --  ARG2: user info (generally used to store symbol).
+      OE_Label,
+
+      --  Jump to ARG2.
+      OE_Jump,
+
+      --  Jump to ARG2 if ARG1 is true/false.
+      OE_Jump_T,
+      OE_Jump_F,
+
+      --  Used internally only.
+      --  ARG2 is info/target, ARG1 is expression (if any).
+      OE_Spill,
+      OE_Reload,
+      OE_Move,
+
+      --  Alloca/allocb handling.
+      OE_Get_Stack,
+      OE_Set_Stack,
+
+      --  Get current frame pointer.
+      OE_Get_Frame,
+
+      --  Additionnal reg
+      OE_Reg
+      );
+   for OE_Kind'Size use 8;
+
+   subtype OE_Kind_Dyadic is OE_Kind range OE_Add_Ov .. OE_Xor;
+   subtype OE_Kind_Cmp is OE_Kind range OE_Eq .. OE_Gt;
+
+
+   --  BE representation of an instruction.
+   type O_Insn is mod 256;
+
+   type Subprogram_Data;
+   type Subprogram_Data_Acc is access Subprogram_Data;
+
+   type Subprogram_Data is record
+      --  Parent or null if top-level subprogram.
+      Parent : Subprogram_Data_Acc;
+
+      --  Block in which this subprogram is declared, or o_dnode_null if
+      --  top-level subprogram.
+      --Parent_Block : O_Dnode;
+
+      --  First and last child, or null if no children.
+      First_Child : Subprogram_Data_Acc;
+      Last_Child : Subprogram_Data_Acc;
+
+      --  Next subprogram at the same depth level.
+      Brother : Subprogram_Data_Acc;
+
+      --  Depth of the subprogram.
+      Depth : O_Depth;
+
+      --  Dnode for the declaration.
+      D_Decl : O_Dnode;
+
+      --  Enode for the Entry.
+      E_Entry : O_Enode;
+
+      --  Dnode for the Body.
+      D_Body : O_Dnode;
+
+      --  Label just before leave.
+      Exit_Label : O_Enode;
+
+      --  Last statement of this subprogram.
+      Last_Stmt : O_Enode;
+
+      --  Static maximum stack use.
+      Stack_Max : Uns32;
+   end record;
+
+   --  Data for the current subprogram.
+   Cur_Subprg : Subprogram_Data_Acc := null;
+
+   --  First and last (top-level) subprogram.
+   First_Subprg : Subprogram_Data_Acc := null;
+   Last_Subprg : Subprogram_Data_Acc := null;
+
+   --  Type of the stack pointer - for OE_Get_Stack and OE_Set_Stack.
+   --  Can be set by back-ends.
+   Stack_Ptr_Type : O_Tnode := O_Tnode_Null;
+
+   --  Create a new node.
+   --  Should be used only by back-end to add internal nodes.
+   function New_Enode (Kind : OE_Kind;
+                       Mode : Mode_Type;
+                       Rtype : O_Tnode;
+                       Arg1 : O_Enode;
+                       Arg2 : O_Enode) return O_Enode;
+
+   --  Get the kind of ENODE.
+   function Get_Expr_Kind (Enode : O_Enode) return OE_Kind;
+   pragma Inline (Get_Expr_Kind);
+
+   --  Get the mode of ENODE.
+   function Get_Expr_Mode (Enode : O_Enode) return Mode_Type;
+   pragma Inline (Get_Expr_Mode);
+
+   --  Get/Set the register of ENODE.
+   function Get_Expr_Reg (Enode : O_Enode) return O_Reg;
+   procedure Set_Expr_Reg (Enode : O_Enode; Reg : O_Reg);
+   pragma Inline (Get_Expr_Reg);
+   pragma Inline (Set_Expr_Reg);
+
+   --  Get the operand of an unary expression.
+   function Get_Expr_Operand (Enode : O_Enode) return O_Enode;
+   procedure Set_Expr_Operand (Enode : O_Enode; Val : O_Enode);
+
+   --  Get left/right operand of a binary expression.
+   function Get_Expr_Left (Enode : O_Enode) return O_Enode;
+   function Get_Expr_Right (Enode : O_Enode) return O_Enode;
+   procedure Set_Expr_Left (Enode : O_Enode; Val : O_Enode);
+   procedure Set_Expr_Right (Enode : O_Enode; Val : O_Enode);
+
+   --  Get the low and high part of an OE_CONST node.
+   function Get_Expr_Low (Cst : O_Enode) return Uns32;
+   function Get_Expr_High (Cst : O_Enode) return Uns32;
+
+   --  Get target of the assignment.
+   function Get_Assign_Target (Enode : O_Enode) return O_Enode;
+   procedure Set_Assign_Target (Enode : O_Enode; Targ : O_Enode);
+
+   --  For OE_Lit: get the literal.
+   function Get_Expr_Lit (Lit : O_Enode) return O_Cnode;
+
+   --  Type of a OE_Conv/OE_Nop/OE_Typed/OE_Alloca
+   --  Used only for display/debugging purposes.
+   function Get_Conv_Type (Enode : O_Enode) return O_Tnode;
+
+   --  Leave node corresponding to the entry.
+   function Get_Entry_Leave (Enode : O_Enode) return O_Enode;
+
+   --  Get the label of a jump/ret
+   function Get_Jump_Label (Enode : O_Enode) return O_Enode;
+   procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode);
+
+   --  Get the object of addrl,addrp,addrg
+   function Get_Addr_Object (Enode : O_Enode) return O_Dnode;
+
+   --  Get the computed frame for the object.
+   --  If O_Enode_Null, then use current frame.
+   function Get_Addrl_Frame (Enode : O_Enode) return O_Enode;
+   procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode);
+
+   --  Return the stack adjustment. For positive values, this is the amount of
+   --  bytes to allocate on the stack before pushing arguments, so that the
+   --  stack pointer stays aligned. For negtive values, this is the amount of
+   --  bytes to release on the stack.
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32;
+
+   --  Get the subprogram called by ENODE.
+   function Get_Call_Subprg (Enode : O_Enode) return O_Dnode;
+
+   --  Get the first argument of a call, or the next argument of an arg.
+   function Get_Arg_Link (Enode : O_Enode) return O_Enode;
+
+   --  Get the declaration chain of a Beg statement.
+   function Get_Block_Decls (Blk : O_Enode) return O_Dnode;
+
+   --  Get the parent of the block.
+   function Get_Block_Parent (Blk : O_Enode) return O_Enode;
+
+   --  Get the corresponding beg.
+   function Get_End_Beg (Blk : O_Enode) return O_Enode;
+
+   --  True if the block contains an alloca insn.
+   function Get_Block_Has_Alloca (Blk : O_Enode) return Boolean;
+
+   --  Set the next branch of a case/case_branch.
+   procedure Set_Case_Branch (C : O_Enode; Branch : O_Enode);
+
+   --  Set the first choice of a case branch.
+   procedure Set_Case_Branch_Choice (Branch : O_Enode; Choice : O_Enode);
+   function Get_Case_Branch_Choice (Branch : O_Enode) return O_Enode;
+
+   --  Set the choice link of a case choice.
+   procedure Set_Case_Choice_Link (Choice : O_Enode; N_Choice : O_Enode);
+   function Get_Case_Choice_Link (Choice : O_Enode) return O_Enode;
+
+   --  Get/Set the max stack size for the end block BLKE.
+   --function Get_Block_Max_Stack (Blke : O_Enode) return Int32;
+   --procedure Set_Block_Max_Stack (Blke : O_Enode; Max : Int32);
+
+   --  Get the field of an o_record_ref node.
+   function Get_Ref_Field (Ref : O_Enode) return O_Fnode;
+
+   --  Get the index of an OE_Index_Ref or OE_Slice_Ref node.
+   function Get_Ref_Index (Ref : O_Enode) return O_Enode;
+
+   --  Get/Set the info field of a label.
+   function Get_Label_Info (Label : O_Enode) return Int32;
+   procedure Set_Label_Info (Label : O_Enode; Info : Int32);
+
+   --  Get the info of a spill.
+   function Get_Spill_Info (Spill : O_Enode) return Int32;
+   procedure Set_Spill_Info (Spill : O_Enode; Info : Int32);
+
+   --  Get the statement link.
+   function Get_Stmt_Link (Stmt : O_Enode) return O_Enode;
+   procedure Set_Stmt_Link (Stmt : O_Enode; Next : O_Enode);
+
+   --  Get the line number of an OE_Line statement.
+   function Get_Expr_Line_Number (Stmt : O_Enode) return Int32;
+
+   --  Get the operation of an intrinsic.
+   function Get_Intrinsic_Operation (Stmt : O_Enode) return Int32;
+
+   --  Get the basic block label (uniq number).
+   function Get_BB_Number (Stmt : O_Enode) return Int32;
+
+   --  For OE_Loop, set loop level (an integer).
+   --  Reserved for back-end in HLI mode only.
+   function Get_Loop_Level (Stmt : O_Enode) return Int32;
+   procedure Set_Loop_Level (Stmt : O_Enode; Level : Int32);
+
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+   --  Translate a scalar literal into an expression.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Translate an object (var, const or interface) into an lvalue.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+      --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Enode;
+
+   --  Returns the offset of FIELD in its record.  The result is a literal
+   --  of unsigned type RTYPE.
+   function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   type O_Assoc_List is limited private;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   type O_If_Block is limited private;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   type O_Snode is private;
+   O_Snode_Null : constant O_Snode;
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   type O_Case_Block is limited private;
+   procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode);
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   procedure Disp_Subprg_Body (Indent : Natural; Subprg : O_Enode);
+   procedure Disp_All_Enode;
+   procedure Disp_Stats;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Finish;
+private
+   type O_Assoc_List is record
+      --  Subprogram being called.
+      Subprg : O_Dnode;
+      --  First and last argument statement.
+      First_Arg : O_Enode;
+      Last_Arg : O_Enode;
+      --  Interface for the next association.
+      Next_Inter : O_Dnode;
+   end record;
+
+   type O_Case_Block is record
+      --  Expression for the selection.
+      Expr : O_Enode;
+
+      --  Type of expression.
+      --  Used to perform checks.
+      Expr_Type : O_Tnode;
+
+      --  Choice code and branch code is not mixed (anymore).
+      --  Therefore, code to perform choices is inserted.
+      --  Last node of the choice code.
+      Last_Node : O_Enode;
+
+      --  Label at the end of the case statement.
+      --  used to jump from the end of a branch to the end of the statement.
+      Label_End : O_Enode;
+
+      --  Label of the branch code.
+      Label_Branch : O_Enode;
+   end record;
+
+   type O_If_Block is record
+      Label_End : O_Enode;
+      Label_Next : O_Enode;
+   end record;
+
+   type O_Snode is record
+      Label_Start : O_Enode;
+      Label_End : O_Enode;
+   end record;
+   O_Snode_Null : constant O_Snode := (Label_Start => O_Enode_Null,
+                                       Label_End => O_Enode_Null);
+
+   type Mark_Type is record
+      Enode : O_Enode;
+   end record;
+end Ortho_Code.Exprs;
diff --git a/src/ortho/mcode/ortho_code-flags.ads b/src/ortho/mcode/ortho_code-flags.ads
new file mode 100644
index 000000000..805f3779b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-flags.ads
@@ -0,0 +1,35 @@
+--  Compile flags for mcode.
+--  Copyright (C) 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.
+package Ortho_Code.Flags is
+   type Debug_Type is (Debug_None, Debug_Dwarf);
+
+   --  Debugging information generated.
+   Flag_Debug : Debug_Type := Debug_None;
+
+   --  If set, generate a map from type to type declaration.
+   Flag_Type_Name : Boolean := False;
+
+   --  If set, enable optimiztions.
+   Flag_Optimize : Boolean := False;
+
+   --  If set, create basic blocks during tree building.
+   Flag_Opt_BB : Boolean := False;
+
+   --  If set, add profiling calls.
+   Flag_Profile : Boolean := False;
+end Ortho_Code.Flags;
diff --git a/src/ortho/mcode/ortho_code-opts.adb b/src/ortho/mcode/ortho_code-opts.adb
new file mode 100644
index 000000000..0ea6b039b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-opts.adb
@@ -0,0 +1,214 @@
+--  Mcode back-end for ortho - Optimization.
+--  Copyright (C) 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 Ortho_Code.Flags;
+
+package body Ortho_Code.Opts is
+   procedure Relabel_Jump (Jmp : O_Enode)
+   is
+      Label : O_Enode;
+      Bb : O_Enode;
+   begin
+      Label := Get_Jump_Label (Jmp);
+      if Get_Expr_Kind (Label) = OE_Label then
+         Bb := O_Enode (Get_Label_Info (Label));
+         if Bb /= O_Enode_Null then
+            Set_Jump_Label (Jmp, Bb);
+         end if;
+      end if;
+   end Relabel_Jump;
+
+   procedure Jmp_To_Bb (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      Prev : O_Enode;
+      Cur_Bb : O_Enode;
+   begin
+      --  Get first statement after entry.
+      First := Get_Stmt_Link (Subprg.E_Entry);
+
+      --  First loop:
+      --  If a label belongs to a BB (ie, is at the beginning of a BB),
+      --  then link it to the BB.
+      Stmt := First;
+      Cur_Bb := O_Enode_Null;
+      loop
+         case Get_Expr_Kind (Stmt) is
+            when OE_Leave =>
+               exit;
+            when OE_BB =>
+               Cur_Bb := Stmt;
+            when OE_Label =>
+               if Cur_Bb /= O_Enode_Null then
+                  Set_Label_Info (Stmt, Int32 (Cur_Bb));
+               end if;
+            when OE_Jump
+              | OE_Jump_T
+              | OE_Jump_F =>
+               --  This handles backward jump.
+               Relabel_Jump (Stmt);
+            when others =>
+               Cur_Bb := O_Enode_Null;
+         end case;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+
+      --  Second loop:
+      --  Transform jump to label to jump to BB.
+      Stmt := First;
+      Prev := O_Enode_Null;
+      loop
+         case Get_Expr_Kind (Stmt) is
+            when OE_Leave =>
+               exit;
+            when OE_Jump
+              | OE_Jump_T
+              | OE_Jump_F =>
+               --  This handles forward jump.
+               Relabel_Jump (Stmt);
+               --  Update PREV.
+               Prev := Stmt;
+            when OE_Label =>
+               --  Remove the Label.
+               --  Do not update PREV.
+               if Get_Label_Info (Stmt) /= 0 then
+                  Set_Stmt_Link (Prev, Get_Stmt_Link (Stmt));
+               end if;
+            when others =>
+               Prev := Stmt;
+         end case;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+   end Jmp_To_Bb;
+
+   type Oe_Kind_Bool_Array is array (OE_Kind) of Boolean;
+   Is_Passive_Stmt : constant Oe_Kind_Bool_Array :=
+     (OE_Label | OE_BB | OE_End | OE_Beg => True,
+      others => False);
+
+   --  Return the next statement after STMT which really execute instructions.
+   function Get_Fall_Stmt (Stmt : O_Enode) return O_Enode
+   is
+      Res : O_Enode;
+   begin
+      Res := Stmt;
+      loop
+         Res := Get_Stmt_Link (Res);
+         case Get_Expr_Kind (Res) is
+            when OE_Label
+              | OE_BB
+              | OE_End
+              | OE_Beg =>
+               null;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Get_Fall_Stmt;
+   pragma Unreferenced (Get_Fall_Stmt);
+
+   procedure Thread_Jump (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      Prev, Next : O_Enode;
+      Kind : OE_Kind;
+   begin
+      --  Get first statement after entry.
+      First := Get_Stmt_Link (Subprg.E_Entry);
+
+      --  First loop:
+      --  If a label belongs to a BB (ie, is at the beginning of a BB),
+      --  then link it to the BB.
+      Stmt := First;
+      Prev := O_Enode_Null;
+      loop
+         Next := Get_Stmt_Link (Stmt);
+         Kind := Get_Expr_Kind (Stmt);
+         case Kind is
+            when OE_Leave =>
+               exit;
+            when OE_Jump =>
+               --  Remove the jump if followed by the label.
+               --    * For _T/_F: should convert to a ignore value.
+               --  Discard unreachable statements after the jump.
+               declare
+                  N_Stmt : O_Enode;
+                  P_Stmt : O_Enode;
+                  Label : O_Enode;
+                  Flag_Discard : Boolean;
+                  K_Stmt : OE_Kind;
+               begin
+                  N_Stmt := Next;
+                  P_Stmt := Stmt;
+                  Label := Get_Jump_Label (Stmt);
+                  Flag_Discard := True;
+                  loop
+                     if N_Stmt = Label then
+                        --  Remove STMT.
+                        Set_Stmt_Link (Prev, Next);
+                        exit;
+                     end if;
+                     K_Stmt := Get_Expr_Kind (N_Stmt);
+                     if K_Stmt = OE_Label then
+                        --  Do not discard anymore statements, since they are
+                        --  now reachable.
+                        Flag_Discard := False;
+                     end if;
+                     if not Is_Passive_Stmt (K_Stmt) then
+                        if not Flag_Discard then
+                           --  We have found the next statement.
+                           --  Keep the jump.
+                           Prev := Stmt;
+                           exit;
+                        else
+                           --  Delete insn.
+                           N_Stmt := Get_Stmt_Link (N_Stmt);
+                           Set_Stmt_Link (P_Stmt, N_Stmt);
+                        end if;
+                     else
+                        --  Iterate.
+                        P_Stmt := N_Stmt;
+                        N_Stmt := Get_Stmt_Link (N_Stmt);
+                     end if;
+                  end loop;
+               end;
+            when others =>
+               Prev := Stmt;
+         end case;
+         Stmt := Next;
+      end loop;
+   end Thread_Jump;
+
+   procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+   begin
+      --  Jump optimisation:
+      --  * discard insns after a OE_JUMP.
+      --  * Remove jump if followed by label
+      --    (through label, BB, comments, end, line)
+      --  * Redirect jump to jump (infinite loop !)
+      --  * Revert jump_t/f if expr is not (XXX)
+      --  * Jmp_t/f L:; jmp L2; L1:  ->  jmp_f/t L2
+      Thread_Jump (Subprg);
+      if Flags.Flag_Opt_BB then
+         Jmp_To_Bb (Subprg);
+      end if;
+   end Optimize_Subprg;
+end Ortho_Code.Opts;
+
diff --git a/src/ortho/mcode/ortho_code-opts.ads b/src/ortho/mcode/ortho_code-opts.ads
new file mode 100644
index 000000000..27a907c7b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-opts.ads
@@ -0,0 +1,22 @@
+--  Mcode back-end for ortho - Optimization.
+--  Copyright (C) 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 Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.Opts is
+   procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc);
+end Ortho_Code.Opts;
diff --git a/src/ortho/mcode/ortho_code-types.adb b/src/ortho/mcode/ortho_code-types.adb
new file mode 100644
index 000000000..e0c070c27
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-types.adb
@@ -0,0 +1,820 @@
+--  Mcode back-end for ortho - type handling.
+--  Copyright (C) 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 Ada.Text_IO;
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.Abi; use Ortho_Code.Abi;
+with Ortho_Ident;
+
+package body Ortho_Code.Types is
+   type Bool_Array is array (Natural range <>) of Boolean;
+   pragma Pack (Bool_Array);
+
+   type Tnode_Common is record
+      Kind : OT_Kind; -- 4 bits.
+      Mode : Mode_Type; -- 4 bits.
+      Align : Small_Natural; -- 2 bits.
+      Deferred : Boolean; -- 1 bit (True if the type was incomplete at first)
+      Flag1 : Boolean;
+      Pad0 : Bool_Array (0 .. 19);
+      Size : Uns32;
+   end record;
+   pragma Pack (Tnode_Common);
+   for Tnode_Common'Size use 64;
+
+   type Tnode_Access is record
+      Dtype : O_Tnode;
+      Pad : Uns32;
+   end record;
+
+   type Tnode_Array is record
+      Element_Type : O_Tnode;
+      Index_Type : O_Tnode;
+   end record;
+
+   type Tnode_Subarray is record
+      Base_Type : O_Tnode;
+      Length : Uns32;
+   end record;
+
+   type Tnode_Record is record
+      Fields : O_Fnode;
+      Nbr_Fields : Uns32;
+   end record;
+
+   type Tnode_Enum is record
+      Lits : O_Cnode;
+      Nbr_Lits : Uns32;
+   end record;
+
+   type Tnode_Bool is record
+      Lit_False : O_Cnode;
+      Lit_True : O_Cnode;
+   end record;
+
+   package Tnodes is new GNAT.Table
+     (Table_Component_Type => Tnode_Common,
+      Table_Index_Type => O_Tnode,
+      Table_Low_Bound => O_Tnode_First,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   type Field_Type is record
+      Parent : O_Tnode;
+      Ident : O_Ident;
+      Ftype : O_Tnode;
+      Offset : Uns32;
+      Next : O_Fnode;
+   end record;
+
+   package Fnodes is new GNAT.Table
+     (Table_Component_Type => Field_Type,
+      Table_Index_Type => O_Fnode,
+      Table_Low_Bound => 2,
+      Table_Initial => 64,
+      Table_Increment => 100);
+
+   function Get_Type_Kind (Atype : O_Tnode) return OT_Kind is
+   begin
+      return Tnodes.Table (Atype).Kind;
+   end Get_Type_Kind;
+
+   function Get_Type_Size (Atype : O_Tnode) return Uns32 is
+   begin
+      return Tnodes.Table (Atype).Size;
+   end Get_Type_Size;
+
+   function Get_Type_Align (Atype : O_Tnode) return Small_Natural is
+   begin
+      return Tnodes.Table (Atype).Align;
+   end Get_Type_Align;
+
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32 is
+   begin
+      return 2 ** Get_Type_Align (Atype);
+   end Get_Type_Align_Bytes;
+
+   function Get_Type_Mode (Atype : O_Tnode) return Mode_Type is
+   begin
+      return Tnodes.Table (Atype).Mode;
+   end Get_Type_Mode;
+
+   function Get_Type_Deferred (Atype : O_Tnode) return Boolean is
+   begin
+      return Tnodes.Table (Atype).Deferred;
+   end Get_Type_Deferred;
+
+   function Get_Type_Flag1 (Atype : O_Tnode) return Boolean is
+   begin
+      return Tnodes.Table (Atype).Flag1;
+   end Get_Type_Flag1;
+
+   procedure Set_Type_Flag1 (Atype : O_Tnode; Flag : Boolean) is
+   begin
+      Tnodes.Table (Atype).Flag1 := Flag;
+   end Set_Type_Flag1;
+
+   function To_Tnode_Access is new Ada.Unchecked_Conversion
+        (Source => Tnode_Common, Target => Tnode_Access);
+
+   function Get_Type_Access_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      return To_Tnode_Access (Tnodes.Table (Atype + 1)).Dtype;
+   end Get_Type_Access_Type;
+
+
+   function To_Tnode_Array is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Array);
+
+   function Get_Type_Ucarray_Index (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Array (Tnodes.Table (Atype + 1)).Index_Type;
+   end Get_Type_Ucarray_Index;
+
+   function Get_Type_Ucarray_Element (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Array (Tnodes.Table (Atype + 1)).Element_Type;
+   end Get_Type_Ucarray_Element;
+
+
+   function To_Tnode_Subarray is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Subarray);
+
+   function Get_Type_Subarray_Base (Atype : O_Tnode) return O_Tnode is
+   begin
+      return To_Tnode_Subarray (Tnodes.Table (Atype + 1)).Base_Type;
+   end Get_Type_Subarray_Base;
+
+   function Get_Type_Subarray_Length (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Subarray (Tnodes.Table (Atype + 1)).Length;
+   end Get_Type_Subarray_Length;
+
+
+   function To_Tnode_Record is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Record);
+
+   function Get_Type_Record_Fields (Atype : O_Tnode) return O_Fnode is
+   begin
+      return To_Tnode_Record (Tnodes.Table (Atype + 1)).Fields;
+   end Get_Type_Record_Fields;
+
+   function Get_Type_Record_Nbr_Fields (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Record (Tnodes.Table (Atype + 1)).Nbr_Fields;
+   end Get_Type_Record_Nbr_Fields;
+
+   function To_Tnode_Enum is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Enum);
+
+   function Get_Type_Enum_Lits (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Enum (Tnodes.Table (Atype + 1)).Lits;
+   end Get_Type_Enum_Lits;
+
+   function Get_Type_Enum_Lit (Atype : O_Tnode; Pos : Uns32) return O_Cnode
+   is
+      F : O_Cnode;
+   begin
+      F := Get_Type_Enum_Lits (Atype);
+      return F + 2 * O_Cnode (Pos);
+   end Get_Type_Enum_Lit;
+
+   function Get_Type_Enum_Nbr_Lits (Atype : O_Tnode) return Uns32 is
+   begin
+      return To_Tnode_Enum (Tnodes.Table (Atype + 1)).Nbr_Lits;
+   end Get_Type_Enum_Nbr_Lits;
+
+
+   function To_Tnode_Bool is new Ada.Unchecked_Conversion
+     (Source => Tnode_Common, Target => Tnode_Bool);
+
+   function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Bool (Tnodes.Table (Atype + 1)).Lit_False;
+   end Get_Type_Bool_False;
+
+   function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode is
+   begin
+      return To_Tnode_Bool (Tnodes.Table (Atype + 1)).Lit_True;
+   end Get_Type_Bool_True;
+
+   function Get_Field_Offset (Field : O_Fnode) return Uns32 is
+   begin
+      return Fnodes.Table (Field).Offset;
+   end Get_Field_Offset;
+
+   procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32) is
+   begin
+      Fnodes.Table (Field).Offset := Offset;
+   end Set_Field_Offset;
+
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode is
+   begin
+      return Fnodes.Table (Field).Parent;
+   end Get_Field_Parent;
+
+   function Get_Field_Type (Field : O_Fnode) return O_Tnode is
+   begin
+      return Fnodes.Table (Field).Ftype;
+   end Get_Field_Type;
+
+   function Get_Field_Ident (Field : O_Fnode) return O_Ident is
+   begin
+      return Fnodes.Table (Field).Ident;
+   end Get_Field_Ident;
+
+   function Get_Field_Chain (Field : O_Fnode) return O_Fnode is
+   begin
+      return Fnodes.Table (Field).Next;
+   end Get_Field_Chain;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_U8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_U16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_U32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_U64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Unsigned,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      return Tnodes.Last;
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_I8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_I16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_I32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_I64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Signed,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      return Tnodes.Last;
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Float,
+                                   Mode => Mode_F64,
+                                   Align => Mode_Align (Mode_F64),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 8));
+      return Tnodes.Last;
+   end New_Float_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Enum, Target => Tnode_Common);
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural)
+   is
+      Mode : Mode_Type;
+      Sz : Uns32;
+   begin
+      case Size is
+         when 8 =>
+            Mode := Mode_U8;
+            Sz := 1;
+         when 16 =>
+            Mode := Mode_U16;
+            Sz := 2;
+         when 32 =>
+            Mode := Mode_U32;
+            Sz := 4;
+         when 64 =>
+            Mode := Mode_U64;
+            Sz := 8;
+         when others =>
+            raise Program_Error;
+      end case;
+      Tnodes.Append (Tnode_Common'(Kind => OT_Enum,
+                                   Mode => Mode,
+                                   Align => Mode_Align (Mode),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Sz));
+      List := (Res => Tnodes.Last,
+               First => O_Cnode_Null,
+               Last => O_Cnode_Null,
+               Nbr => 0);
+      Tnodes.Increment_Last;
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode)
+   is
+   begin
+      Res := New_Named_Literal (List.Res, Ident, List.Nbr, List.Last);
+      List.Nbr := List.Nbr + 1;
+      if List.Last = O_Cnode_Null then
+         List.First := Res;
+      end if;
+      List.Last := Res;
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Res := List.Res;
+      Tnodes.Table (List.Res + 1) := To_Tnode_Common
+        (Tnode_Enum'(Lits => List.First,
+                     Nbr_Lits => List.Nbr));
+   end Finish_Enum_Type;
+
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Bool, Target => Tnode_Common);
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode)
+   is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Boolean,
+                                   Mode => Mode_B2,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 1));
+      Res := Tnodes.Last;
+      False_E := New_Named_Literal (Res, False_Id, 0, O_Cnode_Null);
+      True_E := New_Named_Literal (Res, True_Id, 1, False_E);
+      Tnodes.Append (To_Tnode_Common (Tnode_Bool'(Lit_False => False_E,
+                                                 Lit_True => True_E)));
+   end New_Boolean_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Array, Target => Tnode_Common);
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Ucarray,
+                                   Mode => Mode_Blk,
+                                   Align => Get_Type_Align (El_Type),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Array'(Element_Type => El_Type,
+                                                   Index_Type => Index_Type)));
+      return Res;
+   end New_Array_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Subarray, Target => Tnode_Common);
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : Uns32)
+                                       return O_Tnode
+   is
+      Res : O_Tnode;
+      Size : Uns32;
+   begin
+      Size := Get_Type_Size (Get_Type_Array_Element (Atype));
+      Tnodes.Append (Tnode_Common'(Kind => OT_Subarray,
+                                   Mode => Mode_Blk,
+                                   Align => Get_Type_Align (Atype),
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => Size * Length));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Subarray'(Base_Type => Atype,
+                                                      Length => Length)));
+      return Res;
+   end New_Constrained_Array_Type;
+
+   procedure Create_Completer (Atype : O_Tnode) is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Complete,
+                                   Mode => Mode_Nil,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => To_Uns32 (Int32 (Atype))));
+   end Create_Completer;
+
+   function Get_Type_Complete_Type (Atype : O_Tnode) return O_Tnode is
+   begin
+      return O_Tnode (To_Int32 (Tnodes.Table (Atype).Size));
+   end Get_Type_Complete_Type;
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Access, Target => Tnode_Common);
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Access,
+                                   Mode => Mode_P32,
+                                   Align => Mode_Align (Mode_P32),
+                                   Deferred => Dtype = O_Tnode_Null,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 4));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Access'(Dtype => Dtype,
+                                                    Pad => 0)));
+      return Res;
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      if Get_Type_Access_Type (Atype) /= O_Tnode_Null then
+         raise Program_Error;
+      end if;
+      Tnodes.Table (Atype + 1) :=
+        To_Tnode_Common (Tnode_Access'(Dtype => Dtype,
+                                       Pad => 0));
+      if Flag_Type_Completer then
+         Create_Completer (Atype);
+      end if;
+   end Finish_Access_Type;
+
+
+   function To_Tnode_Common is new Ada.Unchecked_Conversion
+     (Source => Tnode_Record, Target => Tnode_Common);
+
+   function Create_Record_Type (Deferred : Boolean) return O_Tnode
+   is
+      Res : O_Tnode;
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Record,
+                                   Mode => Mode_Blk,
+                                   Align => 0,
+                                   Deferred => Deferred,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Res := Tnodes.Last;
+      Tnodes.Append (To_Tnode_Common (Tnode_Record'(Fields => O_Fnode_Null,
+                                                    Nbr_Fields => 0)));
+      return Res;
+   end Create_Record_Type;
+
+   procedure Start_Record_Type (Elements : out O_Element_List)
+   is
+   begin
+      Elements := (Res => Create_Record_Type (False),
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+   end Start_Record_Type;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Res := Create_Record_Type (True);
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List)
+   is
+   begin
+      Elements := (Res => Res,
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+   end Start_Uncomplete_Record_Type;
+
+   function Get_Mode_Size (Mode : Mode_Type) return Uns32 is
+   begin
+      case Mode is
+         when Mode_B2
+           | Mode_U8
+           | Mode_I8 =>
+            return 1;
+         when Mode_I16
+           | Mode_U16 =>
+            return 2;
+         when Mode_I32
+           | Mode_U32
+           | Mode_P32
+           | Mode_F32 =>
+            return 4;
+         when Mode_I64
+           | Mode_U64
+           | Mode_P64
+           | Mode_F64 =>
+            return 8;
+         when Mode_X1
+           | Mode_Nil
+           | Mode_Blk =>
+            raise Program_Error;
+      end case;
+   end Get_Mode_Size;
+
+   function Do_Align (Off : Uns32; Atype : O_Tnode) return Uns32
+   is
+      Msk : constant Uns32 := Get_Type_Align_Bytes (Atype) - 1;
+   begin
+      --  Align.
+      return (Off + Msk) and (not Msk);
+   end Do_Align;
+
+   function Do_Align (Off : Uns32; Mode : Mode_Type) return Uns32
+   is
+      Msk : constant Uns32 := (2 ** Mode_Align (Mode)) - 1;
+   begin
+      --  Align.
+      return (Off + Msk) and (not Msk);
+   end Do_Align;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+   begin
+      Elements.Off := Do_Align (Elements.Off, Etype);
+
+      Fnodes.Append (Field_Type'(Parent => Elements.Res,
+                                 Ident => Ident,
+                                 Ftype => Etype,
+                                 Offset => Elements.Off,
+                                 Next => O_Fnode_Null));
+      El := Fnodes.Last;
+      Elements.Off := Elements.Off + Get_Type_Size (Etype);
+      if Get_Type_Align (Etype) > Elements.Align then
+         Elements.Align := Get_Type_Align (Etype);
+      end if;
+      if Elements.Last_Field /= O_Fnode_Null then
+         Fnodes.Table (Elements.Last_Field).Next := Fnodes.Last;
+      else
+         Elements.First_Field := Fnodes.Last;
+      end if;
+      Elements.Last_Field := Fnodes.Last;
+      Elements.Nbr := Elements.Nbr + 1;
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode)
+   is
+   begin
+      Tnodes.Table (Elements.Res).Size := Do_Align (Elements.Off,
+                                                    Elements.Res);
+      Tnodes.Table (Elements.Res).Align := Elements.Align;
+      Tnodes.Table (Elements.Res + 1) := To_Tnode_Common
+        (Tnode_Record'(Fields => Elements.First_Field,
+                       Nbr_Fields => Elements.Nbr));
+      Res := Elements.Res;
+      if Flag_Type_Completer
+        and then Tnodes.Table (Elements.Res).Deferred
+      then
+         Create_Completer (Elements.Res);
+      end if;
+   end Finish_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List)
+   is
+   begin
+      Tnodes.Append (Tnode_Common'(Kind => OT_Union,
+                                   Mode => Mode_Blk,
+                                   Align => 0,
+                                   Deferred => False,
+                                   Flag1 => False,
+                                   Pad0 => (others => False),
+                                   Size => 0));
+      Elements := (Res => Tnodes.Last,
+                   First_Field => O_Fnode_Null,
+                   Last_Field => O_Fnode_Null,
+                   Off => 0,
+                   Align => 0,
+                   Nbr => 0);
+      Tnodes.Append (To_Tnode_Common (Tnode_Record'(Fields => O_Fnode_Null,
+                                                   Nbr_Fields => 0)));
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode)
+   is
+      Off : Uns32;
+   begin
+      Off := Elements.Off;
+      Elements.Off := 0;
+      New_Record_Field (Elements, El, Ident, Etype);
+      if Off > Elements.Off then
+         Elements.Off := Off;
+      end if;
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode)
+   is
+   begin
+      Finish_Record_Type (Elements, Res);
+   end Finish_Union_Type;
+
+   function Get_Type_Array_Element (Atype : O_Tnode) return O_Tnode
+   is
+      Base : O_Tnode;
+   begin
+      case Get_Type_Kind (Atype) is
+         when OT_Ucarray =>
+            Base := Atype;
+         when OT_Subarray =>
+            Base := Get_Type_Subarray_Base (Atype);
+         when others =>
+            raise Program_Error;
+      end case;
+      return Get_Type_Ucarray_Element (Base);
+   end Get_Type_Array_Element;
+
+   procedure Debug_Type (Atype : O_Tnode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+      Kind : OT_Kind;
+   begin
+      Put (Int32 (Atype), 3);
+      Put (" ");
+      Kind := Get_Type_Kind (Atype);
+      Put (OT_Kind'Image (Get_Type_Kind (Atype)));
+      Put ("  ");
+      Put (Mode_Type'Image (Get_Type_Mode (Atype)));
+      Put (" D=");
+      Put (Boolean'Image (Get_Type_Deferred (Atype)));
+      Put (" F1=");
+      Put (Boolean'Image (Get_Type_Flag1 (Atype)));
+      New_Line;
+      case Kind is
+         when OT_Boolean =>
+            Put ("  false: ");
+            Put (Int32 (Get_Type_Bool_False (Atype)));
+            Put (", true: ");
+            Put (Int32 (Get_Type_Bool_True (Atype)));
+            New_Line;
+         when OT_Access =>
+            Put (" acc_type: ");
+            Put (Int32 (Get_Type_Access_Type (Atype)));
+            New_Line;
+         when OT_Record =>
+            Put ("  fields: ");
+            Put (Int32 (Get_Type_Record_Fields (Atype)));
+            Put (", nbr_fields: ");
+            Put (To_Int32 (Get_Type_Record_Nbr_Fields (Atype)));
+            New_Line;
+         when OT_Subarray =>
+            Put ("  base type: ");
+            Put (Int32 (Get_Type_Subarray_Base (Atype)));
+            Put (", length: ");
+            Put (To_Int32 (Get_Type_Subarray_Length (Atype)));
+            New_Line;
+         when others =>
+            null;
+      end case;
+   end Debug_Type;
+
+   procedure Debug_Field (Field : O_Fnode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+   begin
+      Put (Int32 (Field), 3);
+      Put (" ");
+      Put (" Offset=");
+      Put (To_Int32 (Get_Field_Offset (Field)), 0);
+      Put (", Ident=");
+      Put (Ortho_Ident.Get_String (Get_Field_Ident (Field)));
+      Put (", Type=");
+      Put (Int32 (Get_Field_Type (Field)), 0);
+      Put (", Chain=");
+      Put (Int32 (Get_Field_Chain (Field)), 0);
+      New_Line;
+   end Debug_Field;
+
+   function Get_Type_Limit return O_Tnode is
+   begin
+      return Tnodes.Last;
+   end Get_Type_Limit;
+
+   function Get_Type_Next (Atype : O_Tnode) return O_Tnode is
+   begin
+      case Tnodes.Table (Atype).Kind is
+         when OT_Unsigned
+           | OT_Signed
+           | OT_Float =>
+            return Atype + 1;
+         when OT_Boolean
+           | OT_Enum
+           | OT_Ucarray
+           | OT_Subarray
+           | OT_Access
+           | OT_Record
+           | OT_Union =>
+            return Atype + 2;
+         when OT_Complete =>
+            return Atype + 1;
+      end case;
+   end Get_Type_Next;
+
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      case Get_Type_Kind (Atype) is
+         when OT_Subarray =>
+            return Get_Type_Subarray_Base (Atype);
+         when others =>
+            return Atype;
+      end case;
+   end Get_Base_Type;
+
+   procedure Mark (M : out Mark_Type) is
+   begin
+      M.Tnode := Tnodes.Last;
+      M.Fnode := Fnodes.Last;
+   end Mark;
+
+   procedure Release (M : Mark_Type) is
+   begin
+      Tnodes.Set_Last (M.Tnode);
+      Fnodes.Set_Last (M.Fnode);
+   end Release;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Tnodes: " & O_Tnode'Image (Tnodes.Last));
+      Put_Line ("Number of Fnodes: " & O_Fnode'Image (Fnodes.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Tnodes.Free;
+      Fnodes.Free;
+   end Finish;
+end Ortho_Code.Types;
diff --git a/src/ortho/mcode/ortho_code-types.ads b/src/ortho/mcode/ortho_code-types.ads
new file mode 100644
index 000000000..da6549841
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-types.ads
@@ -0,0 +1,240 @@
+--  Mcode back-end for ortho - type handling.
+--  Copyright (C) 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.
+package Ortho_Code.Types is
+   type OT_Kind is (OT_Unsigned, OT_Signed, OT_Boolean, OT_Enum, OT_Float,
+                    OT_Ucarray, OT_Subarray, OT_Access,
+                    OT_Record, OT_Union,
+
+                    --  Type completion.  Mark the completion of a type.
+                    --  Optionnal.
+                    OT_Complete);
+
+   --  Kind of ATYPE.
+   function Get_Type_Kind (Atype : O_Tnode) return OT_Kind;
+
+   --  Number of bytes of type ATYPE.
+   function Get_Type_Size (Atype : O_Tnode) return Uns32;
+
+   --  Same as Get_Type_Size but for modes.
+   --  Returns 0 in case of error.
+   function Get_Mode_Size (Mode : Mode_Type) return Uns32;
+
+   --  Alignment for ATYPE, in power of 2.
+   subtype Small_Natural is Natural range 0 .. 3;
+   type Mode_Align_Array is array (Mode_Type) of Small_Natural;
+   function Get_Type_Align (Atype : O_Tnode) return Small_Natural;
+
+   --  Alignment for ATYPE in bytes.
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32;
+
+   --  Return true is the type was incomplete at creation.
+   --  (it may - or not - have been completed later).
+   function Get_Type_Deferred (Atype : O_Tnode) return Boolean;
+
+   --  A back-end reserved flag.
+   --  Initialized to False.
+   function Get_Type_Flag1 (Atype : O_Tnode) return Boolean;
+   procedure Set_Type_Flag1 (Atype : O_Tnode; Flag : Boolean);
+
+   --  Align OFF on ATYPE.
+   function Do_Align (Off : Uns32; Atype : O_Tnode) return Uns32;
+   function Do_Align (Off : Uns32; Mode : Mode_Type) return Uns32;
+
+   --  Get the mode for ATYPE.
+   function Get_Type_Mode (Atype : O_Tnode) return Mode_Type;
+
+   --  Get the type designated by access type ATYPE.
+   function Get_Type_Access_Type (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the index type of array type ATYPE.
+   function Get_Type_Ucarray_Index (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the element type of array type ATYPE.
+   function Get_Type_Ucarray_Element (Atype : O_Tnode) return O_Tnode;
+
+   --  Get the base type of array type ATYPE.
+   function Get_Type_Subarray_Base (Atype : O_Tnode) return O_Tnode;
+
+   --  Get number of element for array type ATYPE.
+   function Get_Type_Subarray_Length (Atype : O_Tnode) return Uns32;
+
+   --  Get the first field of record/union ATYPE.
+   function Get_Type_Record_Fields (Atype : O_Tnode) return O_Fnode;
+
+   --  Get the number of fields of record/union ATYPE.
+   function Get_Type_Record_Nbr_Fields (Atype : O_Tnode) return Uns32;
+
+   --  Get the first literal of enum type ATYPE.
+   function Get_Type_Enum_Lits (Atype : O_Tnode) return O_Cnode;
+
+   --  Get the POS th literal of enum type ATYPE.
+   --  The first is when POS = 0.
+   function Get_Type_Enum_Lit (Atype : O_Tnode; Pos : Uns32) return O_Cnode;
+
+   --  Get the number of literals of enum type ATYPE.
+   function Get_Type_Enum_Nbr_Lits (Atype : O_Tnode) return Uns32;
+
+   --  Get the false/true literal of boolean type ATYPE.
+   function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode;
+   function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode;
+
+   --  Return the union/record type which contains FIELD.
+   function Get_Field_Parent (Field : O_Fnode) return O_Tnode;
+
+   --  Get the offset of FIELD in its record/union.
+   function Get_Field_Offset (Field : O_Fnode) return Uns32;
+   procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32);
+
+   --  Get the type of FIELD.
+   function Get_Field_Type (Field : O_Fnode) return O_Tnode;
+
+   --  Get the name of FIELD.
+   function Get_Field_Ident (Field : O_Fnode) return O_Ident;
+
+   --  Get the next field.
+   function Get_Field_Chain (Field : O_Fnode) return O_Fnode;
+
+   --  Get the type that was completed.
+   function Get_Type_Complete_Type (Atype : O_Tnode) return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : Uns32)
+     return O_Tnode;
+
+   --  Return the base type of ATYPE: for a subarray this is the uc array,
+   --  otherwise this is the type.
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode;
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Non-primitives.
+
+   --  Type of an element of a ucarray or constrained array.
+   function Get_Type_Array_Element (Atype : O_Tnode) return O_Tnode;
+
+   --  Get a type number limit (an O_Tnode is a number).
+   --  There is no type whose number is beyond this limit.
+   --  Note: the limit may not be a type!
+   function Get_Type_Limit return O_Tnode;
+
+   --  Get the type which follows ATYPE.
+   --  User has to check that the result is valid (ie not beyond limit).
+   function Get_Type_Next (Atype : O_Tnode) return O_Tnode;
+
+   procedure Disp_Stats;
+
+   --  Free all the memory used.
+   procedure Finish;
+
+   type Mark_Type is limited private;
+   procedure Mark (M : out Mark_Type);
+   procedure Release (M : Mark_Type);
+
+   procedure Debug_Type (Atype : O_Tnode);
+   procedure Debug_Field (Field : O_Fnode);
+private
+   type O_Enum_List is record
+      Res : O_Tnode;
+      First : O_Cnode;
+      Last : O_Cnode;
+      Nbr : Uns32;
+   end record;
+
+   type O_Element_List is record
+      Res : O_Tnode;
+      Nbr : Uns32;
+      Off : Uns32;
+      Align : Small_Natural;
+      First_Field : O_Fnode;
+      Last_Field : O_Fnode;
+   end record;
+
+   type Mark_Type is record
+      Tnode : O_Tnode;
+      Fnode : O_Fnode;
+   end record;
+
+end Ortho_Code.Types;
+
diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb
new file mode 100644
index 000000000..bb06d51d4
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-abi.adb
@@ -0,0 +1,762 @@
+--  X86 ABI definitions.
+--  Copyright (C) 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 Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+with Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.Disps;
+with Ortho_Code.Flags;
+with Ortho_Code.Dwarf;
+with Ortho_Code.X86; use Ortho_Code.X86;
+with Ortho_Code.X86.Insns;
+with Ortho_Code.X86.Emits;
+with Ortho_Code.X86.Flags;
+with Binary_File;
+with Binary_File.Memory;
+with Ada.Text_IO;
+
+package body Ortho_Code.X86.Abi is
+   procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg)
+   is
+      pragma Unreferenced (Subprg);
+   begin
+      --  First argument is at %ebp + 8
+      Abi.Offset := 8;
+   end Start_Subprogram;
+
+   procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg)
+   is
+      Itype : O_Tnode;
+      Size : Uns32;
+   begin
+      Itype := Get_Decl_Type (Inter);
+      Size := Get_Type_Size (Itype);
+      Size := (Size + 3) and not 3;
+      Set_Local_Offset (Inter, Abi.Offset);
+      Abi.Offset := Abi.Offset + Int32 (Size);
+   end New_Interface;
+
+   procedure Finish_Subprogram (Subprg : O_Dnode; Abi : in out O_Abi_Subprg)
+   is
+      use Binary_File;
+      function To_Int32 is new Ada.Unchecked_Conversion
+        (Source => Symbol, Target => Int32);
+   begin
+      Set_Decl_Info (Subprg,
+                     To_Int32 (Create_Symbol (Get_Decl_Ident (Subprg))));
+      --  Offset is 8 biased.
+      Set_Subprg_Stack (Subprg, Abi.Offset - 8);
+   end Finish_Subprogram;
+
+   procedure Link_Stmt (Stmt : O_Enode) is
+   begin
+      Set_Stmt_Link (Last_Link, Stmt);
+      Last_Link := Stmt;
+   end Link_Stmt;
+
+   procedure Disp_Subprg (Subprg : O_Dnode);
+
+
+   Exprs_Mark : Exprs.Mark_Type;
+   Decls_Mark : Decls.Mark_Type;
+   Consts_Mark : Consts.Mark_Type;
+   Types_Mark : Types.Mark_Type;
+   Dwarf_Mark : Dwarf.Mark_Type;
+
+   procedure Start_Body (Subprg : O_Dnode)
+   is
+      pragma Unreferenced (Subprg);
+   begin
+      if not Debug.Flag_Debug_Keep then
+         Mark (Exprs_Mark);
+         Mark (Decls_Mark);
+         Consts.Mark (Consts_Mark);
+         Mark (Types_Mark);
+      end if;
+   end Start_Body;
+
+   procedure Finish_Body (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Flags;
+
+      Child : Subprogram_Data_Acc;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Disps.Disp_Subprg (Subprg);
+         return;
+      end if;
+
+      Insns.Gen_Subprg_Insns (Subprg);
+
+      if Ortho_Code.Debug.Flag_Debug_Body2 then
+         Disp_Subprg_Body (1, Subprg.E_Entry);
+      end if;
+
+      if Ortho_Code.Debug.Flag_Debug_Code then
+         Disp_Subprg (Subprg.D_Body);
+      end if;
+
+      Emits.Emit_Subprg (Subprg);
+
+      if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel
+        and then Flag_Debug = Debug_Dwarf
+      then
+         Dwarf.Emit_Decls_Until (Subprg.D_Body);
+         if not Debug.Flag_Debug_Keep then
+            Dwarf.Mark (Dwarf_Mark);
+         end if;
+      end if;
+
+      --  Recurse on nested subprograms.
+      Child := Subprg.First_Child;
+      while Child /= null loop
+         Finish_Body (Child);
+         Child := Child.Brother;
+      end loop;
+
+      if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel then
+         if Flag_Debug = Debug_Dwarf then
+            Dwarf.Emit_Subprg (Subprg.D_Body);
+         end if;
+
+         if not Debug.Flag_Debug_Keep then
+            Release (Exprs_Mark);
+            Release (Decls_Mark);
+            Consts.Release (Consts_Mark);
+            Release (Types_Mark);
+            Dwarf.Release (Dwarf_Mark);
+         end if;
+      end if;
+   end Finish_Body;
+
+   procedure Expand_Const_Decl (Decl : O_Dnode) is
+   begin
+      Emits.Emit_Const_Decl (Decl);
+   end Expand_Const_Decl;
+
+   procedure Expand_Var_Decl (Decl : O_Dnode) is
+   begin
+      Emits.Emit_Var_Decl (Decl);
+   end Expand_Var_Decl;
+
+   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode) is
+   begin
+      Emits.Emit_Const_Value (Decl, Val);
+   end Expand_Const_Value;
+
+   procedure Disp_Label (Label : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("L");
+      Put (Int32 (Label), 0);
+   end Disp_Label;
+
+   procedure Disp_Reg (Reg : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("reg_");
+      Put (Int32 (Reg), 0);
+      Put ("{");
+      Put (Image_Reg (Get_Expr_Reg (Reg)));
+      Put ("}");
+   end Disp_Reg;
+
+   procedure Disp_Local (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      Obj : constant O_Dnode := Get_Addr_Object (Stmt);
+      Frame : constant O_Enode := Get_Addrl_Frame (Stmt);
+   begin
+      if Frame = O_Enode_Null then
+         Put ("fp");
+      else
+         Disp_Reg (Frame);
+      end if;
+      Put (",");
+      Put (Get_Local_Offset (Obj), 0);
+      Put (" {");
+      Disp_Decl_Name (Obj);
+      Put ("}");
+   end Disp_Local;
+
+   procedure Disp_Uns32 (Val : Uns32)
+   is
+      use Ada.Text_IO;
+      U2c : constant array (Uns32 range 0 .. 15) of Character
+        := "0123456789abcdef";
+      V : Uns32 := Val;
+   begin
+      for I in 0 .. 7 loop
+         Put (U2c (Shift_Right (V, 28)));
+         V := Shift_Left (V, 4);
+      end loop;
+   end Disp_Uns32;
+
+   procedure Disp_Const (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+   begin
+      Put ("[");
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U64
+           | Mode_I64
+           | Mode_F64 =>
+            Disp_Uns32 (Get_Expr_High (Stmt));
+            Put (",");
+         when others =>
+            null;
+      end case;
+      Disp_Uns32 (Get_Expr_Low (Stmt));
+      Put ("]");
+   end Disp_Const;
+
+   procedure Disp_Irm_Code (Stmt : O_Enode)
+   is
+      use Ortho_Code.Debug.Int32_IO;
+      use Ada.Text_IO;
+      Reg : O_Reg;
+      Kind : OE_Kind;
+   begin
+      Reg := Get_Expr_Reg (Stmt);
+      Kind := Get_Expr_Kind (Stmt);
+      case Reg is
+         when R_Mem =>
+            case Kind is
+               when OE_Indir =>
+                  Put ('(');
+                  Disp_Irm_Code (Get_Expr_Operand (Stmt));
+                  Put (')');
+--                 when OE_Lit =>
+--                    Put ("(&n)");
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_Imm =>
+            case Kind is
+               when OE_Const =>
+                  Disp_Const (Stmt);
+               when OE_Addrg =>
+                  Put ("&");
+                  Disp_Decl_Name (Get_Addr_Object (Stmt));
+               when OE_Add =>
+                  Disp_Irm_Code (Get_Expr_Left (Stmt));
+                  Put ("+");
+                  Disp_Irm_Code (Get_Expr_Right (Stmt));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when Regs_R32
+           | R_Any32
+           | R_Any8
+           | Regs_R64
+           | R_Any64
+           | Regs_Cc
+           | Regs_Fp
+           | Regs_Xmm =>
+            Disp_Reg (Stmt);
+         when R_Spill =>
+            Disp_Reg (Stmt);
+            --Disp_Irm_Code (Get_Stmt_Link (Stmt));
+         when R_B_Off
+           | R_I_Off
+           | R_B_I
+           | R_Sib =>
+            case Kind is
+               when OE_Addrl =>
+                  Disp_Local (Stmt);
+               when OE_Add =>
+                  Disp_Irm_Code (Get_Expr_Left (Stmt));
+                  Put (" + ");
+                  Disp_Irm_Code (Get_Expr_Right (Stmt));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_I =>
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (" * ");
+            case Get_Expr_Low (Get_Expr_Right (Stmt)) is
+               when 0 =>
+                  Put ('1');
+               when 1 =>
+                  Put ('2');
+               when 2 =>
+                  Put ('4');
+               when 3 =>
+                  Put ('8');
+               when others =>
+                  Put ('?');
+            end case;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("abi.disp_irm_code: unhandled reg=" & Image_Reg (Reg)
+               & ", stmt=" & O_Enode'Image (Stmt));
+            raise Program_Error;
+      end case;
+   end Disp_Irm_Code;
+
+   procedure Disp_Decls (Block : O_Dnode)
+   is
+      Decl : O_Dnode;
+      Last : O_Dnode;
+   begin
+      Last := Get_Block_Last (Block);
+      Disp_Decl (2, Block);
+      Decl := Block + 1;
+      while Decl <= Last loop
+         case Get_Decl_Kind (Decl) is
+            when OD_Local =>
+               Disp_Decl (2, Decl);
+            when OD_Block =>
+               --  Skip internal blocks.
+               Decl := Get_Block_Last (Decl);
+            when others =>
+               Disp_Decl (2, Decl);
+               null;
+         end case;
+         Decl := Decl + 1;
+      end loop;
+   end Disp_Decls;
+
+   procedure Disp_Stmt (Stmt : O_Enode)
+   is
+      use Ada.Text_IO;
+      use Debug.Int32_IO;
+      Kind : OE_Kind;
+      Mode : Mode_Type;
+
+      procedure Disp_Op_Name (Name : String) is
+      begin
+         Put (Name);
+         Put (":");
+         Debug.Disp_Mode (Mode);
+         Put (" ");
+      end Disp_Op_Name;
+
+      procedure Disp_Reg_Op_Name (Name : String) is
+      begin
+         Put ("  ");
+         Disp_Reg (Stmt);
+         Put (" = ");
+         Disp_Op_Name (Name);
+      end Disp_Reg_Op_Name;
+
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      Mode := Get_Expr_Mode (Stmt);
+
+      case Kind is
+         when OE_Beg =>
+            Put ("  # block start");
+            if Get_Block_Has_Alloca (Stmt) then
+               Put (" [alloca]");
+            end if;
+            New_Line;
+            Disp_Decls (Get_Block_Decls (Stmt));
+         when OE_End =>
+            Put_Line ("  # block end");
+         when OE_Indir =>
+            Disp_Reg_Op_Name ("indir");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            Put_Line (")");
+         when OE_Alloca =>
+            Disp_Reg_Op_Name ("alloca");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            Put_Line (")");
+         when OE_Kind_Cmp
+           | OE_Kind_Dyadic =>
+            Disp_Reg_Op_Name ("op");
+            Put ("{");
+            Put (OE_Kind'Image (Kind));
+            Put ("} ");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Abs_Ov
+           | OE_Neg_Ov
+           | OE_Not =>
+            Disp_Reg_Op_Name ("op");
+            Put ("{");
+            Put (OE_Kind'Image (Kind));
+            Put ("} ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Const =>
+            Disp_Reg_Op_Name ("const");
+            Disp_Const (Stmt);
+            New_Line;
+         when OE_Jump_F =>
+            Put ("  jump_f ");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (" ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Jump_T =>
+            Put ("  jump_t ");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (" ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Jump =>
+            Put ("  jump ");
+            Disp_Label (Get_Jump_Label (Stmt));
+            New_Line;
+         when OE_Label =>
+            Disp_Label (Stmt);
+            Put_Line (":");
+         when OE_Asgn =>
+            Put ("  assign:");
+            Debug.Disp_Mode (Mode);
+            Put (" (");
+            Disp_Irm_Code (Get_Assign_Target (Stmt));
+            Put (") <- ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Set_Stack =>
+            Put ("  set_stack");
+            Put (" <- ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Spill =>
+            Disp_Reg_Op_Name ("spill");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            Put (", offset=");
+            Put (Int32'Image (Get_Spill_Info (Stmt)));
+            New_Line;
+         when OE_Reload =>
+            Disp_Reg_Op_Name ("reload");
+            Disp_Reg (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Arg =>
+            Put ("  push ");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Call =>
+            if Get_Expr_Mode (Stmt) /= Mode_Nil then
+               Disp_Reg_Op_Name ("call");
+            else
+               Put ("  ");
+               Disp_Op_Name ("call");
+               Put (" ");
+            end if;
+            Disp_Decl_Name (Get_Call_Subprg (Stmt));
+            New_Line;
+         when OE_Stack_Adjust =>
+            Put ("  stack_adjust: ");
+            Put (Int32'Image (Get_Stack_Adjust (Stmt)));
+            New_Line;
+         when OE_Intrinsic =>
+            Disp_Reg_Op_Name ("intrinsic");
+            --Disp_Decl_Name (Get_Call_Subprg (Stmt));
+            New_Line;
+         when OE_Conv =>
+            Disp_Reg_Op_Name ("conv");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Move =>
+            Disp_Reg_Op_Name ("move");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Ret =>
+            Put ("  ret");
+            if Get_Expr_Mode (Stmt) /= Mode_Nil then
+               Put (" ");
+               Disp_Reg (Get_Expr_Operand (Stmt));
+            end if;
+            New_Line;
+         when OE_Case =>
+            Disp_Reg_Op_Name ("case");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Case_Expr =>
+            Disp_Reg_Op_Name ("case_expr");
+            Disp_Irm_Code (Get_Expr_Operand (Stmt));
+            New_Line;
+         when OE_Leave =>
+            Put_Line ("leave");
+         when OE_Entry =>
+            Put_Line ("entry");
+         when OE_Line =>
+            Put ("  # line #");
+            Put (Get_Expr_Line_Number (Stmt), 0);
+            New_Line;
+         when OE_Addrl =>
+            Disp_Reg_Op_Name ("lea{addrl}");
+            Put ("(");
+            Disp_Local (Stmt);
+            Put (")");
+            New_Line;
+         when OE_Addrg =>
+            Disp_Reg_Op_Name ("lea{addrg}");
+            Put ("&");
+            Disp_Decl_Name (Get_Addr_Object (Stmt));
+            New_Line;
+         when OE_Add =>
+            Disp_Reg_Op_Name ("lea{add}");
+            Put ("(");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (" + ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            Put (")");
+            New_Line;
+         when OE_Mul =>
+            Disp_Reg_Op_Name ("mul");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Shl =>
+            Disp_Reg_Op_Name ("shl");
+            Disp_Irm_Code (Get_Expr_Left (Stmt));
+            Put (", ");
+            Disp_Irm_Code (Get_Expr_Right (Stmt));
+            New_Line;
+         when OE_Reg =>
+            Disp_Reg_Op_Name ("reg");
+            New_Line;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("abi.disp_stmt: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+   end Disp_Stmt;
+
+   procedure Disp_Subprg_Decl (Decl : O_Dnode)
+   is
+      use Ada.Text_IO;
+      Arg : O_Dnode;
+   begin
+      Put ("subprogram ");
+      Disp_Decl_Name (Decl);
+      Put_Line (":");
+      Arg := Decl + 1;
+      while Get_Decl_Kind (Arg) = OD_Interface loop
+         Disp_Decl (2, Arg);
+         Arg := Arg + 1;
+      end loop;
+   end Disp_Subprg_Decl;
+
+   procedure Disp_Subprg (Subprg : O_Dnode)
+   is
+      use Ada.Text_IO;
+
+      Stmt : O_Enode;
+   begin
+      Disp_Subprg_Decl (Get_Body_Decl (Subprg));
+
+      Stmt := Get_Body_Stmt (Subprg);
+      loop
+         exit when Stmt = O_Enode_Null;
+         Disp_Stmt (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+         Stmt := Get_Stmt_Link (Stmt);
+      end loop;
+   end Disp_Subprg;
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+   is
+      use Ortho_Code.Flags;
+   begin
+      if Flag_Debug = Debug_Dwarf then
+         Dwarf.Set_Filename ("", Filename);
+      end if;
+   end New_Debug_Filename_Decl;
+
+   procedure Init
+   is
+      use Ortho_Code.Debug;
+   begin
+      --  Alignment of doubles is platform dependent.
+      Mode_Align (Mode_F64) := X86.Flags.Mode_F64_Align;
+
+      if Flag_Debug_Hli then
+         Disps.Init;
+      else
+         Emits.Init;
+      end if;
+   end Init;
+
+   procedure Finish
+   is
+      use Ortho_Code.Debug;
+   begin
+      if Flag_Debug_Hli then
+         Disps.Finish;
+      else
+         Emits.Finish;
+      end if;
+   end Finish;
+
+--    function Image_Insn (Insn : O_Insn) return String is
+--    begin
+--       case Insn is
+--          when Insn_Nil =>
+--             return "nil";
+--          when Insn_Imm =>
+--             return "imm";
+--          when Insn_Base_Off =>
+--             return "B+O";
+--          when Insn_Loadm =>
+--             return "ldm";
+--          when Insn_Loadi =>
+--             return "ldi";
+--          when Insn_Mem =>
+--             return "mem";
+--          when Insn_Cmp =>
+--             return "cmp";
+--          when Insn_Op =>
+--             return "op ";
+--          when Insn_Rop =>
+--             return "rop";
+--          when Insn_Call =>
+--             return "cal";
+--          when others =>
+--             return "???";
+--       end case;
+--    end Image_Insn;
+
+   function Image_Reg (Reg : O_Reg) return String is
+   begin
+      case Reg is
+         when R_Nil =>
+            return "nil ";
+         when R_None =>
+            return " -- ";
+         when R_Spill =>
+            return "spil";
+         when R_Mem =>
+            return "mem ";
+         when R_Imm =>
+            return "imm ";
+         when R_Irm =>
+            return "irm ";
+         when R_Rm =>
+            return "rm  ";
+         when R_Sib =>
+            return "sib ";
+         when R_B_Off =>
+            return "b+o ";
+         when R_B_I =>
+            return "b+i ";
+         when R_I =>
+            return "s*i ";
+         when R_Ir =>
+            return " ir ";
+         when R_I_Off =>
+            return "i+o ";
+         when R_Any32 =>
+            return "r32 ";
+         when R_Any_Cc =>
+            return "cc  ";
+         when R_Any8 =>
+            return "r8  ";
+         when R_Any64 =>
+            return "r64 ";
+
+         when R_St0 =>
+            return "st0 ";
+         when R_Ax =>
+            return "ax  ";
+         when R_Dx =>
+            return "dx  ";
+         when R_Cx =>
+            return "cx  ";
+         when R_Bx =>
+            return "bx  ";
+         when R_Si =>
+            return "si  ";
+         when R_Di =>
+            return "di  ";
+         when R_Sp =>
+            return "sp  ";
+         when R_Bp =>
+            return "bp  ";
+         when R_Edx_Eax =>
+            return "dxax";
+         when R_Ebx_Ecx =>
+            return "bxcx";
+         when R_Esi_Edi =>
+            return "sidi";
+         when R_Eq =>
+            return "eq? ";
+         when R_Ne =>
+            return "ne? ";
+         when R_Uge =>
+            return "uge?";
+         when R_Sge =>
+            return "sge?";
+         when R_Ugt =>
+            return "ugt?";
+         when R_Sgt =>
+            return "sgt?";
+         when R_Ule =>
+            return "ule?";
+         when R_Sle =>
+            return "sle?";
+         when R_Ult =>
+            return "ult?";
+         when R_Slt =>
+            return "slt?";
+         when R_Xmm0 =>
+            return "xmm0";
+         when R_Xmm1 =>
+            return "xmm1";
+         when R_Xmm2 =>
+            return "xmm2";
+         when R_Xmm3 =>
+            return "xmm3";
+         when others =>
+            return "????";
+      end case;
+   end Image_Reg;
+
+   --  From GCC.
+   --  FIXME: these don't handle overflow!
+   function Divdi3 (A, B : Long_Integer) return Long_Integer;
+   pragma Import (C, Divdi3, "__divdi3");
+
+   function Muldi3 (A, B : Long_Integer) return Long_Integer;
+   pragma Import (C, Muldi3, "__muldi3");
+
+   procedure Chkstk (Sz : Integer);
+   pragma Import (C, Chkstk, "__chkstk");
+
+   procedure Link_Intrinsics
+   is
+   begin
+      Binary_File.Memory.Set_Symbol_Address
+        (Ortho_Code.X86.Emits.Intrinsics_Symbol
+         (Ortho_Code.X86.Intrinsic_Mul_Ov_I64),
+         Muldi3'Address);
+      Binary_File.Memory.Set_Symbol_Address
+        (Ortho_Code.X86.Emits.Intrinsics_Symbol
+         (Ortho_Code.X86.Intrinsic_Div_Ov_I64),
+         Divdi3'Address);
+      if X86.Flags.Flag_Alloca_Call then
+         Binary_File.Memory.Set_Symbol_Address
+           (Ortho_Code.X86.Emits.Chkstk_Symbol, Chkstk'Address);
+      end if;
+   end Link_Intrinsics;
+end Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-x86-abi.ads b/src/ortho/mcode/ortho_code-x86-abi.ads
new file mode 100644
index 000000000..7b166dad8
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-abi.ads
@@ -0,0 +1,76 @@
+--  X86 ABI definitions.
+--  Copyright (C) 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 Ortho_Code.Types; use Ortho_Code.Types;
+
+package Ortho_Code.X86.Abi is
+   type O_Abi_Subprg is private;
+
+   procedure Init;
+   procedure Finish;
+
+   Mode_Align : Mode_Align_Array :=
+     (Mode_U8 | Mode_I8 => 0,
+      Mode_U16 | Mode_I16 => 1,
+      Mode_U32 | Mode_I32 | Mode_F32 | Mode_P32 => 2,
+      Mode_U64 | Mode_I64 => 2,
+      Mode_F64 => 2, -- 2 for SVR4-ABI and Darwin, 3 for Windows.
+      Mode_Blk | Mode_X1 | Mode_Nil | Mode_P64 => 0,
+      Mode_B2 => 0);
+
+   Mode_Ptr : constant Mode_Type := Mode_P32;
+
+   Flag_Type_Completer : constant Boolean := False;
+   Flag_Lower_Stmt : constant Boolean := True;
+
+   Flag_Sse2 : Boolean := False;
+
+   --  Procedures to layout a subprogram declaration.
+   procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg);
+   procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg);
+   procedure Finish_Subprogram (Subprg : O_Dnode; Abi : in out O_Abi_Subprg);
+
+   --  Only called for top-level subprograms.
+   procedure Start_Body (Subprg : O_Dnode);
+   --  Finish compilation of a body.
+   procedure Finish_Body (Subprg : Subprogram_Data_Acc);
+
+   procedure Expand_Const_Decl (Decl : O_Dnode);
+   procedure Expand_Var_Decl (Decl : O_Dnode);
+   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   Last_Link : O_Enode;
+   procedure Link_Stmt (Stmt : O_Enode);
+
+   --  Disp SUBPRG (subprg declaration) as a declaration (name and interfaces).
+   procedure Disp_Subprg_Decl (Decl : O_Dnode);
+
+   procedure Disp_Stmt (Stmt : O_Enode);
+
+   --function Image_Insn (Insn : O_Insn) return String;
+   function Image_Reg (Reg : O_Reg) return String;
+
+   --  Link in memory intrinsics symbols.
+   procedure Link_Intrinsics;
+private
+   type O_Abi_Subprg is record
+      --  For x86: offset of the next argument.
+      Offset : Int32 := 0;
+   end record;
+end Ortho_Code.X86.Abi;
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb
new file mode 100644
index 000000000..ad1ef559b
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-emits.adb
@@ -0,0 +1,2322 @@
+--  Mcode back-end for ortho - Binary X86 instructions generator.
+--  Copyright (C) 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 Ortho_Code.Abi;
+with Ortho_Code.Decls;
+with Ortho_Code.Types;
+with Ortho_Code.Consts;
+with Ortho_Code.Debug;
+with Ortho_Code.X86.Insns;
+with Ortho_Code.X86.Flags;
+with Ortho_Code.Flags;
+with Ortho_Code.Dwarf;
+with Ortho_Code.Binary; use Ortho_Code.Binary;
+with Ortho_Ident;
+with Ada.Text_IO;
+with Interfaces; use Interfaces;
+
+package body Ortho_Code.X86.Emits is
+   type Insn_Size is (Sz_8, Sz_16, Sz_32l, Sz_32h);
+
+   type Fp_Size is (Fp_32, Fp_64);
+
+   Sect_Text : Binary_File.Section_Acc;
+   Sect_Rodata : Binary_File.Section_Acc;
+   Sect_Bss : Binary_File.Section_Acc;
+
+   Reg_Helper : O_Reg;
+
+   Subprg_Pc : Pc_Type;
+
+   procedure Error_Emit (Msg : String; Insn : O_Enode)
+   is
+      use Ada.Text_IO;
+   begin
+      Put ("error_emit: ");
+      Put (Msg);
+      Put (", insn=");
+      Put (O_Enode'Image (Insn));
+      Put (" (");
+      Put (OE_Kind'Image (Get_Expr_Kind (Insn)));
+      Put (")");
+      New_Line;
+      raise Program_Error;
+   end Error_Emit;
+
+
+   procedure Gen_Insn_Sz (B : Byte; Sz : Insn_Size) is
+   begin
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (B);
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (B + 1);
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (B + 1);
+      end case;
+   end Gen_Insn_Sz;
+
+   procedure Gen_Insn_Sz_S8 (B : Byte; Sz : Insn_Size) is
+   begin
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (B);
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (B + 3);
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (B + 3);
+      end case;
+   end Gen_Insn_Sz_S8;
+
+   function Get_Const_Val (C : O_Enode; Sz : Insn_Size) return Uns32 is
+   begin
+      case Sz is
+         when Sz_8
+           | Sz_16
+           | Sz_32l =>
+            return Get_Expr_Low (C);
+         when Sz_32h =>
+            return Get_Expr_High (C);
+      end case;
+   end Get_Const_Val;
+
+   function Is_Imm8 (N : O_Enode; Sz : Insn_Size) return Boolean is
+   begin
+      if Get_Expr_Kind (N) /= OE_Const then
+         return False;
+      end if;
+      return Get_Const_Val (N, Sz) <= 127;
+   end Is_Imm8;
+
+   procedure Gen_Imm8 (N : O_Enode; Sz : Insn_Size) is
+   begin
+      Gen_B8 (Byte (Get_Const_Val (N, Sz)));
+   end Gen_Imm8;
+
+--     procedure Gen_Imm32 (N : O_Enode; Sz : Insn_Size)
+--     is
+--        use Interfaces;
+--     begin
+--        case Get_Expr_Kind (N) is
+--           when OE_Const =>
+--              Gen_Le32 (Unsigned_32 (Get_Const_Val (N, Sz)));
+--           when OE_Addrg =>
+--              Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0);
+--           when others =>
+--              raise Program_Error;
+--        end case;
+--     end Gen_Imm32;
+
+   procedure Gen_Imm (N : O_Enode; Sz : Insn_Size) is
+   begin
+      case Get_Expr_Kind (N) is
+         when OE_Const =>
+            case Sz is
+               when Sz_8 =>
+                  Gen_B8 (Byte (Get_Expr_Low (N) and 16#FF#));
+               when Sz_16 =>
+                  Gen_Le16 (Unsigned_32 (Get_Expr_Low (N) and 16#FF_FF#));
+               when Sz_32l =>
+                  Gen_Le32 (Unsigned_32 (Get_Expr_Low (N)));
+               when Sz_32h =>
+                  Gen_Le32 (Unsigned_32 (Get_Expr_High (N)));
+            end case;
+         when OE_Addrg =>
+            if Sz /= Sz_32l then
+               raise Program_Error;
+            end if;
+            Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0);
+         when OE_Add =>
+            declare
+               P : O_Enode;
+               L, R : O_Enode;
+               S, C : O_Enode;
+               Off : Int32;
+            begin
+               Off := 0;
+               P := N;
+               if Sz /= Sz_32l then
+                  raise Program_Error;
+               end if;
+               loop
+                  L := Get_Expr_Left (P);
+                  R := Get_Expr_Right (P);
+
+                  --  Extract the const node.
+                  if Get_Expr_Kind (R) = OE_Const then
+                     S := L;
+                     C := R;
+                  elsif Get_Expr_Kind (L) = OE_Const then
+                     S := R;
+                     C := L;
+                  else
+                     raise Program_Error;
+                  end if;
+                  if Get_Expr_Mode (C) /= Mode_U32 then
+                     raise Program_Error;
+                  end if;
+                  Off := Off + To_Int32 (Get_Expr_Low (C));
+
+                  exit when Get_Expr_Kind (S) = OE_Addrg;
+                  P := S;
+                  if Get_Expr_Kind (P) /= OE_Add then
+                     raise Program_Error;
+                  end if;
+               end loop;
+               Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (S)),
+                           Integer_32 (Off));
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Imm;
+
+   Rm_Base : O_Reg;
+   Rm_Index : O_Reg;
+   Rm_Offset : Int32;
+   Rm_Sym : Symbol;
+   Rm_Scale : Byte;
+
+   procedure Fill_Sib (N : O_Enode)
+   is
+      use Ortho_Code.Decls;
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      if Reg in Regs_R32 then
+         if Rm_Base = R_Nil then
+            Rm_Base := Reg;
+         elsif Rm_Index = R_Nil then
+            Rm_Index := Reg;
+         else
+            raise Program_Error;
+         end if;
+         return;
+      end if;
+      case Get_Expr_Kind (N) is
+         when OE_Indir =>
+            Fill_Sib (Get_Expr_Operand (N));
+         when OE_Addrl =>
+            declare
+               Frame : O_Enode;
+            begin
+               Frame := Get_Addrl_Frame (N);
+               if Frame = O_Enode_Null then
+                  Rm_Base := R_Bp;
+               else
+                  Rm_Base := Get_Expr_Reg (Frame);
+               end if;
+            end;
+            Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Object (N));
+         when OE_Addrg =>
+            if Rm_Sym /= Null_Symbol then
+               raise Program_Error;
+            end if;
+            Rm_Sym := Get_Decl_Symbol (Get_Addr_Object (N));
+         when OE_Add =>
+            Fill_Sib (Get_Expr_Left (N));
+            Fill_Sib (Get_Expr_Right (N));
+         when OE_Const =>
+            Rm_Offset := Rm_Offset + To_Int32 (Get_Expr_Low (N));
+         when OE_Shl =>
+            if Rm_Index /= R_Nil then
+               raise Program_Error;
+            end if;
+            Rm_Index := Get_Expr_Reg (Get_Expr_Left (N));
+            Rm_Scale := Byte (Get_Expr_Low (Get_Expr_Right (N)));
+         when others =>
+            Error_Emit ("fill_sib", N);
+      end case;
+   end Fill_Sib;
+
+   function To_Reg32 (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+   end To_Reg32;
+   pragma Inline (To_Reg32);
+
+   function To_Reg_Xmm (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Xmm0);
+   end To_Reg_Xmm;
+   pragma Inline (To_Reg_Xmm);
+
+   function To_Reg32 (R : O_Reg; Sz : Insn_Size) return Byte is
+   begin
+      case Sz is
+         when Sz_8 =>
+            if R in Regs_R8 then
+               return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+            else
+               raise Program_Error;
+            end if;
+         when Sz_16 =>
+            if R in Regs_R32 then
+               return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+            else
+               raise Program_Error;
+            end if;
+         when Sz_32l =>
+            case R is
+               when Regs_R32 =>
+                  return O_Reg'Pos (R) - O_Reg'Pos (R_Ax);
+               when R_Edx_Eax =>
+                  return 2#000#;
+               when R_Ebx_Ecx =>
+                  return 2#001#;
+               when R_Esi_Edi =>
+                  return 2#111#;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when Sz_32h =>
+            case R is
+               when R_Edx_Eax =>
+                  return 2#010#;
+               when R_Ebx_Ecx =>
+                  return 2#011#;
+               when R_Esi_Edi =>
+                  return 2#110#;
+               when others =>
+                  raise Program_Error;
+            end case;
+      end case;
+   end To_Reg32;
+
+   function To_Cond (R : O_Reg) return Byte is
+   begin
+      return O_Reg'Pos (R) - O_Reg'Pos (R_Ov);
+   end To_Cond;
+   pragma Inline (To_Cond);
+
+   procedure Gen_Sib is
+   begin
+      if Rm_Base = R_Nil then
+         Gen_B8 (Rm_Scale * 2#1_000_000#
+                 + To_Reg32 (Rm_Index) * 2#1_000#
+                 + 2#101#);
+      else
+         Gen_B8 (Rm_Scale * 2#1_000_000#
+                 + To_Reg32 (Rm_Index) * 2#1_000#
+                 + To_Reg32 (Rm_Base));
+      end if;
+   end Gen_Sib;
+
+   --  Generate an R/M (+ SIB) byte.
+   --  R is added to the R/M byte.
+   procedure Gen_Rm_Mem (R : Byte; N : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      Rm_Base := R_Nil;
+      Rm_Index := R_Nil;
+      if Sz = Sz_32h then
+         Rm_Offset := 4;
+      else
+         Rm_Offset := 0;
+      end if;
+      Rm_Scale := 0;
+      Rm_Sym := Null_Symbol;
+      case Reg is
+         when R_Mem
+           | R_Imm
+           | R_Eq
+           | R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            Fill_Sib (N);
+         when Regs_R32 =>
+            Rm_Base := Reg;
+         when R_Spill =>
+            Rm_Base := R_Bp;
+            Rm_Offset := Rm_Offset + Get_Spill_Info (N);
+         when others =>
+            Error_Emit ("gen_rm_mem: unhandled reg", N);
+      end case;
+      if Rm_Index /= R_Nil then
+         --  SIB.
+         if Rm_Base = R_Nil then
+            Gen_B8 (2#00_000_100# + R);
+            Rm_Base := R_Bp;
+            Gen_Sib;
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         elsif Rm_Sym = Null_Symbol and Rm_Offset = 0 and Rm_Base /= R_Bp then
+            Gen_B8 (2#00_000_100# + R);
+            Gen_Sib;
+         elsif Rm_Sym = Null_Symbol and Rm_Offset <= 127 and Rm_Offset >= -128
+         then
+            Gen_B8 (2#01_000_100# + R);
+            Gen_Sib;
+            Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#));
+         else
+            Gen_B8 (2#10_000_100# + R);
+            Gen_Sib;
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         end if;
+         return;
+      end if;
+      case Rm_Base is
+         when R_Sp =>
+            raise Program_Error;
+         when R_Nil =>
+            Gen_B8 (2#00_000_101# + R);
+            Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+         when R_Ax
+            | R_Bx
+            | R_Cx
+            | R_Dx
+            | R_Bp
+            | R_Si
+            | R_Di =>
+            if Rm_Offset = 0 and Rm_Sym = Null_Symbol and Rm_Base /= R_Bp then
+               Gen_B8 (2#00_000_000# + R + To_Reg32 (Rm_Base));
+            elsif Rm_Sym = Null_Symbol
+               and Rm_Offset <= 127 and Rm_Offset >= -128
+            then
+               Gen_B8 (2#01_000_000# + R + To_Reg32 (Rm_Base));
+               Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#));
+            else
+               Gen_B8 (2#10_000_000# + R + To_Reg32 (Rm_Base));
+               Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset));
+            end if;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Rm_Mem;
+
+   procedure Gen_Rm (R : Byte; N : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (N);
+      if Reg in Regs_R32 or Reg in Regs_R64 then
+         Gen_B8 (2#11_000_000# + R + To_Reg32 (Reg, Sz));
+         return;
+      else
+         Gen_Rm_Mem (R, N, Sz);
+      end if;
+   end Gen_Rm;
+
+   procedure Emit_Op (Op : Byte; Stmt : O_Enode; Sz : Insn_Size)
+   is
+      L, R : O_Enode;
+      Lr, Rr : O_Reg;
+   begin
+      L := Get_Expr_Left (Stmt);
+      R := Get_Expr_Right (Stmt);
+      Lr := Get_Expr_Reg (L);
+      Rr := Get_Expr_Reg (R);
+      Start_Insn;
+      case Rr is
+         when R_Imm =>
+            if Is_Imm8 (R, Sz) then
+               Gen_Insn_Sz_S8 (16#80#, Sz);
+               Gen_Rm (Op, L, Sz);
+               Gen_Imm8 (R, Sz);
+            elsif Lr = R_Ax then
+               Gen_Insn_Sz (2#000_000_100# + Op, Sz);
+               Gen_Imm (R, Sz);
+            else
+               Gen_Insn_Sz (16#80#, Sz);
+               Gen_Rm (Op, L, Sz);
+               Gen_Imm (R, Sz);
+            end if;
+         when R_Mem
+           | R_Spill
+           | Regs_R32
+           | Regs_R64 =>
+            Gen_Insn_Sz (2#00_000_010# + Op, Sz);
+            Gen_Rm (To_Reg32 (Lr, Sz) * 8, R, Sz);
+         when others =>
+            Error_Emit ("emit_op", Stmt);
+      end case;
+      End_Insn;
+   end Emit_Op;
+
+   procedure Gen_Into is
+   begin
+      Start_Insn;
+      Gen_B8 (2#1100_1110#);
+      End_Insn;
+   end Gen_Into;
+
+   procedure Gen_Cdq is
+   begin
+      Start_Insn;
+      Gen_B8 (2#1001_1001#);
+      End_Insn;
+   end Gen_Cdq;
+
+   procedure Gen_Mono_Op (Op : Byte; Val : O_Enode; Sz : Insn_Size) is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1111_011_0#, Sz);
+      Gen_Rm (Op, Val, Sz);
+      End_Insn;
+   end Gen_Mono_Op;
+
+   procedure Emit_Mono_Op_Stmt (Op : Byte; Stmt : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      Gen_Mono_Op (Op, Get_Expr_Operand (Stmt), Sz);
+   end Emit_Mono_Op_Stmt;
+
+   procedure Emit_Load_Imm (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Tr : O_Reg;
+   begin
+      Tr := Get_Expr_Reg (Stmt);
+      Start_Insn;
+      --  FIXME: handle 0.
+      case Sz is
+         when Sz_8 =>
+            Gen_B8 (2#1011_0_000# + To_Reg32 (Tr, Sz));
+         when Sz_16 =>
+            Gen_B8 (16#66#);
+            Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz));
+         when Sz_32l
+           | Sz_32h =>
+            Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz));
+      end case;
+      Gen_Imm (Stmt, Sz);
+      End_Insn;
+   end Emit_Load_Imm;
+
+   function Fp_Size_To_Mf (Sz : Fp_Size) return Byte is
+   begin
+      case Sz is
+         when Fp_32 =>
+            return 2#00_0#;
+         when Fp_64 =>
+            return 2#10_0#;
+      end case;
+   end Fp_Size_To_Mf;
+
+   procedure Emit_Load_Fp (Stmt : O_Enode; Sz : Fp_Size)
+   is
+      Sym : Symbol;
+      R : O_Reg;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Gen_Pow_Align (3);
+      Prealloc (8);
+      Sym := Create_Local_Symbol;
+      Set_Symbol_Pc (Sym, False);
+      Gen_Le32 (Unsigned_32 (Get_Expr_Low (Stmt)));
+      if Sz = Fp_64 then
+         Gen_Le32 (Unsigned_32 (Get_Expr_High (Stmt)));
+      end if;
+      Set_Current_Section (Sect_Text);
+
+      R := Get_Expr_Reg (Stmt);
+      case R is
+         when R_St0 =>
+            Start_Insn;
+            Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+            Gen_B8 (2#00_000_101#);
+            Gen_X86_32 (Sym, 0);
+            End_Insn;
+         when Regs_Xmm =>
+            Start_Insn;
+            case Sz is
+               when Fp_32 =>
+                  Gen_B8 (16#F3#);
+               when Fp_64 =>
+                  Gen_B8 (16#F2#);
+            end case;
+            Gen_B8 (16#0f#);
+            Gen_B8 (16#10#);
+            Gen_B8 (2#00_000_101# + To_Reg_Xmm (R) * 2#1_000#);
+            Gen_X86_32 (Sym, 0);
+            End_Insn;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Emit_Load_Fp;
+
+   procedure Emit_Load_Fp_Mem (Stmt : O_Enode; Sz : Fp_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+      Gen_Rm_Mem (2#000_000#, Get_Expr_Operand (Stmt), Sz_32l);
+      End_Insn;
+   end Emit_Load_Fp_Mem;
+
+   procedure Emit_Load_Mem (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Tr : O_Reg;
+      Val : O_Enode;
+   begin
+      Tr := Get_Expr_Reg (Stmt);
+      Val := Get_Expr_Operand (Stmt);
+      case Tr is
+         when Regs_R32
+           | Regs_R64 =>
+            --  mov REG, OP
+            Start_Insn;
+            Gen_Insn_Sz (2#1000_101_0#, Sz);
+            Gen_Rm_Mem (To_Reg32 (Tr, Sz) * 8, Val, Sz);
+            End_Insn;
+         when R_Eq =>
+            --  Cmp OP, 1
+            Start_Insn;
+            Gen_Insn_Sz_S8 (2#1000_000_0#, Sz);
+            Gen_Rm_Mem (2#111_000#, Val, Sz);
+            Gen_B8 (1);
+            End_Insn;
+         when others =>
+            Error_Emit ("emit_load_mem", Stmt);
+      end case;
+   end Emit_Load_Mem;
+
+
+   procedure Emit_Store (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      T, R : O_Enode;
+      Tr, Rr : O_Reg;
+      B : Byte;
+   begin
+      T := Get_Assign_Target (Stmt);
+      R := Get_Expr_Operand (Stmt);
+      Tr := Get_Expr_Reg (T);
+      Rr := Get_Expr_Reg (R);
+      Start_Insn;
+      case Rr is
+         when R_Imm =>
+            if False and (Tr in Regs_R32 or Tr in Regs_R64) then
+               B := 2#1011_1_000#;
+               case Sz is
+                  when Sz_8 =>
+                     B := B and not 2#0000_1_000#;
+                  when Sz_16 =>
+                     Gen_B8 (16#66#);
+                  when Sz_32l
+                    | Sz_32h =>
+                     null;
+               end case;
+               Gen_B8 (B + To_Reg32 (Tr, Sz));
+            else
+               Gen_Insn_Sz (2#1100_011_0#, Sz);
+               Gen_Rm_Mem (16#00#, T, Sz);
+            end if;
+            Gen_Imm (R, Sz);
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_Insn_Sz (2#1000_100_0#, Sz);
+            Gen_Rm_Mem (To_Reg32 (Rr, Sz) * 8, T, Sz);
+         when others =>
+            Error_Emit ("emit_store", Stmt);
+      end case;
+      End_Insn;
+   end Emit_Store;
+
+   procedure Emit_Store_Fp (Stmt : O_Enode; Sz : Fp_Size)
+   is
+   begin
+      -- fstp
+      Start_Insn;
+      Gen_B8 (2#11011_00_1# + Fp_Size_To_Mf (Sz));
+      Gen_Rm_Mem (2#011_000#, Get_Assign_Target (Stmt), Sz_32l);
+      End_Insn;
+   end Emit_Store_Fp;
+
+   procedure Emit_Push_32 (Val : O_Enode; Sz : Insn_Size)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Val);
+      Start_Insn;
+      case R is
+         when R_Imm =>
+            if Is_Imm8 (Val, Sz) then
+               Gen_B8 (2#0110_1010#);
+               Gen_Imm8 (Val, Sz);
+            else
+               Gen_B8 (2#0110_1000#);
+               Gen_Imm (Val, Sz);
+            end if;
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_B8 (2#01010_000# + To_Reg32 (R, Sz));
+         when others =>
+            Gen_B8 (2#1111_1111#);
+            Gen_Rm (2#110_000#, Val, Sz);
+      end case;
+      End_Insn;
+   end Emit_Push_32;
+
+   procedure Emit_Pop_32 (Val : O_Enode; Sz : Insn_Size)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Val);
+      Start_Insn;
+      case R is
+         when Regs_R32
+           | Regs_R64 =>
+            Gen_B8 (2#01011_000# + To_Reg32 (R, Sz));
+         when others =>
+            Gen_B8 (2#1000_1111#);
+            Gen_Rm (2#000_000#, Val, Sz);
+      end case;
+      End_Insn;
+   end Emit_Pop_32;
+
+   procedure Emit_Push_Fp (Op : O_Enode; Sz : Fp_Size)
+   is
+      pragma Unreferenced (Op);
+   begin
+      Start_Insn;
+      --  subl esp, val
+      Gen_B8 (2#100000_11#);
+      Gen_B8 (2#11_101_100#);
+      case Sz is
+         when Fp_32 =>
+            Gen_B8 (4);
+         when Fp_64 =>
+            Gen_B8 (8);
+      end case;
+      End_Insn;
+      --  fstp st, (esp)
+      Start_Insn;
+      Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz));
+      Gen_B8 (2#00_011_100#);
+      Gen_B8 (2#00_100_100#);
+      End_Insn;
+   end Emit_Push_Fp;
+
+   function Prepare_Label (Label : O_Enode) return Symbol
+   is
+      Sym : Symbol;
+   begin
+      Sym := Get_Label_Symbol (Label);
+      if Sym = Null_Symbol then
+         Sym := Create_Local_Symbol;
+         Set_Label_Symbol (Label, Sym);
+      end if;
+      return Sym;
+   end Prepare_Label;
+
+   procedure Emit_Jmp_T (Stmt : O_Enode; Reg : O_Reg)
+   is
+      Sym : Symbol;
+      Val : Pc_Type;
+      Opc : Byte;
+   begin
+      Sym := Prepare_Label (Get_Jump_Label (Stmt));
+      Val := Get_Symbol_Value (Sym);
+      Start_Insn;
+      Opc := To_Cond (Reg);
+      if Val = 0 then
+         --  Assume long jmp.
+         Gen_B8 (16#0f#);
+         Gen_B8 (16#80# + Opc);
+         Gen_X86_Pc32 (Sym);
+      else
+         if Val + 128 < Get_Current_Pc + 4 then
+            --  Long jmp.
+            Gen_B8 (16#0f#);
+            Gen_B8 (16#80# + Opc);
+            Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4)));
+         else
+            --  short jmp.
+            Gen_B8 (16#70# + Opc);
+            Gen_B8 (Byte (Val - (Get_Current_Pc + 1)));
+         end if;
+      end if;
+      End_Insn;
+   end Emit_Jmp_T;
+
+   procedure Emit_Jmp (Stmt : O_Enode)
+   is
+      Sym : Symbol;
+      Val : Pc_Type;
+   begin
+      Sym := Prepare_Label (Get_Jump_Label (Stmt));
+      Val := Get_Symbol_Value (Sym);
+      Start_Insn;
+      if Val = 0 then
+         --  Assume long jmp.
+         Gen_B8 (16#e9#);
+         Gen_X86_Pc32 (Sym);
+      else
+         if Val + 128 < Get_Current_Pc + 4 then
+            --  Long jmp.
+            Gen_B8 (16#e9#);
+            Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4)));
+         else
+            --  short jmp.
+            Gen_B8 (16#eb#);
+            Gen_B8 (Byte ((Val - (Get_Current_Pc + 1)) and 16#Ff#));
+         end if;
+      end if;
+      End_Insn;
+   end Emit_Jmp;
+
+   procedure Emit_Label (Stmt : O_Enode)
+   is
+      Sym : Symbol;
+   begin
+      Sym := Prepare_Label (Stmt);
+      Set_Symbol_Pc (Sym, False);
+   end Emit_Label;
+
+   procedure Gen_Call (Sym : Symbol) is
+   begin
+      Start_Insn;
+      Gen_B8 (16#E8#);
+      Gen_X86_Pc32 (Sym);
+      End_Insn;
+   end Gen_Call;
+
+   procedure Emit_Setup_Frame (Stmt : O_Enode)
+   is
+      Val : constant Int32 := Get_Stack_Adjust (Stmt);
+   begin
+      if Val > 0 then
+         Start_Insn;
+         --  subl esp, val
+         Gen_B8 (2#100000_11#);
+         Gen_B8 (2#11_101_100#);
+         Gen_B8 (Byte (Val));
+         End_Insn;
+      elsif Val < 0 then
+         Start_Insn;
+         if -Val <= 127 then
+            --  addl esp, val
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (Byte (-Val));
+         else
+            --  addl esp, val
+            Gen_B8 (2#100000_01#);
+            Gen_B8 (2#11_000_100#);
+            Gen_Le32 (Unsigned_32 (-Val));
+         end if;
+         End_Insn;
+      end if;
+   end Emit_Setup_Frame;
+
+   procedure Emit_Call (Stmt : O_Enode)
+   is
+      use Ortho_Code.Decls;
+      Subprg : O_Dnode;
+      Sym : Symbol;
+   begin
+      Subprg := Get_Call_Subprg (Stmt);
+      Sym := Get_Decl_Symbol (Subprg);
+      Gen_Call (Sym);
+   end Emit_Call;
+
+   procedure Emit_Intrinsic (Stmt : O_Enode)
+   is
+      Op : Int32;
+   begin
+      Op := Get_Intrinsic_Operation (Stmt);
+      Start_Insn;
+      Gen_B8 (16#E8#);
+      Gen_X86_Pc32 (Intrinsics_Symbol (Op));
+      End_Insn;
+
+      Start_Insn;
+      --  addl esp, val
+      Gen_B8 (2#100000_11#);
+      Gen_B8 (2#11_000_100#);
+      Gen_B8 (16);
+      End_Insn;
+   end Emit_Intrinsic;
+
+   procedure Emit_Setcc (Dest : O_Enode; Cond : O_Reg)
+   is
+   begin
+      if Cond not in Regs_Cc then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      Gen_B8 (16#90# + To_Cond (Cond));
+      Gen_Rm (2#000_000#, Dest, Sz_8);
+      End_Insn;
+   end Emit_Setcc;
+
+   procedure Emit_Setcc_Reg (Reg : O_Reg; Cond : O_Reg)
+   is
+   begin
+      if Cond not in Regs_Cc then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      Gen_B8 (16#90# + To_Cond (Cond));
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz_8));
+      End_Insn;
+   end Emit_Setcc_Reg;
+
+   procedure Emit_Tst (Reg : O_Reg; Sz : Insn_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_0100#, Sz);
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz) * 9);
+      End_Insn;
+   end Emit_Tst;
+
+   procedure Gen_Cmp_Imm (Reg : O_Reg; Val : Int32; Sz : Insn_Size)
+   is
+      B : Byte;
+   begin
+      Start_Insn;
+      if Val <= 127 and Val >= -128 then
+         B := 2#10#;
+      else
+         B := 0;
+      end if;
+      Gen_Insn_Sz (2#1000_0000# + B, Sz);
+      Gen_B8 (2#11_111_000# + To_Reg32 (Reg));
+      if B = 0 then
+         Gen_Le32 (Unsigned_32 (To_Uns32 (Val)));
+      else
+         Gen_B8 (Byte (To_Uns32 (Val) and 16#Ff#));
+      end if;
+      End_Insn;
+   end Gen_Cmp_Imm;
+
+   procedure Emit_Spill (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+      Expr : O_Enode;
+   begin
+      Expr := Get_Expr_Operand (Stmt);
+      Reg := Get_Expr_Reg (Expr);
+      if Reg = R_Spill then
+         if Get_Expr_Kind (Expr) = OE_Conv then
+            return;
+         else
+            raise Program_Error;
+         end if;
+      end if;
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_1000#, Sz);
+      Gen_Rm (To_Reg32 (Reg, Sz) * 8, Stmt, Sz);
+      End_Insn;
+   end Emit_Spill;
+
+   procedure Emit_Load (Reg : O_Reg; Val : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      Start_Insn;
+      Gen_Insn_Sz (2#1000_1010#, Sz);
+      Gen_Rm (To_Reg32 (Reg, Sz) * 8, Val, Sz);
+      End_Insn;
+   end Emit_Load;
+
+   procedure Emit_Lea (Stmt : O_Enode)
+   is
+      Reg : O_Reg;
+   begin
+      --  Hack: change the register to use the real address instead of it.
+      Reg := Get_Expr_Reg (Stmt);
+      Set_Expr_Reg (Stmt, R_Mem);
+
+      Start_Insn;
+      Gen_B8 (2#10001101#);
+      Gen_Rm_Mem (To_Reg32 (Reg) * 8, Stmt, Sz_32l);
+      End_Insn;
+      Set_Expr_Reg (Stmt, Reg);
+   end Emit_Lea;
+
+   procedure Gen_Umul (Stmt : O_Enode; Sz : Insn_Size)
+   is
+   begin
+      if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= R_Ax then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      Gen_Insn_Sz (16#F6#, Sz);
+      Gen_Rm (2#100_000#, Get_Expr_Right (Stmt), Sz);
+      End_Insn;
+   end Gen_Umul;
+
+   procedure Gen_Mul (Stmt : O_Enode; Sz : Insn_Size)
+   is
+      Reg : O_Reg;
+      Right : O_Enode;
+      Reg_R : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (Stmt);
+      Right := Get_Expr_Right (Stmt);
+      if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= Reg
+        or Sz /= Sz_32l
+      then
+         raise Program_Error;
+      end if;
+      Start_Insn;
+      if Reg = R_Ax then
+         Gen_Insn_Sz (16#F6#, Sz);
+         Gen_Rm (2#100_000#, Right, Sz);
+      else
+         Reg_R := Get_Expr_Reg (Right);
+         case Reg_R is
+            when R_Imm =>
+               if Is_Imm8 (Right, Sz) then
+                  Gen_B8 (16#6B#);
+                  Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#);
+                  Gen_Imm8 (Right, Sz);
+               else
+                  Gen_B8 (16#69#);
+                  Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#);
+                  Gen_Imm (Right, Sz);
+               end if;
+            when R_Mem
+              | R_Spill
+              | Regs_R32 =>
+               Gen_B8 (16#0F#);
+               Gen_B8 (16#AF#);
+               Gen_Rm (To_Reg32 (Reg, Sz) * 8, Right, Sz);
+            when others =>
+               Error_Emit ("gen_mul", Stmt);
+         end case;
+      end if;
+      End_Insn;
+   end Gen_Mul;
+
+   --  Do not trap if COND is true.
+   procedure Gen_Ov_Check (Cond : O_Reg) is
+   begin
+      --  JXX +2
+      Start_Insn;
+      Gen_B8 (16#70# + To_Cond (Cond));
+      Gen_B8 (16#02#);
+      End_Insn;
+      --  INT 4 (overflow).
+      Start_Insn;
+      Gen_B8 (16#CD#);
+      Gen_B8 (16#04#);
+      End_Insn;
+   end Gen_Ov_Check;
+
+   procedure Emit_Abs (Val : O_Enode; Mode : Mode_Type)
+   is
+      Szh : Insn_Size;
+      Pc_Jmp : Pc_Type;
+   begin
+      case Mode is
+         when Mode_I32 =>
+            Szh := Sz_32l;
+         when Mode_I64 =>
+            Szh := Sz_32h;
+         when others =>
+            raise Program_Error;
+      end case;
+      Emit_Tst (Get_Expr_Reg (Val), Szh);
+      --  JXX +
+      Start_Insn;
+      Gen_B8 (16#70# + To_Cond (R_Sge));
+      Gen_B8 (0);
+      End_Insn;
+      Pc_Jmp := Get_Current_Pc;
+      --  NEG
+      Gen_Mono_Op (2#011_000#, Val, Sz_32l);
+      if Mode = Mode_I64 then
+         --  Propagate carray.
+         --  Adc reg,0
+         --  neg reg
+         Start_Insn;
+         Gen_B8 (2#100000_11#);
+         Gen_Rm (2#010_000#, Val, Sz_32h);
+         Gen_B8 (0);
+         End_Insn;
+         Gen_Mono_Op (2#011_000#, Val, Sz_32h);
+      end if;
+      Gen_Into;
+      Patch_B8 (Pc_Jmp - 1, Unsigned_8 (Get_Current_Pc - Pc_Jmp));
+   end Emit_Abs;
+
+   procedure Gen_Alloca (Stmt : O_Enode)
+   is
+      Reg : O_Reg;
+   begin
+      Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+      if Reg not in Regs_R32 or else Reg /= Get_Expr_Reg (Stmt) then
+         raise Program_Error;
+      end if;
+      --  Align stack on word.
+      --  Add reg, (stack_boundary - 1)
+      Start_Insn;
+      Gen_B8 (2#1000_0011#);
+      Gen_B8 (2#11_000_000# + To_Reg32 (Reg));
+      Gen_B8 (Byte (X86.Flags.Stack_Boundary - 1));
+      End_Insn;
+      --  and reg, ~(stack_boundary - 1)
+      Start_Insn;
+      Gen_B8 (2#1000_0001#);
+      Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+      Gen_Le32 (not (X86.Flags.Stack_Boundary - 1));
+      End_Insn;
+      if X86.Flags.Flag_Alloca_Call then
+         Gen_Call (Chkstk_Symbol);
+      else
+         --  subl esp, reg
+         Start_Insn;
+         Gen_B8 (2#0001_1011#);
+         Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+         End_Insn;
+      end if;
+      --  movl reg, esp
+      Start_Insn;
+      Gen_B8 (2#1000_1001#);
+      Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+      End_Insn;
+   end Gen_Alloca;
+
+   --  Byte/word to long.
+   procedure Gen_Movzx (Reg : Regs_R32; Op : O_Enode; Sz : Insn_Size)
+   is
+      B : Byte;
+   begin
+      Start_Insn;
+      Gen_B8 (16#0f#);
+      case Sz is
+         when Sz_8 =>
+            B := 0;
+         when Sz_16 =>
+            B := 1;
+         when Sz_32l
+           | Sz_32h =>
+            raise Program_Error;
+      end case;
+      Gen_B8 (2#1011_0110# + B);
+      Gen_Rm (To_Reg32 (Reg) * 8, Op, Sz_8);
+      End_Insn;
+   end Gen_Movzx;
+
+   --  Convert U32 to xx.
+   procedure Gen_Conv_U32 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Op : O_Reg;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Op := Get_Expr_Reg (Op);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Emit_Tst (Reg_Res, Sz_32l);
+            Gen_Ov_Check (R_Sge);
+         when Mode_U8
+           | Mode_B2 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            --  cmpl VAL, 0xff
+            Start_Insn;
+            Gen_B8 (2#1000_0001#);
+            Gen_Rm (2#111_000#, Op, Sz_32l);
+            Gen_Le32 (16#00_00_00_Ff#);
+            End_Insn;
+            Gen_Ov_Check (R_Ule);
+         when others =>
+            Error_Emit ("gen_conv_u32", Stmt);
+      end case;
+   end Gen_Conv_U32;
+
+   --  Convert I32 to xxx
+   procedure Gen_Conv_I32 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Op : O_Reg;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Op := Get_Expr_Reg (Op);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I64 =>
+            if Reg_Res /= R_Edx_Eax or Reg_Op /= R_Ax then
+               raise Program_Error;
+            end if;
+            Gen_Cdq;
+         when Mode_U32 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Emit_Tst (Reg_Res, Sz_32l);
+            Gen_Ov_Check (R_Sge);
+         when Mode_B2 =>
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Gen_Cmp_Imm (Reg_Res, 1, Sz_32l);
+            Gen_Ov_Check (R_Ule);
+         when Mode_U8 =>
+            if Reg_Op /= Reg_Res then
+               Emit_Load (Reg_Res, Op, Sz_32l);
+            end if;
+            Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32l);
+            Gen_Ov_Check (R_Ule);
+         when Mode_F64 =>
+            Emit_Push_32 (Op, Sz_32l);
+            --  fild (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_011#);
+            Gen_B8 (2#00_000_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            --  addl %esp, 4
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (4);
+            End_Insn;
+         when others =>
+            Error_Emit ("gen_conv_i32", Stmt);
+      end case;
+   end Gen_Conv_I32;
+
+   --  Convert U8 to xxx
+   procedure Gen_Conv_U8 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_U16
+           | Mode_I16 =>
+            if Reg_Res not in Regs_R32 then
+               raise Program_Error;
+            end if;
+            Gen_Movzx (Reg_Res, Op, Sz_8);
+         when others =>
+            Error_Emit ("gen_conv_U8", Stmt);
+      end case;
+   end Gen_Conv_U8;
+
+   --  Convert B2 to xxx
+   procedure Gen_Conv_B2 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+      Reg_Res : O_Reg;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      Reg_Res := Get_Expr_Reg (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_U16
+           | Mode_I16 =>
+            Gen_Movzx (Reg_Res, Op, Sz_8);
+         when others =>
+            Error_Emit ("gen_conv_B2", Stmt);
+      end case;
+   end Gen_Conv_B2;
+
+   --  Convert I64 to xxx
+   procedure Gen_Conv_I64 (Stmt : O_Enode)
+   is
+      Op : O_Enode;
+   begin
+      Op := Get_Expr_Operand (Stmt);
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            --  move dx to reg_helper
+            Start_Insn;
+            Gen_B8 (2#1000_1001#);
+            Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper));
+            End_Insn;
+            Gen_Cdq;
+            --  cmp reg_helper, dx
+            Start_Insn;
+            Gen_B8 (2#0011_1001#);
+            Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper));
+            End_Insn;
+            Gen_Ov_Check (R_Eq);
+         when Mode_F64 =>
+            Emit_Push_32 (Op, Sz_32h);
+            Emit_Push_32 (Op, Sz_32l);
+            --  fild (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_111#);
+            Gen_B8 (2#00_101_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            --  addl %esp, 8
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (8);
+            End_Insn;
+         when others =>
+            Error_Emit ("gen_conv_I64", Stmt);
+      end case;
+   end Gen_Conv_I64;
+
+   --  Convert FP to xxx.
+   procedure Gen_Conv_Fp (Stmt : O_Enode) is
+   begin
+      case Get_Expr_Mode (Stmt) is
+         when Mode_I32 =>
+            --  subl %esp, 4
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_101_100#);
+            Gen_B8 (4);
+            End_Insn;
+            --  fistp (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_011#);
+            Gen_B8 (2#00_011_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            Emit_Pop_32 (Stmt, Sz_32l);
+         when Mode_I64 =>
+            --  subl %esp, 8
+            Start_Insn;
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_101_100#);
+            Gen_B8 (8);
+            End_Insn;
+            --  fistp (%esp)
+            Start_Insn;
+            Gen_B8 (2#11011_111#);
+            Gen_B8 (2#00_111_100#);
+            Gen_B8 (2#00_100_100#);
+            End_Insn;
+            Emit_Pop_32 (Stmt, Sz_32l);
+            Emit_Pop_32 (Stmt, Sz_32h);
+         when others =>
+            Error_Emit ("gen_conv_fp", Stmt);
+      end case;
+   end Gen_Conv_Fp;
+
+   procedure Gen_Emit_Op (Stmt : O_Enode; Cl : Byte; Ch : Byte) is
+   begin
+      case Get_Expr_Mode (Stmt) is
+         when Mode_U32
+           | Mode_I32
+           | Mode_P32 =>
+            Emit_Op (Cl, Stmt, Sz_32l);
+         when Mode_I64
+           | Mode_U64 =>
+            Emit_Op (Cl, Stmt, Sz_32l);
+            Emit_Op (Ch, Stmt, Sz_32h);
+         when Mode_B2
+           | Mode_I8
+           | Mode_U8 =>
+            Emit_Op (Cl, Stmt, Sz_8);
+         when others =>
+            Error_Emit ("gen_emit_op", Stmt);
+      end case;
+   end Gen_Emit_Op;
+
+   procedure Gen_Check_Overflow (Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_I32
+           | Mode_I64
+           | Mode_I8 =>
+            Gen_Into;
+         when Mode_U64
+           | Mode_U32
+           | Mode_U8 =>
+            --  FIXME: check no carry.
+            null;
+         when Mode_B2 =>
+            null;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Check_Overflow;
+
+   procedure Gen_Emit_Fp_Op (Stmt : O_Enode; B_St1 : Byte; B_Mem : Byte)
+   is
+      Right : O_Enode;
+      Reg : O_Reg;
+      B_Size : Byte;
+   begin
+      Right := Get_Expr_Right (Stmt);
+      Reg := Get_Expr_Reg (Right);
+      Start_Insn;
+      case Reg is
+         when R_St0 =>
+            Gen_B8 (2#11011_110#);
+            Gen_B8 (2#11_000_001# or B_St1);
+         when R_Mem =>
+            case Get_Expr_Mode (Stmt) is
+               when Mode_F32 =>
+                  B_Size := 0;
+               when Mode_F64 =>
+                  B_Size := 2#100#;
+               when others =>
+                  raise Program_Error;
+            end case;
+            Gen_B8 (2#11011_000# or B_Size);
+            Gen_Rm_Mem (B_Mem, Right, Sz_32l);
+         when others =>
+            raise Program_Error;
+      end case;
+      End_Insn;
+   end Gen_Emit_Fp_Op;
+
+   procedure Emit_Mod (Stmt : O_Enode)
+   is
+      Right : O_Enode;
+      Pc1, Pc2, Pc3: Pc_Type;
+   begin
+      --  a : EAX
+      --  d : EDX
+      --  b : Rm
+
+      --  d := Rm
+      --  d := d ^ a
+      --  cltd
+      --  if cc < 0 then
+      --    idiv b
+      --    if edx /= 0 then
+      --      edx := edx + b
+      --    end if
+      --  else
+      --    idiv b
+      --  end if
+      Right := Get_Expr_Right (Stmt);
+      --  %edx <- right
+      Emit_Load (R_Dx, Right, Sz_32l);
+      --  xorl %eax -> %edx
+      Start_Insn;
+      Gen_B8 (2#0011_0011#);
+      Gen_B8 (2#11_010_000#);
+      End_Insn;
+      Gen_Cdq;
+      --  js
+      Start_Insn;
+      Gen_B8 (2#0111_1000#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc1 := Get_Current_Pc;
+      --  idiv
+      Gen_Mono_Op (2#111_000#, Right, Sz_32l);
+      --  jmp
+      Start_Insn;
+      Gen_B8 (2#1110_1011#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc2 := Get_Current_Pc;
+      Patch_B8 (Pc1 - 1, Unsigned_8 (Get_Current_Pc - Pc1));
+      --  idiv
+      Gen_Mono_Op (2#111_000#, Right, Sz_32l);
+      --  tstl %edx,%edx
+      Start_Insn;
+      Gen_B8 (2#1000_0101#);
+      Gen_B8 (2#11_010_010#);
+      End_Insn;
+      --  jz
+      Start_Insn;
+      Gen_B8 (2#0111_0100#);
+      Gen_B8 (0);
+      End_Insn;
+      Pc3 := Get_Current_Pc;
+      --  addl b, %edx
+      Start_Insn;
+      Gen_B8 (2#00_000_011#);
+      Gen_Rm (2#010_000#, Right, Sz_32l);
+      End_Insn;
+      Patch_B8 (Pc2 - 1, Unsigned_8 (Get_Current_Pc - Pc2));
+      Patch_B8 (Pc3 - 1, Unsigned_8 (Get_Current_Pc - Pc3));
+   end Emit_Mod;
+
+   procedure Emit_Insn (Stmt : O_Enode)
+   is
+      use Ortho_Code.Flags;
+      Kind : OE_Kind;
+      Mode : Mode_Type;
+      Reg : O_Reg;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      Mode := Get_Expr_Mode (Stmt);
+      case Kind is
+         when OE_Beg =>
+            if Flag_Debug /= Debug_None then
+               Decls.Set_Block_Info1 (Get_Block_Decls (Stmt),
+                                      Int32 (Get_Current_Pc - Subprg_Pc));
+            end if;
+         when OE_End =>
+            if Flag_Debug /= Debug_None then
+               Decls.Set_Block_Info2 (Get_Block_Decls (Get_End_Beg (Stmt)),
+                                      Int32 (Get_Current_Pc - Subprg_Pc));
+            end if;
+         when OE_Leave =>
+            null;
+         when OE_BB =>
+            null;
+         when OE_Add_Ov =>
+            if Mode in Mode_Fp then
+               Gen_Emit_Fp_Op (Stmt, 2#000_000#, 2#000_000#);
+            else
+               Gen_Emit_Op (Stmt, 2#000_000#, 2#010_000#);
+               Gen_Check_Overflow (Mode);
+            end if;
+         when OE_Or =>
+            Gen_Emit_Op (Stmt, 2#001_000#, 2#001_000#);
+         when OE_And =>
+            Gen_Emit_Op (Stmt, 2#100_000#, 2#100_000#);
+         when OE_Xor =>
+            Gen_Emit_Op (Stmt, 2#110_000#, 2#110_000#);
+         when OE_Sub_Ov =>
+            if Mode in Mode_Fp then
+               Gen_Emit_Fp_Op (Stmt, 2#100_000#, 2#100_000#);
+            else
+               Gen_Emit_Op (Stmt, 2#101_000#, 2#011_000#);
+               Gen_Check_Overflow (Mode);
+            end if;
+         when OE_Mul_Ov
+           | OE_Mul =>
+            case Mode is
+               when Mode_U8 =>
+                  Gen_Umul (Stmt, Sz_8);
+               when Mode_U16 =>
+                  Gen_Umul (Stmt, Sz_16);
+               when Mode_U32 =>
+                  Gen_Mul (Stmt, Sz_32l);
+               when Mode_I32 =>
+                  Gen_Mono_Op (2#101_000#, Get_Expr_Right (Stmt), Sz_32l);
+               when Mode_F32
+                 | Mode_F64 =>
+                  Gen_Emit_Fp_Op (Stmt, 2#001_000#, 2#001_000#);
+               when others =>
+                  Error_Emit ("emit_insn: mul_ov", Stmt);
+            end case;
+         when OE_Shl =>
+            declare
+               Right : O_Enode;
+               Sz : Insn_Size;
+               Val : Uns32;
+            begin
+               case Mode is
+                  when Mode_U32 =>
+                     Sz := Sz_32l;
+                  when others =>
+                     Error_Emit ("emit_insn: shl", Stmt);
+               end case;
+               Right := Get_Expr_Right (Stmt);
+               if Get_Expr_Kind (Right) = OE_Const then
+                  Val := Get_Expr_Low (Right);
+                  Start_Insn;
+                  if Val = 1 then
+                     Gen_Insn_Sz (2#1101000_0#, Sz);
+                     Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                  else
+                     Gen_Insn_Sz (2#1100000_0#, Sz);
+                     Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                     Gen_B8 (Byte (Val and 31));
+                  end if;
+                  End_Insn;
+               else
+                  if Get_Expr_Reg (Right) /= R_Cx then
+                     raise Program_Error;
+                  end if;
+                  Start_Insn;
+                  Gen_Insn_Sz (2#1101001_0#, Sz);
+                  Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz);
+                  End_Insn;
+               end if;
+            end;
+         when OE_Mod
+           | OE_Rem
+           | OE_Div_Ov =>
+            case Mode is
+               when Mode_U32 =>
+                  --  Xorl edx, edx
+                  Start_Insn;
+                  Gen_B8 (2#0011_0001#);
+                  Gen_B8 (2#11_010_010#);
+                  End_Insn;
+                  Gen_Mono_Op (2#110_000#, Get_Expr_Right (Stmt), Sz_32l);
+               when Mode_I32 =>
+                  if Kind = OE_Mod then
+                     Emit_Mod (Stmt);
+                  else
+                     Gen_Cdq;
+                     Gen_Mono_Op (2#111_000#, Get_Expr_Right (Stmt), Sz_32l);
+                  end if;
+               when Mode_F32
+                 | Mode_F64 =>
+                  if Kind = OE_Div_Ov then
+                     Gen_Emit_Fp_Op (Stmt, 2#111_000#, 2#110_000#);
+                  else
+                     raise Program_Error;
+                  end if;
+               when others =>
+                  Error_Emit ("emit_insn: mod_ov", Stmt);
+            end case;
+
+         when OE_Not =>
+            case Mode is
+               when Mode_B2 =>
+                  --  Xor VAL, $1
+                  Start_Insn;
+                  Gen_B8 (2#1000_0011#);
+                  Gen_Rm (2#110_000#, Stmt, Sz_8);
+                  Gen_B8 (16#01#);
+                  End_Insn;
+               when Mode_U8 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_8);
+               when Mode_U16 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_16);
+               when Mode_U32 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l);
+               when Mode_U64 =>
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l);
+                  Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32h);
+               when others =>
+                  Error_Emit ("emit_insn: not", Stmt);
+            end case;
+
+         when OE_Neg_Ov =>
+            case Mode is
+               when Mode_I8 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_8);
+                  --Gen_Into;
+               when Mode_I16 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_16);
+                  --Gen_Into;
+               when Mode_I32 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l);
+                  --Gen_Into;
+               when Mode_I64 =>
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l);
+                  -- adcl 0, high
+                  Start_Insn;
+                  Gen_B8 (2#100000_11#);
+                  Gen_Rm (2#010_000#, Get_Expr_Operand (Stmt), Sz_32h);
+                  Gen_B8 (0);
+                  End_Insn;
+                  Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32h);
+                  --Gen_Into;
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fchs
+                  Start_Insn;
+                  Gen_B8 (2#11011_001#);
+                  Gen_B8 (2#1110_0000#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: neg_ov", Stmt);
+            end case;
+
+         when OE_Abs_Ov =>
+            case Mode is
+               when Mode_I32
+                  | Mode_I64 =>
+                  Emit_Abs (Get_Expr_Operand (Stmt), Mode);
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fabs
+                  Start_Insn;
+                  Gen_B8 (2#11011_001#);
+                  Gen_B8 (2#1110_0001#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: abs_ov", Stmt);
+            end case;
+
+         when OE_Kind_Cmp =>
+            case Get_Expr_Mode (Get_Expr_Left (Stmt)) is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Op (2#111_000#, Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_I8
+                 | Mode_U8 =>
+                  Emit_Op (2#111_000#, Stmt, Sz_8);
+               when Mode_U64 =>
+                  declare
+                     Pc : Pc_Type;
+                  begin
+                     Emit_Op (2#111_000#, Stmt, Sz_32h);
+                     --  jne
+                     Start_Insn;
+                     Gen_B8 (2#0111_0101#);
+                     Gen_B8 (0);
+                     End_Insn;
+                     Pc := Get_Current_Pc;
+                     Emit_Op (2#111_000#, Stmt, Sz_32l);
+                     Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc));
+                  end;
+               when Mode_I64 =>
+                  declare
+                     Pc : Pc_Type;
+                  begin
+                     Reg := Get_Expr_Reg (Stmt);
+                     Emit_Op (2#111_000#, Stmt, Sz_32h);
+                     --  Note: this does not clobber a reg due to care in
+                     --  insns.
+                     Emit_Setcc_Reg (Reg, Ekind_Signed_To_Cc (Kind));
+                     --  jne
+                     Start_Insn;
+                     Gen_B8 (2#0111_0101#);
+                     Gen_B8 (0);
+                     End_Insn;
+                     Pc := Get_Current_Pc;
+                     Emit_Op (2#111_000#, Stmt, Sz_32l);
+                     Emit_Setcc_Reg (Reg, Ekind_Unsigned_To_Cc (Kind));
+                     Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc));
+                     return;
+                  end;
+               when Mode_F32
+                 | Mode_F64 =>
+                  --  fcomip st, st(1)
+                  Start_Insn;
+                  Gen_B8 (2#11011_111#);
+                  Gen_B8 (2#1111_0001#);
+                  End_Insn;
+                  --  fstp st, st (0)
+                  Start_Insn;
+                  Gen_B8 (2#11011_101#);
+                  Gen_B8 (2#11_011_000#);
+                  End_Insn;
+               when others =>
+                  Error_Emit ("emit_insn: cmp", Stmt);
+            end case;
+            Reg := Get_Expr_Reg (Stmt);
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/cmp: not cc", Stmt);
+            end if;
+         when OE_Const
+           | OE_Addrg =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Load_Imm (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Load_Imm (Stmt, Sz_8);
+               when Mode_I64
+                 | Mode_U64 =>
+                  Emit_Load_Imm (Stmt, Sz_32l);
+                  Emit_Load_Imm (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Load_Fp (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Load_Fp (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: const", Stmt);
+            end case;
+         when OE_Indir =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Load_Mem (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Load_Mem (Stmt, Sz_8);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Load_Mem (Stmt, Sz_32l);
+                  Emit_Load_Mem (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Load_Fp_Mem (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Load_Fp_Mem (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: indir", Stmt);
+            end case;
+
+         when OE_Conv =>
+            case Get_Expr_Mode (Get_Expr_Operand (Stmt)) is
+               when Mode_U32 =>
+                  Gen_Conv_U32 (Stmt);
+               when Mode_I32 =>
+                  Gen_Conv_I32 (Stmt);
+               when Mode_U8 =>
+                  Gen_Conv_U8 (Stmt);
+               when Mode_B2 =>
+                  Gen_Conv_B2 (Stmt);
+               when Mode_I64 =>
+                  Gen_Conv_I64 (Stmt);
+               when Mode_F32
+                 | Mode_F64 =>
+                  Gen_Conv_Fp (Stmt);
+               when others =>
+                  Error_Emit ("emit_insn: conv", Stmt);
+            end case;
+
+         when OE_Asgn =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Store (Stmt, Sz_32l);
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Store (Stmt, Sz_8);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Store (Stmt, Sz_32l);
+                  Emit_Store (Stmt, Sz_32h);
+               when Mode_F32 =>
+                  Emit_Store_Fp (Stmt, Fp_32);
+               when Mode_F64 =>
+                  Emit_Store_Fp (Stmt, Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: move", Stmt);
+            end case;
+
+         when OE_Jump_F =>
+            Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/jmp_f: not cc", Stmt);
+            end if;
+            Emit_Jmp_T (Stmt, Inverse_Cc (Reg));
+         when OE_Jump_T =>
+            Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt));
+            if Reg not in Regs_Cc then
+               Error_Emit ("emit_insn/jmp_t: not cc", Stmt);
+            end if;
+            Emit_Jmp_T (Stmt, Reg);
+         when OE_Jump =>
+            Emit_Jmp (Stmt);
+         when OE_Label =>
+            Emit_Label (Stmt);
+
+         when OE_Ret =>
+            --  Value already set.
+            null;
+
+         when OE_Arg =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32h);
+                  Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l);
+               when Mode_F32 =>
+                  Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_32);
+               when Mode_F64 =>
+                  Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_64);
+               when others =>
+                  Error_Emit ("emit_insn: oe_arg", Stmt);
+            end case;
+         when OE_Stack_Adjust =>
+            Emit_Setup_Frame (Stmt);
+         when OE_Call =>
+            Emit_Call (Stmt);
+         when OE_Intrinsic =>
+            Emit_Intrinsic (Stmt);
+
+         when OE_Move =>
+            declare
+               Operand : O_Enode;
+               Op_Reg : O_Reg;
+            begin
+               Reg := Get_Expr_Reg (Stmt);
+               Operand := Get_Expr_Operand (Stmt);
+               Op_Reg := Get_Expr_Reg (Operand);
+               case Mode is
+                  when Mode_B2 =>
+                     if Reg in Regs_R32 and then Op_Reg in Regs_Cc then
+                        Emit_Setcc (Stmt, Op_Reg);
+                     elsif (Reg = R_Eq or Reg = R_Ne)
+                       and then Op_Reg in Regs_R32
+                     then
+                        Emit_Tst (Op_Reg, Sz_8);
+                     else
+                        Error_Emit ("emit_insn: move/b2", Stmt);
+                     end if;
+                  when Mode_U32
+                    | Mode_I32 =>
+                     --  mov REG, OP
+                     Start_Insn;
+                     Gen_Insn_Sz (2#1000_101_0#, Sz_32l);
+                     Gen_Rm (To_Reg32 (Reg, Sz_32l) * 8, Operand, Sz_32l);
+                     End_Insn;
+                  when others =>
+                     Error_Emit ("emit_insn: move", Stmt);
+               end case;
+            end;
+
+         when OE_Alloca =>
+            if Mode /= Mode_P32 then
+               raise Program_Error;
+            end if;
+            Gen_Alloca (Stmt);
+
+         when OE_Set_Stack =>
+            Emit_Load_Mem (Stmt, Sz_32l);
+
+         when OE_Add
+           | OE_Addrl =>
+            case Mode is
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Lea (Stmt);
+               when others =>
+                  Error_Emit ("emit_insn: oe_add", Stmt);
+            end case;
+
+         when OE_Spill =>
+            case Mode is
+               when Mode_B2
+                 | Mode_U8
+                 | Mode_I8 =>
+                  Emit_Spill (Stmt, Sz_8);
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_P32 =>
+                  Emit_Spill (Stmt, Sz_32l);
+               when Mode_U64
+                 | Mode_I64 =>
+                  Emit_Spill (Stmt, Sz_32l);
+                  Emit_Spill (Stmt, Sz_32h);
+               when others =>
+                  Error_Emit ("emit_insn: spill", Stmt);
+            end case;
+
+         when OE_Reload =>
+            declare
+               Expr : O_Enode;
+            begin
+               Reg := Get_Expr_Reg (Stmt);
+               Expr := Get_Expr_Operand (Stmt);
+               case Mode is
+                  when Mode_B2
+                    | Mode_U8
+                    | Mode_I8 =>
+                     Emit_Load (Reg, Expr, Sz_8);
+                  when Mode_U32
+                    | Mode_I32
+                    | Mode_P32 =>
+                     Emit_Load (Reg, Expr, Sz_32l);
+                  when Mode_U64
+                    | Mode_I64 =>
+                     Emit_Load (Reg, Expr, Sz_32l);
+                     Emit_Load (Reg, Expr, Sz_32h);
+                  when others =>
+                     Error_Emit ("emit_insn: reload", Stmt);
+               end case;
+            end;
+
+         when OE_Reg =>
+            Reg_Helper := Get_Expr_Reg (Stmt);
+
+         when OE_Case_Expr
+           | OE_Case =>
+            null;
+
+         when OE_Line =>
+            if Flag_Debug = Debug_Dwarf then
+               Dwarf.Set_Line_Stmt (Get_Expr_Line_Number (Stmt));
+               Set_Current_Section (Sect_Text);
+            end if;
+         when others =>
+            Error_Emit ("cannot handle insn", Stmt);
+      end case;
+   end Emit_Insn;
+
+   procedure Push_Reg_If_Used (Reg : Regs_R32)
+   is
+      use Ortho_Code.X86.Insns;
+   begin
+      if Reg_Used (Reg) then
+         Start_Insn;
+         Gen_B8 (2#01010_000# + To_Reg32 (Reg, Sz_32l));
+         End_Insn;
+      end if;
+   end Push_Reg_If_Used;
+
+   procedure Pop_Reg_If_Used (Reg : Regs_R32)
+   is
+      use Ortho_Code.X86.Insns;
+   begin
+      if Reg_Used (Reg) then
+         Start_Insn;
+         Gen_B8 (2#01011_000# + To_Reg32 (Reg, Sz_32l));
+         End_Insn;
+      end if;
+   end Pop_Reg_If_Used;
+
+   procedure Emit_Prologue (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Decls;
+      use Ortho_Code.Flags;
+      use Ortho_Code.X86.Insns;
+      Sym : Symbol;
+      Subprg_Decl : O_Dnode;
+      Is_Global : Boolean;
+      Frame_Size : Unsigned_32;
+      Saved_Regs_Size : Unsigned_32;
+   begin
+      --  Switch to .text section and align the function (to avoid the nested
+      --  function trick and for performance).
+      Set_Current_Section (Sect_Text);
+      Gen_Pow_Align (2);
+
+      Subprg_Decl := Subprg.D_Decl;
+      Sym := Get_Decl_Symbol (Subprg_Decl);
+      case Get_Decl_Storage (Subprg_Decl) is
+         when O_Storage_Public
+           | O_Storage_External =>
+            --  FIXME: should not accept the external case.
+            Is_Global := True;
+         when others =>
+            Is_Global := False;
+      end case;
+      Set_Symbol_Pc (Sym, Is_Global);
+      Subprg_Pc := Get_Current_Pc;
+
+      Saved_Regs_Size := Boolean'Pos(Reg_Used (R_Di)) * 4
+        + Boolean'Pos(Reg_Used (R_Si)) * 4
+        + Boolean'Pos(Reg_Used (R_Bx)) * 4;
+
+      --  Compute frame size.
+      --  8 bytes are used by return address and saved frame pointer.
+      Frame_Size := Unsigned_32 (Subprg.Stack_Max) + 8 + Saved_Regs_Size;
+      --  Align.
+      Frame_Size := (Frame_Size + X86.Flags.Stack_Boundary - 1)
+        and not (X86.Flags.Stack_Boundary - 1);
+      --  The 8 bytes are already allocated.
+      Frame_Size := Frame_Size - 8 - Saved_Regs_Size;
+
+      --  Emit prolog.
+      --  push %ebp
+      Start_Insn;
+      Gen_B8 (2#01010_101#);
+      End_Insn;
+      --  movl %esp, %ebp
+      Start_Insn;
+      Gen_B8 (2#1000100_1#);
+      Gen_B8 (2#11_100_101#);
+      End_Insn;
+      --  subl XXX, %esp
+      if Frame_Size /= 0 then
+         if not X86.Flags.Flag_Alloca_Call
+            or else Frame_Size <= 4096
+         then
+            Start_Insn;
+            if Frame_Size < 128 then
+               Gen_B8 (2#100000_11#);
+               Gen_B8 (2#11_101_100#);
+               Gen_B8 (Byte (Frame_Size));
+            else
+               Gen_B8 (2#100000_01#);
+               Gen_B8 (2#11_101_100#);
+               Gen_Le32 (Frame_Size);
+            end if;
+            End_Insn;
+         else
+            --  mov stack_size,%eax
+            Start_Insn;
+            Gen_B8 (2#1011_1_000#);
+            Gen_Le32 (Frame_Size);
+            End_Insn;
+            Gen_Call (Chkstk_Symbol);
+         end if;
+      end if;
+
+      if Flag_Profile then
+         Gen_Call (Mcount_Symbol);
+      end if;
+
+      --  Save registers.
+      Push_Reg_If_Used (R_Di);
+      Push_Reg_If_Used (R_Si);
+      Push_Reg_If_Used (R_Bx);
+   end Emit_Prologue;
+
+   procedure Emit_Epilogue (Subprg : Subprogram_Data_Acc)
+   is
+      use Ortho_Code.Decls;
+      use Ortho_Code.Types;
+      use Ortho_Code.Flags;
+      Decl : O_Dnode;
+   begin
+      --  Restore registers.
+      Pop_Reg_If_Used (R_Bx);
+      Pop_Reg_If_Used (R_Si);
+      Pop_Reg_If_Used (R_Di);
+
+      Decl := Subprg.D_Decl;
+      if Get_Decl_Kind (Decl) = OD_Function then
+         case Get_Type_Mode (Get_Decl_Type (Decl)) is
+            when Mode_U8
+              | Mode_B2 =>
+               --  movzx %al,%eax
+               Start_Insn;
+               Gen_B8 (16#0f#);
+               Gen_B8 (2#1011_0110#);
+               Gen_B8 (2#11_000_000#);
+               End_Insn;
+            when Mode_U32
+              | Mode_I32
+              | Mode_U64
+              | Mode_I64
+              | Mode_F32
+              | Mode_F64
+              | Mode_P32 =>
+               null;
+            when others =>
+               raise Program_Error;
+         end case;
+      end if;
+
+      --  leave
+      Start_Insn;
+      Gen_B8 (2#1100_1001#);
+      End_Insn;
+
+      --  ret
+      Start_Insn;
+      Gen_B8 (2#1100_0011#);
+      End_Insn;
+
+      if Flag_Debug = Debug_Dwarf then
+         Set_Body_Info (Subprg.D_Body, Int32 (Get_Current_Pc - Subprg_Pc));
+      end if;
+   end Emit_Epilogue;
+
+   procedure Emit_Subprg (Subprg : Subprogram_Data_Acc)
+   is
+      Stmt : O_Enode;
+   begin
+      if Debug.Flag_Debug_Code2 then
+         Abi.Disp_Subprg_Decl (Subprg.D_Decl);
+      end if;
+
+      Emit_Prologue (Subprg);
+
+      Stmt := Subprg.E_Entry;
+      loop
+         Stmt := Get_Stmt_Link (Stmt);
+
+         if Debug.Flag_Debug_Code2 then
+            Abi.Disp_Stmt (Stmt);
+         end if;
+
+         Emit_Insn (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+      end loop;
+
+      Emit_Epilogue (Subprg);
+   end Emit_Subprg;
+
+   procedure Emit_Var_Decl (Decl : O_Dnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+      Storage : O_Storage;
+      Dtype : O_Tnode;
+   begin
+      Set_Current_Section (Sect_Bss);
+      Sym := Create_Symbol (Get_Decl_Ident (Decl));
+      Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym)));
+      Storage := Get_Decl_Storage (Decl);
+      Dtype := Get_Decl_Type (Decl);
+      case Storage is
+         when O_Storage_External =>
+            null;
+         when O_Storage_Public
+           | O_Storage_Private =>
+            Gen_Pow_Align (Get_Type_Align (Dtype));
+            Set_Symbol_Pc (Sym, Storage = O_Storage_Public);
+            Gen_Space (Integer_32 (Get_Type_Size (Dtype)));
+         when O_Storage_Local =>
+            raise Program_Error;
+      end case;
+      Set_Current_Section (Sect_Text);
+   end Emit_Var_Decl;
+
+   procedure Emit_Const_Decl (Decl : O_Dnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Sym := Create_Symbol (Get_Decl_Ident (Decl));
+      Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym)));
+      Set_Current_Section (Sect_Text);
+   end Emit_Const_Decl;
+
+   procedure Emit_Const (Val : O_Cnode)
+   is
+      use Consts;
+      use Types;
+      H, L : Uns32;
+   begin
+      case Get_Const_Kind (Val) is
+         when OC_Signed
+           | OC_Unsigned
+           | OC_Float
+           | OC_Null
+           | OC_Lit =>
+            Get_Const_Bytes (Val, H, L);
+            case Get_Type_Mode (Get_Const_Type (Val)) is
+               when Mode_U8
+                 | Mode_I8
+                 | Mode_B2 =>
+                  Gen_B8 (Byte (L));
+               when Mode_U32
+                 | Mode_I32
+                 | Mode_F32
+                 | Mode_P32 =>
+                  Gen_Le32 (Unsigned_32 (L));
+               when Mode_F64
+                 | Mode_I64
+                 | Mode_U64 =>
+                  Gen_Le32 (Unsigned_32 (L));
+                  Gen_Le32 (Unsigned_32 (H));
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OC_Address
+           | OC_Subprg_Address =>
+            Gen_X86_32 (Get_Decl_Symbol (Get_Const_Decl (Val)), 0);
+         when OC_Array =>
+            for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop
+               Emit_Const (Get_Const_Aggr_Element (Val, I));
+            end loop;
+         when OC_Record =>
+            declare
+               E : O_Cnode;
+            begin
+               for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop
+                  E := Get_Const_Aggr_Element (Val, I);
+                  Gen_Pow_Align (Get_Type_Align (Get_Const_Type (E)));
+                  Emit_Const (E);
+               end loop;
+            end;
+         when OC_Sizeof
+           | OC_Alignof
+           | OC_Union =>
+            raise Program_Error;
+      end case;
+   end Emit_Const;
+
+   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode)
+   is
+      use Decls;
+      use Types;
+      Sym : Symbol;
+      Dtype : O_Tnode;
+   begin
+      Set_Current_Section (Sect_Rodata);
+      Sym := Get_Decl_Symbol (Decl);
+
+      Dtype := Get_Decl_Type (Decl);
+      Gen_Pow_Align (Get_Type_Align (Dtype));
+      Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public);
+      Prealloc (Pc_Type (Get_Type_Size (Dtype)));
+      Emit_Const (Val);
+
+      Set_Current_Section (Sect_Text);
+   end Emit_Const_Value;
+
+   procedure Init
+   is
+      use Ortho_Ident;
+      use Ortho_Code.Flags;
+   begin
+      Arch := Arch_X86;
+
+      Create_Section (Sect_Text, ".text", Section_Exec + Section_Read);
+      Create_Section (Sect_Rodata, ".rodata", Section_Read);
+      Create_Section (Sect_Bss, ".bss",
+                      Section_Read + Section_Write + Section_Zero);
+
+      Set_Current_Section (Sect_Text);
+
+      if Flag_Profile then
+         Mcount_Symbol := Create_Symbol (Get_Identifier ("mcount"));
+      end if;
+
+      if X86.Flags.Flag_Alloca_Call then
+         Chkstk_Symbol := Create_Symbol (Get_Identifier ("___chkstk"));
+      end if;
+
+      Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__muldi3"));
+      Intrinsics_Symbol (Intrinsic_Div_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__mcode_div_ov_u64"));
+      Intrinsics_Symbol (Intrinsic_Mod_Ov_U64) :=
+        Create_Symbol (Get_Identifier ("__mcode_mod_ov_u64"));
+      Intrinsics_Symbol (Intrinsic_Mul_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__muldi3"));
+      Intrinsics_Symbol (Intrinsic_Div_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__divdi3"));
+      Intrinsics_Symbol (Intrinsic_Mod_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__mcode_mod_ov_i64"));
+      Intrinsics_Symbol (Intrinsic_Rem_Ov_I64) :=
+        Create_Symbol (Get_Identifier ("__mcode_rem_ov_i64"));
+
+      if Debug.Flag_Debug_Asm then
+         Dump_Asm := True;
+      end if;
+      if Debug.Flag_Debug_Hex then
+         Debug_Hex := True;
+      end if;
+
+      if Flag_Debug = Debug_Dwarf then
+         Dwarf.Init;
+         Set_Current_Section (Sect_Text);
+      end if;
+   end Init;
+
+   procedure Finish
+   is
+      use Ortho_Code.Flags;
+   begin
+      if Flag_Debug = Debug_Dwarf then
+         Set_Current_Section (Sect_Text);
+         Dwarf.Finish;
+      end if;
+   end Finish;
+
+end Ortho_Code.X86.Emits;
+
diff --git a/src/ortho/mcode/ortho_code-x86-emits.ads b/src/ortho/mcode/ortho_code-x86-emits.ads
new file mode 100644
index 000000000..9ddb43ee5
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-emits.ads
@@ -0,0 +1,36 @@
+--  Mcode back-end for ortho - Binary X86 instructions generator.
+--  Copyright (C) 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 Binary_File; use Binary_File;
+
+package Ortho_Code.X86.Emits is
+   procedure Init;
+   procedure Finish;
+
+   procedure Emit_Subprg (Subprg : Subprogram_Data_Acc);
+
+   procedure Emit_Var_Decl (Decl : O_Dnode);
+   procedure Emit_Const_Decl (Decl : O_Dnode);
+   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+
+   type Intrinsic_Symbols_Map is array (Intrinsics_X86) of Symbol;
+   Intrinsics_Symbol : Intrinsic_Symbols_Map;
+
+   Mcount_Symbol : Symbol;
+   Chkstk_Symbol : Symbol;
+end Ortho_Code.X86.Emits;
+
diff --git a/src/ortho/mcode/ortho_code-x86-flags_linux.ads b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
new file mode 100644
index 000000000..30bc7f7b3
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_linux.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Linux is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := False;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 3;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 2;
+end Ortho_Code.X86.Flags_Linux;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_macosx.ads b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
new file mode 100644
index 000000000..a33085294
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_macosx.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Macosx is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := False;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 4;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 2;
+end Ortho_Code.X86.Flags_Macosx;
diff --git a/src/ortho/mcode/ortho_code-x86-flags_windows.ads b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
new file mode 100644
index 000000000..3296aaf2c
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-flags_windows.ads
@@ -0,0 +1,31 @@
+--  X86 ABI flags.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+
+package Ortho_Code.X86.Flags_Windows is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : constant Boolean := True;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : constant Unsigned_32 := 2 ** 3;
+
+   --  Alignment for double (64 bit float).
+   Mode_F64_Align : constant Natural := 3;
+end Ortho_Code.X86.Flags_Windows;
diff --git a/src/ortho/mcode/ortho_code-x86-insns.adb b/src/ortho/mcode/ortho_code-x86-insns.adb
new file mode 100644
index 000000000..c218a9ae0
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-insns.adb
@@ -0,0 +1,2068 @@
+--  Mcode back-end for ortho - mcode to X86 instructions.
+--  Copyright (C) 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 Interfaces;
+with Ada.Text_IO;
+with Ortho_Code.Abi;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Debug;
+with Ortho_Code.X86.Flags;
+
+package body Ortho_Code.X86.Insns is
+   procedure Link_Stmt (Stmt : O_Enode)
+   is
+      use Ortho_Code.Abi;
+   begin
+      Set_Stmt_Link (Last_Link, Stmt);
+      Last_Link := Stmt;
+      if Debug.Flag_Debug_Insn then
+         Disp_Stmt (Stmt);
+      end if;
+   end Link_Stmt;
+
+   function Get_Reg_Any (Mode : Mode_Type) return O_Reg is
+   begin
+      case Mode is
+         when Mode_I16 .. Mode_I32
+           | Mode_U16 .. Mode_U32
+           | Mode_P32 =>
+            return R_Any32;
+         when Mode_I8
+           | Mode_U8
+           | Mode_B2 =>
+            return R_Any8;
+         when Mode_U64
+           | Mode_I64 =>
+            return R_Any64;
+         when Mode_F32
+           | Mode_F64 =>
+            if Abi.Flag_Sse2 then
+               return R_Any_Xmm;
+            else
+               return R_St0;
+            end if;
+         when Mode_P64
+           | Mode_X1
+           | Mode_Nil
+           | Mode_Blk =>
+            raise Program_Error;
+      end case;
+   end Get_Reg_Any;
+
+   function Get_Reg_Any (Stmt : O_Enode) return O_Reg is
+   begin
+      return Get_Reg_Any (Get_Expr_Mode (Stmt));
+   end Get_Reg_Any;
+
+   --  Stack slot management.
+   Stack_Offset : Uns32 := 0;
+   Stack_Max : Uns32 := 0;
+
+   --  Count how many bytes have been pushed on the stack, during a call. This
+   --  is used to correctly align the stack for nested calls.
+   Push_Offset : Uns32 := 0;
+
+   --  STMT is an OE_END statement.
+   --  Swap Stack_Offset with Max_Stack of STMT.
+   procedure Swap_Stack_Offset (Blk : O_Dnode)
+   is
+      Prev_Offset : Uns32;
+   begin
+      Prev_Offset := Get_Block_Max_Stack (Blk);
+      Set_Block_Max_Stack (Blk, Stack_Offset);
+      Stack_Offset := Prev_Offset;
+   end Swap_Stack_Offset;
+
+   procedure Expand_Decls (Block : O_Dnode)
+   is
+      Last : O_Dnode;
+      Decl : O_Dnode;
+      Decl_Type : O_Tnode;
+   begin
+      if Get_Decl_Kind (Block) /= OD_Block then
+         raise Program_Error;
+      end if;
+      Last := Get_Block_Last (Block);
+      Decl := Block + 1;
+      while Decl <= Last loop
+         case Get_Decl_Kind (Decl) is
+            when OD_Local =>
+               Decl_Type := Get_Decl_Type (Decl);
+               Stack_Offset := Do_Align (Stack_Offset, Decl_Type);
+               Stack_Offset := Stack_Offset + Get_Type_Size (Decl_Type);
+               Set_Local_Offset (Decl, -Int32 (Stack_Offset));
+               if Stack_Offset > Stack_Max then
+                  Stack_Max := Stack_Offset;
+               end if;
+            when OD_Type
+              | OD_Const
+              | OD_Const_Val
+              | OD_Var
+              | OD_Function
+              | OD_Procedure
+              | OD_Interface
+              | OD_Body
+              | OD_Subprg_Ext =>
+               null;
+            when OD_Block =>
+               Decl := Get_Block_Last (Decl);
+         end case;
+         Decl := Decl + 1;
+      end loop;
+   end Expand_Decls;
+
+   function Ekind_To_Cc (Stmt : O_Enode; Mode : Mode_Type) return O_Reg
+   is
+      Kind : OE_Kind;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      case Mode is
+         when Mode_U8 .. Mode_U64
+           | Mode_F32 .. Mode_F64
+           | Mode_P32
+           | Mode_P64
+           | Mode_B2 =>
+            return Ekind_Unsigned_To_Cc (Kind);
+         when Mode_I8 .. Mode_I64 =>
+            return Ekind_Signed_To_Cc (Kind);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Ekind_To_Cc;
+
+   --  CC is the result of A CMP B.
+   --  Returns the condition for B CMP A.
+   function Reverse_Cc (Cc : O_Reg) return O_Reg is
+   begin
+      case Cc is
+         when R_Ult =>
+            return R_Ugt;
+         when R_Uge =>
+            return R_Ule;
+         when R_Eq =>
+            return R_Eq;
+         when R_Ne =>
+            return R_Ne;
+         when R_Ule =>
+            return R_Uge;
+         when R_Ugt =>
+            return R_Ult;
+         when R_Slt =>
+            return R_Sgt;
+         when R_Sge =>
+            return R_Sle;
+         when R_Sle =>
+            return R_Sge;
+         when R_Sgt =>
+            return R_Slt;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Reverse_Cc;
+
+   --  Get the register in which a result of MODE is returned.
+   function Get_Call_Register (Mode : Mode_Type) return O_Reg is
+   begin
+      case Mode is
+         when Mode_U8 .. Mode_U32
+           | Mode_I8 .. Mode_I32
+           | Mode_P32
+           | Mode_B2 =>
+            return R_Ax;
+         when Mode_U64
+           | Mode_I64 =>
+            return R_Edx_Eax;
+         when Mode_F32
+           | Mode_F64 =>
+            if Abi.Flag_Sse2 and True then
+               --  Note: this shouldn't be enabled as the svr4 ABI specifies
+               --  ST0.
+               return R_Xmm0;
+            else
+               return R_St0;
+            end if;
+         when Mode_Nil =>
+            return R_None;
+         when Mode_X1
+           | Mode_Blk
+           | Mode_P64 =>
+            raise Program_Error;
+      end case;
+   end Get_Call_Register;
+
+--    function Ensure_Rm (Stmt : O_Enode) return O_Enode
+--    is
+--    begin
+--       case Get_Expr_Reg (Stmt) is
+--          when R_Mem
+--            | Regs_Any32 =>
+--             return Stmt;
+--          when others =>
+--             raise Program_Error;
+--       end case;
+--    end Ensure_Rm;
+
+--    function Ensure_Ireg (Stmt : O_Enode) return O_Enode
+--    is
+--       Reg : O_Reg;
+--    begin
+--       Reg := Get_Expr_Reg (Stmt);
+--       case Reg is
+--          when Regs_Any32
+--            | R_Imm =>
+--             return Stmt;
+--          when others =>
+--             raise Program_Error;
+--       end case;
+--    end Ensure_Ireg;
+
+   function Insert_Move (Expr : O_Enode; Dest : O_Reg) return O_Enode
+   is
+      N : O_Enode;
+   begin
+      N := New_Enode (OE_Move, Get_Expr_Mode (Expr), O_Tnode_Null,
+                      Expr, O_Enode_Null);
+      Set_Expr_Reg (N, Dest);
+      Link_Stmt (N);
+      return N;
+   end Insert_Move;
+
+--     function Insert_Spill (Expr : O_Enode) return O_Enode
+--     is
+--        N : O_Enode;
+--     begin
+--        N := New_Enode (OE_Spill, Get_Expr_Mode (Expr), O_Tnode_Null,
+--                        Expr, O_Enode_Null);
+--        Set_Expr_Reg (N, R_Spill);
+--        Link_Stmt (N);
+--        return N;
+--     end Insert_Spill;
+
+   procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("gen_insn error: cannot match reg " & Abi.Image_Reg (Reg)
+                & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt)));
+      raise Program_Error;
+   end Error_Gen_Insn;
+
+   procedure Error_Gen_Insn (Stmt : O_Enode; Mode : Mode_Type)
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("gen_insn error: cannot match mode " & Mode_Type'Image (Mode)
+                & " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt))
+                & " of mode " & Mode_Type'Image (Get_Expr_Mode (Stmt)));
+      raise Program_Error;
+   end Error_Gen_Insn;
+
+   pragma No_Return (Error_Gen_Insn);
+
+   Cur_Block : O_Enode;
+
+   type O_Inum is new Int32;
+   O_Free : constant O_Inum := 0;
+   O_Iroot : constant O_Inum := 1;
+
+
+   Insn_Num : O_Inum;
+
+   function Get_Insn_Num return O_Inum is
+   begin
+      Insn_Num := Insn_Num + 1;
+      return Insn_Num;
+   end Get_Insn_Num;
+
+
+   type Reg_Info_Type is record
+      --  Statement number which use this register.
+      --  This is a distance.
+      Num : O_Inum;
+
+      --  Statement which produces this value.
+      --  Used to have more info on this register (such as mode to allocate
+      --   a spill location).
+      Stmt : O_Enode;
+
+      --  If set, this register has been used.
+      --  All callee-saved registers marked must be saved.
+      Used : Boolean;
+   end record;
+
+   Init_Reg_Info : constant Reg_Info_Type := (Num => O_Free,
+                                              Stmt => O_Enode_Null,
+                                              Used => False);
+   type Reg32_Info_Array is array (Regs_R32) of Reg_Info_Type;
+   Regs : Reg32_Info_Array := (others => Init_Reg_Info);
+
+   Reg_Cc : Reg_Info_Type := Init_Reg_Info;
+
+   type Fp_Stack_Type is mod 8;
+   type RegFp_Info_Array is array (Fp_Stack_Type) of Reg_Info_Type;
+   Fp_Top : Fp_Stack_Type := 0;
+   Fp_Regs : RegFp_Info_Array;
+
+   type Reg_Xmm_Info_Array is array (Regs_Xmm) of Reg_Info_Type;
+   Info_Regs_Xmm : Reg_Xmm_Info_Array := (others => Init_Reg_Info);
+
+   function Reg_Used (Reg : Regs_R32) return Boolean is
+   begin
+      return Regs (Reg).Used;
+   end Reg_Used;
+
+   procedure Dump_Reg32_Info (Reg : Regs_R32)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+      use Abi;
+   begin
+      Put (Image_Reg (Reg));
+      Put (": ");
+      Put (Int32 (Regs (Reg).Stmt), 0);
+      Put (", num: ");
+      Put (Int32 (Regs (Reg).Num), 0);
+      --Put (", twin: ");
+      --Put (Image_Reg (Regs (Reg).Twin_Reg));
+      --Put (", link: ");
+      --Put (Image_Reg (Regs (Reg).Link));
+      New_Line;
+   end Dump_Reg32_Info;
+
+   procedure Dump_Regs
+   is
+      use Ada.Text_IO;
+      use Debug.Int32_IO;
+   begin
+--        Put ("free_regs: ");
+--        Put (Image_Reg (Free_Regs));
+--        Put (", to_free_regs: ");
+--        Put (Image_Reg (To_Free_Regs));
+--        New_Line;
+
+      for I in Regs_R32 loop
+         Dump_Reg32_Info (I);
+      end loop;
+      for I in Fp_Stack_Type loop
+         Put ("fp" & Fp_Stack_Type'Image (I));
+         Put (": ");
+         Put (Int32 (Fp_Regs (I).Stmt), 0);
+         New_Line;
+      end loop;
+   end Dump_Regs;
+
+   pragma Unreferenced (Dump_Regs);
+
+   procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg)
+   is
+      use Ada.Text_IO;
+      use Ortho_Code.Debug.Int32_IO;
+   begin
+      Put ("error reg: ");
+      Put (Msg);
+      New_Line;
+      Put (" stmt: ");
+      Put (Int32 (Stmt), 0);
+      Put (", reg: ");
+      Put (Abi.Image_Reg (Reg));
+      New_Line;
+      --Dump_Regs;
+      raise Program_Error;
+   end Error_Reg;
+   pragma No_Return (Error_Reg);
+
+   --  Free_XX
+   --  Mark a register as unused.
+   procedure Free_R32 (Reg : O_Reg) is
+   begin
+      if Regs (Reg).Num = O_Free then
+         raise Program_Error;
+      end if;
+      Regs (Reg).Num := O_Free;
+   end Free_R32;
+
+   procedure Free_Fp is
+   begin
+      if Fp_Regs (Fp_Top).Stmt = O_Enode_Null then
+         raise Program_Error;
+      end if;
+      Fp_Regs (Fp_Top).Stmt := O_Enode_Null;
+      Fp_Top := Fp_Top + 1;
+   end Free_Fp;
+
+   procedure Free_Cc is
+   begin
+      if Reg_Cc.Num = O_Free then
+         raise Program_Error;
+      end if;
+      Reg_Cc.Num := O_Free;
+   end Free_Cc;
+
+   procedure Free_Xmm (Reg : O_Reg) is
+   begin
+      if Info_Regs_Xmm (Reg).Num = O_Free then
+         raise Program_Error;
+      end if;
+      Info_Regs_Xmm (Reg).Num := O_Free;
+   end Free_Xmm;
+
+   --  Allocate a stack slot for spilling.
+   procedure Alloc_Spill (N : O_Enode)
+   is
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Expr_Mode (N);
+      --  Allocate on the stack.
+      Stack_Offset := Types.Do_Align (Stack_Offset, Mode);
+      Stack_Offset := Stack_Offset + Types.Get_Mode_Size (Mode);
+      if Stack_Offset > Stack_Max then
+         Stack_Max := Stack_Offset;
+      end if;
+      Set_Spill_Info (N, -Int32 (Stack_Offset));
+   end Alloc_Spill;
+
+   --  Insert a spill statement after ORIG: will save register(s) allocated by
+   --  ORIG.
+   --  Return the register(s) spilt (There might be several registers if
+   --   ORIG uses a R64 register).
+   function Insert_Spill (Orig : O_Enode) return O_Reg
+   is
+      N : O_Enode;
+      Mode : Mode_Type;
+      Reg_Orig : O_Reg;
+   begin
+      --  Add a spill statement.
+      Mode := Get_Expr_Mode (Orig);
+      N := New_Enode (OE_Spill, Mode, O_Tnode_Null, Orig, O_Enode_Null);
+      Alloc_Spill (N);
+
+      --  Insert the statement after the one that set the register
+      --  being spilled.
+      --  That's very important to be able to easily find the spill location,
+      --  when it will be reloaded.
+      if Orig = Abi.Last_Link then
+         Link_Stmt (N);
+      else
+         Set_Stmt_Link (N, Get_Stmt_Link (Orig));
+         Set_Stmt_Link (Orig, N);
+      end if;
+      Reg_Orig := Get_Expr_Reg (Orig);
+      Set_Expr_Reg (N, Reg_Orig);
+      Set_Expr_Reg (Orig, R_Spill);
+      return Reg_Orig;
+   end Insert_Spill;
+
+   procedure Spill_R32 (Reg : Regs_R32)
+   is
+      Reg_Orig : O_Reg;
+   begin
+      if Regs (Reg).Num = O_Free then
+         --  This register was not allocated.
+         raise Program_Error;
+      end if;
+
+      Reg_Orig := Insert_Spill (Regs (Reg).Stmt);
+
+      --  Free the register.
+      case Reg_Orig is
+         when Regs_R32 =>
+            if Reg_Orig /= Reg then
+               raise Program_Error;
+            end if;
+            Free_R32 (Reg);
+         when Regs_R64 =>
+            Free_R32 (Get_R64_High (Reg_Orig));
+            Free_R32 (Get_R64_Low (Reg_Orig));
+         when others =>
+            raise Program_Error;
+      end case;
+   end Spill_R32;
+
+   procedure Alloc_R32 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Regs (Reg).Num /= O_Free then
+         Spill_R32 (Reg);
+      end if;
+      Regs (Reg) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_R32;
+
+   procedure Clobber_R32 (Reg : O_Reg) is
+   begin
+      if Regs (Reg).Num /= O_Free then
+         Spill_R32 (Reg);
+      end if;
+   end Clobber_R32;
+
+   procedure Alloc_Fp (Stmt : O_Enode)
+   is
+   begin
+      Fp_Top := Fp_Top - 1;
+
+      if Fp_Regs (Fp_Top).Stmt /= O_Enode_Null then
+         --  Must spill-out.
+         raise Program_Error;
+      end if;
+      Fp_Regs (Fp_Top).Stmt := Stmt;
+   end Alloc_Fp;
+
+   procedure Alloc_R64 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum)
+   is
+      Rh, Rl : O_Reg;
+   begin
+      Rl := Get_R64_Low (Reg);
+      Rh := Get_R64_High (Reg);
+      if Regs (Rl).Num /= O_Free
+        or Regs (Rh).Num /= O_Free
+      then
+         Spill_R32 (Rl);
+      end if;
+      Regs (Rh) := (Num => Num, Stmt => Stmt, Used => True);
+      Regs (Rl) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_R64;
+
+   procedure Alloc_Cc (Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Reg_Cc.Num /= O_Free then
+         raise Program_Error;
+      end if;
+      Reg_Cc := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_Cc;
+
+   procedure Spill_Xmm (Reg : Regs_Xmm)
+   is
+      Reg_Orig : O_Reg;
+   begin
+      if Info_Regs_Xmm (Reg).Num = O_Free then
+         --  This register was not allocated.
+         raise Program_Error;
+      end if;
+
+      Reg_Orig := Insert_Spill (Info_Regs_Xmm (Reg).Stmt);
+
+      --  Free the register.
+      if Reg_Orig /= Reg then
+         raise Program_Error;
+      end if;
+      Free_Xmm (Reg);
+   end Spill_Xmm;
+
+   procedure Alloc_Xmm (Reg : Regs_Xmm; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      if Info_Regs_Xmm (Reg).Num /= O_Free then
+         Spill_Xmm (Reg);
+      end if;
+      Info_Regs_Xmm (Reg) := (Num => Num, Stmt => Stmt, Used => True);
+   end Alloc_Xmm;
+
+   procedure Clobber_Xmm (Reg : Regs_Xmm) is
+   begin
+      if Info_Regs_Xmm (Reg).Num /= O_Free then
+         Spill_Xmm (Reg);
+      end if;
+   end Clobber_Xmm;
+   pragma Unreferenced (Clobber_Xmm);
+
+   function Alloc_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) return O_Reg
+   is
+      Best_Reg : O_Reg;
+      Best_Num : O_Inum;
+   begin
+      case Reg is
+         when Regs_R32 =>
+            Alloc_R32 (Reg, Stmt, Num);
+            return Reg;
+         when Regs_R64 =>
+            Alloc_R64 (Reg, Stmt, Num);
+            return Reg;
+         when R_St0 =>
+            Alloc_Fp (Stmt);
+            return Reg;
+         when Regs_Xmm =>
+            Alloc_Xmm (Reg, Stmt, Num);
+            return Reg;
+         when R_Any32 =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_R32 loop
+               if I not in R_Sp .. R_Bp then
+                  if Regs (I).Num = O_Free then
+                     Alloc_R32 (I, Stmt, Num);
+                     return I;
+                  elsif Regs (I).Num <= Best_Num then
+                     Best_Reg := I;
+                     Best_Num := Regs (I).Num;
+                  end if;
+               end if;
+            end loop;
+            Alloc_R32 (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when R_Any8 =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_R8 loop
+               if Regs (I).Num = O_Free then
+                  Alloc_R32 (I, Stmt, Num);
+                  return I;
+               elsif Regs (I).Num <= Best_Num then
+                  Best_Reg := I;
+                  Best_Num := Regs (I).Num;
+               end if;
+            end loop;
+            Alloc_R32 (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when R_Any64 =>
+            declare
+               Rh, Rl : O_Reg;
+            begin
+               Best_Num := O_Inum'Last;
+               Best_Reg := R_None;
+               for I in Regs_R64 loop
+                  Rh := Get_R64_High (I);
+                  Rl := Get_R64_Low (I);
+                  if Regs (Rh).Num = O_Free
+                    and then Regs (Rl).Num = O_Free
+                  then
+                     Alloc_R64 (I, Stmt, Num);
+                     return I;
+                  elsif Regs (Rh).Num <= Best_Num
+                    and Regs (Rl).Num <= Best_Num
+                  then
+                     Best_Reg := I;
+                     Best_Num := O_Inum'Max (Regs (Rh).Num,
+                                             Regs (Rl).Num);
+                  end if;
+               end loop;
+               Alloc_R64 (Best_Reg, Stmt, Num);
+               return Best_Reg;
+            end;
+         when R_Any_Xmm =>
+            Best_Num := O_Inum'Last;
+            Best_Reg := R_None;
+            for I in Regs_X86_Xmm loop
+               if Info_Regs_Xmm (I).Num = O_Free then
+                  Alloc_Xmm (I, Stmt, Num);
+                  return I;
+               elsif Info_Regs_Xmm (I).Num <= Best_Num then
+                  Best_Reg := I;
+                  Best_Num := Info_Regs_Xmm (I).Num;
+               end if;
+            end loop;
+            Alloc_Xmm (Best_Reg, Stmt, Num);
+            return Best_Reg;
+         when others =>
+            Error_Reg ("alloc_reg: unknown reg", O_Enode_Null, Reg);
+            raise Program_Error;
+      end case;
+   end Alloc_Reg;
+
+   function Gen_Reload (Spill : O_Enode; Reg : O_Reg; Num : O_Inum)
+                       return O_Enode
+   is
+      N : O_Enode;
+      Mode : Mode_Type;
+   begin
+      --  Add a reload node.
+      Mode := Get_Expr_Mode (Spill);
+      N := New_Enode (OE_Reload, Mode, O_Tnode_Null, Spill, O_Enode_Null);
+      --  Note: this does not use a just-freed register, since
+      --  this case only occurs at the first call.
+      Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
+      Link_Stmt (N);
+      return N;
+   end Gen_Reload;
+
+   function Reload (Expr : O_Enode; Dest : O_Reg; Num : O_Inum) return O_Enode
+   is
+      Reg : O_Reg;
+      Spill : O_Enode;
+   begin
+      Reg := Get_Expr_Reg (Expr);
+      case Reg is
+         when R_Spill =>
+            --  Restore the register between the statement and the spill.
+            Spill := Get_Stmt_Link (Expr);
+            Set_Expr_Reg (Expr, Get_Expr_Reg (Spill));
+            Set_Expr_Reg (Spill, R_Spill);
+            case Dest is
+               when R_Mem
+                 | R_Irm
+                 | R_Rm =>
+                  return Spill;
+               when Regs_R32
+                 | R_Any32
+                 | Regs_R64
+                 | R_Any64
+                 | R_Any8 =>
+                  return Gen_Reload (Spill, Dest, Num);
+               when R_Sib =>
+                  return Gen_Reload (Spill, R_Any32, Num);
+               when R_Ir =>
+                  return Gen_Reload (Spill, Get_Reg_Any (Expr), Num);
+               when others =>
+                  Error_Reg ("reload: unhandled dest in spill", Expr, Dest);
+            end case;
+         when Regs_R32 =>
+            case Dest is
+               when R_Irm
+                 | R_Rm
+                 | R_Ir
+                 | R_Any32
+                 | R_Any8
+                 | R_Sib =>
+                  return Expr;
+               when Regs_R32 =>
+                  if Dest = Reg then
+                     return Expr;
+                  end if;
+                  Free_R32 (Reg);
+                  Spill := Insert_Move (Expr, Dest);
+                  Alloc_R32 (Dest, Spill, Num);
+                  return Spill;
+               when others =>
+                  Error_Reg ("reload: unhandled dest in R32", Expr, Dest);
+            end case;
+         when Regs_R64 =>
+            return Expr;
+         when R_St0 =>
+            return Expr;
+         when Regs_Xmm =>
+            return Expr;
+         when R_Mem =>
+            if Get_Expr_Kind (Expr) = OE_Indir then
+               Set_Expr_Operand (Expr,
+                                 Reload (Get_Expr_Operand (Expr), R_Sib, Num));
+               return Expr;
+            else
+               raise Program_Error;
+            end if;
+         when R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            case Get_Expr_Kind (Expr) is
+               when OE_Add =>
+                  Set_Expr_Left
+                    (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
+                  Set_Expr_Right
+                    (Expr, Reload (Get_Expr_Right (Expr), R_Any32, Num));
+                  return Expr;
+               when OE_Addrl =>
+                  Spill := Get_Addrl_Frame (Expr);
+                  if Spill /= O_Enode_Null then
+                     Set_Addrl_Frame (Expr, Reload (Spill, R_Any32, Num));
+                  end if;
+                  return Expr;
+               when others =>
+                  Error_Reg ("reload: unhandle expr in b_off", Expr, Dest);
+            end case;
+         when R_I =>
+            Set_Expr_Left (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
+            return Expr;
+         when R_Imm =>
+            return Expr;
+         when others =>
+            Error_Reg ("reload: unhandled reg", Expr, Reg);
+      end case;
+   end Reload;
+
+   procedure Renum_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
+   begin
+      case Reg is
+         when Regs_R32 =>
+            Regs (Reg).Num := Num;
+            Regs (Reg).Stmt := Stmt;
+         when Regs_Cc =>
+            Reg_Cc.Num := Num;
+            Reg_Cc.Stmt := Stmt;
+         when R_St0 =>
+            null;
+         when Regs_R64 =>
+            declare
+               L, H : O_Reg;
+            begin
+               L := Get_R64_Low (Reg);
+               Regs (L).Num := Num;
+               Regs (L).Stmt := Stmt;
+               H := Get_R64_High (Reg);
+               Regs (H).Num := Num;
+               Regs (H).Stmt := Stmt;
+            end;
+         when others =>
+            Error_Reg ("renum_reg", Stmt, Reg);
+      end case;
+   end Renum_Reg;
+
+   procedure Free_Insn_Regs (Insn : O_Enode)
+   is
+      R : O_Reg;
+   begin
+      R := Get_Expr_Reg (Insn);
+      case R is
+         when R_Ax
+           | R_Bx
+           | R_Cx
+           | R_Dx
+           | R_Si
+           | R_Di =>
+            Free_R32 (R);
+         when R_Sp
+           | R_Bp =>
+            null;
+         when R_St0 =>
+            Free_Fp;
+         when Regs_Xmm =>
+            Free_Xmm (R);
+         when Regs_R64 =>
+            Free_R32 (Get_R64_High (R));
+            Free_R32 (Get_R64_Low (R));
+         when R_Mem =>
+            if Get_Expr_Kind (Insn) = OE_Indir then
+               Free_Insn_Regs (Get_Expr_Operand (Insn));
+            else
+               raise Program_Error;
+            end if;
+         when R_B_Off
+           | R_B_I
+           | R_I_Off
+           | R_Sib =>
+            case Get_Expr_Kind (Insn) is
+               when OE_Add =>
+                  Free_Insn_Regs (Get_Expr_Left (Insn));
+                  Free_Insn_Regs (Get_Expr_Right (Insn));
+               when OE_Addrl =>
+                  if Get_Addrl_Frame (Insn) /= O_Enode_Null then
+                     Free_Insn_Regs (Get_Addrl_Frame (Insn));
+                  end if;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when R_I =>
+            Free_Insn_Regs (Get_Expr_Left (Insn));
+         when R_Imm =>
+            null;
+         when R_Spill =>
+            null;
+         when others =>
+            Error_Reg ("free_insn_regs: unknown reg", Insn, R);
+      end case;
+   end Free_Insn_Regs;
+
+   procedure Insert_Reg (Mode : Mode_Type)
+   is
+      N : O_Enode;
+      Num : O_Inum;
+   begin
+      Num := Get_Insn_Num;
+      N := New_Enode (OE_Reg, Mode, O_Tnode_Null,
+                      O_Enode_Null, O_Enode_Null);
+      Set_Expr_Reg (N, Alloc_Reg (Get_Reg_Any (Mode), N, Num));
+      Link_Stmt (N);
+      Free_Insn_Regs (N);
+   end Insert_Reg;
+
+   procedure Insert_Arg (Expr : O_Enode)
+   is
+      N : O_Enode;
+   begin
+      Free_Insn_Regs (Expr);
+      N := New_Enode (OE_Arg, Get_Expr_Mode (Expr), O_Tnode_Null,
+                      Expr, O_Enode_Null);
+      Set_Expr_Reg (N, R_None);
+      Link_Stmt (N);
+   end Insert_Arg;
+
+   function Insert_Intrinsic (Stmt : O_Enode; Reg : O_Reg; Num : O_Inum)
+                             return O_Enode
+   is
+      N : O_Enode;
+      Op : Int32;
+      Mode : Mode_Type;
+   begin
+      Mode := Get_Expr_Mode (Stmt);
+      case Get_Expr_Kind (Stmt) is
+         when OE_Mul_Ov =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Mul_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Mul_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Div_Ov =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Div_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Div_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Mod =>
+            case Mode is
+               when Mode_U64 =>
+                  Op := Intrinsic_Mod_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Mod_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when OE_Rem =>
+            case Mode is
+               when Mode_U64 =>
+                  --  For unsigned, MOD == REM.
+                  Op := Intrinsic_Mod_Ov_U64;
+               when Mode_I64 =>
+                  Op := Intrinsic_Rem_Ov_I64;
+               when others =>
+                  raise Program_Error;
+            end case;
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  Save caller-saved registers.
+      Clobber_R32 (R_Ax);
+      Clobber_R32 (R_Dx);
+      Clobber_R32 (R_Cx);
+
+      N := New_Enode (OE_Intrinsic, Mode, O_Tnode_Null,
+                      O_Enode (Op), O_Enode_Null);
+      Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
+      Link_Stmt (N);
+      return N;
+   end Insert_Intrinsic;
+
+   --  REG is mandatory: the result of STMT must satisfy the REG constraint.
+   function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode;
+
+   function Gen_Conv_From_Fp_Insn (Stmt : O_Enode;
+                                   Reg : O_Reg;
+                                   Pnum : O_Inum)
+                                  return O_Enode
+   is
+      Num : O_Inum;
+      Left : O_Enode;
+   begin
+      Left := Get_Expr_Operand (Stmt);
+      Num := Get_Insn_Num;
+      Left := Gen_Insn (Left, R_St0, Num);
+      Free_Insn_Regs (Left);
+      Set_Expr_Operand (Stmt, Left);
+      case Reg is
+         when Regs_R32
+           | R_Any32
+           | Regs_R64
+           | R_Any64 =>
+            Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+         when R_Rm
+           | R_Irm
+           | R_Ir =>
+            Set_Expr_Reg (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+         when others =>
+            raise Program_Error;
+      end case;
+      Link_Stmt (Stmt);
+      return Stmt;
+--                             declare
+--                                Spill : O_Enode;
+--                             begin
+--                                Num := Get_Insn_Num;
+--                                Left := Gen_Insn (Left, R_St0, Num);
+--                                Set_Expr_Operand (Stmt, Left);
+--                                Set_Expr_Reg (Stmt, R_Spill);
+--                                Free_Insn_Regs (Left);
+--                                Link_Stmt (Stmt);
+--                                Spill := Insert_Spill (Stmt);
+--                                case Reg is
+--                                   when R_Any32
+--                                     | Regs_R32 =>
+--                                      return Gen_Reload (Spill, Reg, Pnum);
+--                                   when R_Ir =>
+--                                    return Gen_Reload (Spill, R_Any32, Pnum);
+--                                   when R_Rm
+--                                     | R_Irm =>
+--                                      return Spill;
+--                                   when others =>
+--                                      Error_Reg
+--                                        ("gen_insn:oe_conv(fp)", Stmt, Reg);
+--                                end case;
+--                             end;
+   end Gen_Conv_From_Fp_Insn;
+
+   function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode
+   is
+      use Interfaces;
+      Left : O_Enode;
+      Reg_Res : O_Reg;
+      Subprg : O_Dnode;
+      Push_Size : Uns32;
+      Pad : Uns32;
+      Res_Stmt : O_Enode;
+   begin
+      --  Emit Setup_Frame (to align stack).
+      Subprg := Get_Call_Subprg (Stmt);
+      Push_Size := Uns32 (Get_Subprg_Stack (Subprg));
+      --  Pad the stack if necessary.
+      Pad := (Push_Size + Push_Offset) and Uns32 (Flags.Stack_Boundary - 1);
+      if Pad /= 0 then
+         Pad := Uns32 (Flags.Stack_Boundary) - Pad;
+         Link_Stmt (New_Enode (OE_Stack_Adjust, Mode_Nil, O_Tnode_Null,
+                               O_Enode (Pad), O_Enode_Null));
+      end if;
+      --  The stack has been adjusted by Pad bytes.
+      Push_Offset := Push_Offset + Pad;
+
+      --  Generate code for arguments (if any).
+      Left := Get_Arg_Link (Stmt);
+      if Left /= O_Enode_Null then
+         Left := Gen_Insn (Left, R_None, Pnum);
+      end if;
+
+      --  Clobber registers.
+      Clobber_R32 (R_Ax);
+      Clobber_R32 (R_Dx);
+      Clobber_R32 (R_Cx);
+      --  FIXME: fp regs.
+
+      --  Add the call.
+      Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt));
+      Set_Expr_Reg (Stmt, Reg_Res);
+      Link_Stmt (Stmt);
+      Res_Stmt := Stmt;
+
+      if Push_Size + Pad /= 0 then
+         Res_Stmt :=
+           New_Enode (OE_Stack_Adjust, Get_Expr_Mode (Stmt), O_Tnode_Null,
+                      O_Enode (-Int32 (Push_Size + Pad)), O_Enode_Null);
+         Set_Expr_Reg (Res_Stmt, Reg_Res);
+         Link_Stmt (Res_Stmt);
+      end if;
+
+      --  The stack has been restored (just after the call).
+      Push_Offset := Push_Offset - (Push_Size + Pad);
+
+      case Reg is
+         when R_Any32
+           | R_Any64
+           | R_Any8
+           | R_Irm
+           | R_Rm
+           | R_Ir
+           | R_Sib
+           | R_Ax
+           | R_St0
+           | R_Edx_Eax =>
+            Reg_Res := Alloc_Reg (Reg_Res, Res_Stmt, Pnum);
+            return Res_Stmt;
+         when R_Any_Cc =>
+            --  Move to register.
+            --  (use the 'test' instruction).
+            Alloc_Cc (Res_Stmt, Pnum);
+            return Insert_Move (Res_Stmt, R_Ne);
+         when R_None =>
+            if Reg_Res /= R_None then
+               raise Program_Error;
+            end if;
+            return Res_Stmt;
+         when others =>
+            Error_Gen_Insn (Stmt, Reg);
+      end case;
+   end Gen_Call;
+
+   function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
+                     return O_Enode
+   is
+      Kind : OE_Kind;
+
+      Left : O_Enode;
+      Right : O_Enode;
+
+      Reg1 : O_Reg;
+      --      P_Reg : O_Reg;
+      Reg_L : O_Reg;
+      Reg_Res : O_Reg;
+
+      Num : O_Inum;
+   begin
+      Kind := Get_Expr_Kind (Stmt);
+      case Kind is
+         when OE_Addrl =>
+            Right := Get_Addrl_Frame (Stmt);
+            if Right /= O_Enode_Null then
+               Num := Get_Insn_Num;
+               Right := Gen_Insn (Right, R_Any32, Num);
+               Set_Addrl_Frame (Stmt, Right);
+            else
+               Num := O_Free;
+            end if;
+            case Reg is
+               when R_Sib =>
+                  Set_Expr_Reg (Stmt, R_B_Off);
+                  return Stmt;
+               when R_Irm
+                 | R_Ir =>
+                  if Right /= O_Enode_Null then
+                     Free_Insn_Regs (Right);
+                  end if;
+                  Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
+                  Link_Stmt (Stmt);
+                  return Stmt;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Addrg =>
+            case Reg is
+               when R_Sib
+                 | R_Irm
+                 | R_Ir =>
+                  Set_Expr_Reg (Stmt, R_Imm);
+                  return Stmt;
+               when R_Any32
+                 | Regs_R32 =>
+                  Set_Expr_Reg (Stmt, Reg);
+                  Link_Stmt (Stmt);
+                  return Stmt;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Indir =>
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Irm
+                 | R_Rm =>
+                  Left := Gen_Insn (Left, R_Sib, Pnum);
+                  Set_Expr_Reg (Stmt, R_Mem);
+                  Set_Expr_Operand (Stmt, Left);
+               when R_Ir
+                 | R_Sib
+                 | R_I_Off =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Reg1 := Get_Reg_Any (Stmt);
+                  if Reg1 = R_Any64 then
+                     Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
+                     Free_Insn_Regs (Left);
+                  else
+                     Free_Insn_Regs (Left);
+                     Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
+                  end if;
+                  Set_Expr_Reg (Stmt, Reg1);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when Regs_R32
+                 | R_Any32
+                 | R_Any8
+                 | Regs_Fp =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when Regs_R64
+                 | R_Any64 =>
+                  --  Avoid overwritting:
+                  --  Eg: axdx = indir (ax)
+                  --      axdx = indir (ax+dx)
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                  Left := Reload (Left, R_Sib, Num);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Stmt);
+               when R_Any_Cc =>
+                  Num := Get_Insn_Num;
+                  Left := Gen_Insn (Left, R_Sib, Num);
+                  --  Generate a cmp $1, XX
+                  Set_Expr_Reg (Stmt, R_Eq);
+                  Set_Expr_Operand (Stmt, Left);
+                  Free_Insn_Regs (Left);
+                  Link_Stmt (Stmt);
+                  Alloc_Cc (Stmt, Pnum);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            return Stmt;
+         when OE_Conv_Ptr =>
+            --  Delete nops.
+            return Gen_Insn (Get_Expr_Operand (Stmt), Reg, Pnum);
+         when OE_Const =>
+            case Get_Expr_Mode (Stmt) is
+               when Mode_U8 .. Mode_U32
+                 | Mode_I8 .. Mode_I32
+                 | Mode_P32
+                 | Mode_B2 =>
+                  case Reg is
+                     when R_Imm
+                       | Regs_Imm32 =>
+                        Set_Expr_Reg (Stmt, R_Imm);
+                     when Regs_R32
+                       | R_Any32
+                       | R_Any8 =>
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when R_Rm =>
+                        Set_Expr_Reg
+                          (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when R_Any_Cc =>
+                        Num := Get_Insn_Num;
+                        Set_Expr_Reg (Stmt, Alloc_Reg (R_Any8, Stmt, Num));
+                        Link_Stmt (Stmt);
+                        Free_Insn_Regs (Stmt);
+                        Right := Insert_Move (Stmt, R_Ne);
+                        Alloc_Cc (Right, Pnum);
+                        return Right;
+                     when others =>
+                        Error_Gen_Insn (Stmt, Reg);
+                  end case;
+               when Mode_F32
+                 | Mode_F64 =>
+                  case Reg is
+                     when R_Ir
+                       | R_Irm
+                       | R_Rm
+                       | R_St0 =>
+                        Num := Get_Insn_Num;
+                        if Reg = R_St0 or not Abi.Flag_Sse2 then
+                           Reg1 := R_St0;
+                        else
+                           Reg1 := R_Any_Xmm;
+                        end if;
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Num));
+                        Link_Stmt (Stmt);
+                     when others =>
+                        raise Program_Error;
+                  end case;
+               when Mode_U64
+                 | Mode_I64 =>
+                  case Reg is
+                     when R_Irm
+                       | R_Ir
+                       | R_Rm =>
+                        Set_Expr_Reg (Stmt, R_Imm);
+                     when R_Mem =>
+                        Set_Expr_Reg (Stmt, R_Mem);
+                     when Regs_R64
+                       | R_Any64 =>
+                        Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                        Link_Stmt (Stmt);
+                     when others =>
+                        raise Program_Error;
+                  end case;
+               when others =>
+                  raise Program_Error;
+            end case;
+            return Stmt;
+         when OE_Alloca =>
+            --  Roughly speaking, emited code is: (MASK is a constant).
+            --  VAL := (VAL + MASK) & ~MASK
+            --  SP := SP - VAL
+            --  res <- SP
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Ir
+                 | R_Irm
+                 | R_Any32 =>
+                  Num := Get_Insn_Num;
+                  if X86.Flags.Flag_Alloca_Call then
+                     Reg_L := R_Ax;
+                  else
+                     Reg_L := R_Any32;
+                  end if;
+                  Left := Gen_Insn (Left, Reg_L, Num);
+                  Set_Expr_Operand (Stmt, Left);
+                  Link_Stmt (Left);
+                  Free_Insn_Regs (Left);
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg_L, Stmt, Pnum));
+                  Link_Stmt (Stmt);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            return Stmt;
+
+         when OE_Kind_Cmp =>
+            --  Return LEFT cmp RIGHT, ie compute RIGHT - LEFT
+            Num := Get_Insn_Num;
+            Left := Get_Expr_Left (Stmt);
+            Reg_L := Get_Reg_Any (Left);
+            Left := Gen_Insn (Left, Reg_L, Num);
+
+            Right := Get_Expr_Right (Stmt);
+            case Get_Expr_Mode (Right) is
+               when Mode_F32
+                 | Mode_F64 =>
+                  Reg1 := R_St0;
+               when others =>
+                  Reg1 := R_Irm;
+            end case;
+            Right := Gen_Insn (Right, Reg1, Num);
+
+            --  FIXME: what about if right was spilled out of FP regs ?
+            --  (it is reloaded in reverse).
+            Left := Reload (Left, Reg_L, Num);
+
+            Set_Expr_Right (Stmt, Right);
+            Set_Expr_Left (Stmt, Left);
+
+            Link_Stmt (Stmt);
+
+            Reg_Res := Ekind_To_Cc (Stmt, Get_Expr_Mode (Left));
+            case Get_Expr_Mode (Left) is
+               when Mode_F32
+                 | Mode_F64 =>
+                  Reg_Res := Reverse_Cc (Reg_Res);
+               when Mode_I64 =>
+                  --  I64 is a little bit special...
+                  Reg_Res := Get_R64_High (Get_Expr_Reg (Left));
+                  if Reg_Res not in Regs_R8 then
+                     Reg_Res := R_Nil;
+                     for I in Regs_R8 loop
+                        if Regs (I).Num = O_Free then
+                           Reg_Res := I;
+                           exit;
+                        end if;
+                     end loop;
+                     if Reg_Res = R_Nil then
+                        --  FIXME: to be handled.
+                        --  Can this happen ?
+                        raise Program_Error;
+                     end if;
+                  end if;
+
+                  Free_Insn_Regs (Left);
+                  Free_Insn_Regs (Right);
+
+                  Set_Expr_Reg (Stmt, Reg_Res);
+                  case Reg is
+                     when R_Any_Cc =>
+                        Right := Insert_Move (Stmt, R_Ne);
+                        Alloc_Cc (Right, Pnum);
+                        return Right;
+                     when R_Any8
+                       | Regs_R8
+                       | R_Irm
+                       | R_Ir
+                       | R_Rm =>
+                        Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum);
+                        return Stmt;
+                     when others =>
+                        Error_Gen_Insn (Stmt, Reg);
+                  end case;
+               when others =>
+                  null;
+            end case;
+            Set_Expr_Reg (Stmt, Reg_Res);
+
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+
+            case Reg is
+               when R_Any_Cc =>
+                  Alloc_Cc (Stmt, Pnum);
+                  return Stmt;
+               when R_Any8
+                 | Regs_R8 =>
+                  Reg_Res := Alloc_Reg (Reg, Stmt, Pnum);
+                  return Insert_Move (Stmt, Reg_Res);
+               when R_Irm
+                 | R_Ir
+                 | R_Rm =>
+                  Reg_Res := Alloc_Reg (R_Any8, Stmt, Pnum);
+                  return Insert_Move (Stmt, Reg_Res);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+         when OE_Add =>
+            declare
+               R_L : O_Reg;
+               R_R : O_Reg;
+            begin
+               Left := Gen_Insn (Get_Expr_Left (Stmt), R_Sib, Pnum);
+               Right := Gen_Insn (Get_Expr_Right (Stmt), R_Sib, Pnum);
+               Left := Reload (Left, R_Sib, Pnum);
+               Set_Expr_Right (Stmt, Right);
+               Set_Expr_Left (Stmt, Left);
+               R_L := Get_Expr_Reg (Left);
+               R_R := Get_Expr_Reg (Right);
+               --  Results can be: Reg, R_B_Off, R_Sib, R_Imm, R_B_I
+               case R_L is
+                  when R_Any32
+                    | Regs_R32 =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_B_Off
+                          | R_I
+                          | R_I_Off =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when R_Any32
+                          | Regs_R32 =>
+                           Set_Expr_Reg (Stmt, R_B_I);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_Imm =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_Imm);
+                        when R_Any32
+                          | Regs_R32
+                          | R_B_Off =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_I
+                          | R_I_Off =>
+                           Set_Expr_Reg (Stmt, R_I_Off);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_B_Off =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_B_Off);
+                        when R_Any32
+                          | Regs_R32
+                          | R_I =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_I_Off =>
+                     case R_R is
+                        when R_Imm =>
+                           Set_Expr_Reg (Stmt, R_I_Off);
+                        when R_Any32
+                          | Regs_R32 =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_I =>
+                     case R_R is
+                        when R_Imm
+                          | Regs_R32
+                          | R_B_Off =>
+                           Set_Expr_Reg (Stmt, R_Sib);
+                        when others =>
+                           Error_Gen_Insn (Stmt, R_R);
+                     end case;
+                  when R_Sib
+                    | R_B_I =>
+                     if R_R = R_Imm then
+                        Set_Expr_Reg (Stmt, R_Sib);
+                     else
+                        Num := Get_Insn_Num;
+                        Free_Insn_Regs (Left);
+                        Set_Expr_Reg (Left, Alloc_Reg (R_Any32, Left, Num));
+                        Link_Stmt (Left);
+                        case R_R is
+                           when R_Any32
+                             | Regs_R32
+                             | R_I =>
+                              Set_Expr_Reg (Stmt, R_B_I);
+                           when others =>
+                              Error_Gen_Insn (Stmt, R_R);
+                        end case;
+                     end if;
+                  when others =>
+                     Error_Gen_Insn (Stmt, R_L);
+               end case;
+
+               case Reg is
+                  when R_Sib =>
+                     null;
+                  when R_Ir
+                    | R_Irm =>
+                     if Get_Expr_Reg (Stmt) /= R_Imm then
+                        Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
+                        Free_Insn_Regs (Left);
+                        Free_Insn_Regs (Right);
+                        Link_Stmt (Stmt);
+                     end if;
+                  when R_Any32
+                    | Regs_R32 =>
+                     Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                  when others =>
+                     Error_Gen_Insn (Stmt, Reg);
+               end case;
+            end;
+            return Stmt;
+         when OE_Mul =>
+            Num := Get_Insn_Num;
+            Left := Gen_Insn (Get_Expr_Left (Stmt), R_Ax, Num);
+            Set_Expr_Left (Stmt, Left);
+
+            Right := Gen_Insn (Get_Expr_Right (Stmt), R_Any32, Num);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               raise Program_Error;
+            end if;
+            Set_Expr_Right (Stmt, Right);
+
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+            Clobber_R32 (R_Dx);
+            Set_Expr_Reg (Stmt, Alloc_Reg (R_Ax, Stmt, Pnum));
+            case Reg is
+               when R_Sib
+                 | R_B_Off =>
+                  null;
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Link_Stmt (Stmt);
+            return Stmt;
+         when OE_Shl =>
+            Num := Get_Insn_Num;
+            Right := Get_Expr_Right (Stmt);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               Right := Gen_Insn (Right, R_Cx, Num);
+            else
+               Right := Gen_Insn (Right, R_Imm, Num);
+            end if;
+            Left := Get_Expr_Left (Stmt);
+            Reg1 := Get_Reg_Any (Stmt);
+            Left := Gen_Insn (Left, Reg1, Pnum);
+            if Get_Expr_Kind (Right) /= OE_Const then
+               Right := Reload (Right, R_Cx, Num);
+            end if;
+            Left := Reload (Left, Reg1, Pnum);
+            Set_Expr_Left (Stmt, Left);
+            Set_Expr_Right (Stmt, Right);
+            if Reg = R_Sib
+              and then Get_Expr_Kind (Right) = OE_Const
+              and then Get_Expr_Low (Right) in 0 .. 3
+            then
+               Set_Expr_Reg (Stmt, R_I);
+            else
+               Link_Stmt (Stmt);
+               Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
+               Free_Insn_Regs (Right);
+            end if;
+            return Stmt;
+
+         when OE_Add_Ov
+           | OE_Sub_Ov
+           | OE_And
+           | OE_Xor
+           | OE_Or =>
+            --  Accepted is: R with IMM or R/M
+            Num := Get_Insn_Num;
+            Right := Get_Expr_Right (Stmt);
+            Left := Get_Expr_Left (Stmt);
+            case Reg is
+               when R_Irm
+                 | R_Rm
+                 | R_Ir
+                 | R_Sib =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Reg1 := Get_Reg_Any (Stmt);
+                  Left := Gen_Insn (Left, Reg1, Num);
+                  Right := Reload (Right, R_Irm, Num);
+                  Left := Reload (Left, Reg1, Num);
+                  Reg_Res := Get_Expr_Reg (Left);
+               when R_Any_Cc =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Left := Gen_Insn (Left, R_Any8, Num);
+                  Reg_Res := R_Ne;
+                  Alloc_Cc (Stmt, Num);
+                  Free_Insn_Regs (Left);
+               when R_Any32
+                 | Regs_R32
+                 | R_Any8
+                 | R_Any64
+                 | Regs_R64
+                 | Regs_Fp =>
+                  Right := Gen_Insn (Right, R_Irm, Num);
+                  Left := Gen_Insn (Left, Reg, Num);
+                  Right := Reload (Right, R_Irm, Num);
+                  Left := Reload (Left, Reg, Num);
+                  Reg_Res := Get_Expr_Reg (Left);
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Set_Expr_Right (Stmt, Right);
+            Set_Expr_Left (Stmt, Left);
+            Set_Expr_Reg (Stmt, Reg_Res);
+            Renum_Reg (Reg_Res, Stmt, Pnum);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Right);
+            return Stmt;
+
+         when OE_Mod
+           | OE_Rem
+           | OE_Mul_Ov
+           | OE_Div_Ov =>
+            declare
+               Mode : Mode_Type;
+            begin
+               Num := Get_Insn_Num;
+               Mode := Get_Expr_Mode (Stmt);
+               Left := Get_Expr_Left (Stmt);
+               Right := Get_Expr_Right (Stmt);
+               case Mode is
+                  when Mode_I32
+                    | Mode_U32
+                    | Mode_I16
+                    | Mode_U16 =>
+                     Left := Gen_Insn (Left, R_Ax, Num);
+                     Right := Gen_Insn (Right, R_Rm, Num);
+                     Left := Reload (Left, R_Ax, Num);
+                     case Kind is
+                        when OE_Div_Ov
+                          | OE_Rem
+                          | OE_Mod =>
+                           --  Be sure EDX is free.
+                           Reg_Res := Alloc_Reg (R_Dx, Stmt, Pnum);
+                        when others =>
+                           Reg_Res := R_Nil;
+                     end case;
+                     Right := Reload (Right, R_Rm, Num);
+                     Set_Expr_Right (Stmt, Right);
+                     Set_Expr_Left (Stmt, Left);
+                     Free_Insn_Regs (Left);
+                     Free_Insn_Regs (Right);
+                     if Reg_Res /= R_Nil then
+                        Free_R32 (Reg_Res);
+                     end if;
+                     if Kind = OE_Div_Ov or Kind = OE_Mul_Ov then
+                        Reg_Res := R_Ax;
+                        Clobber_R32 (R_Dx);
+                     else
+                        Reg_Res := R_Dx;
+                        Clobber_R32 (R_Ax);
+                     end if;
+                     Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                     return Reload (Stmt, Reg, Pnum);
+                  when Mode_U64
+                    | Mode_I64 =>
+                     --  FIXME: align stack
+                     Insert_Arg (Gen_Insn (Right, R_Irm, Num));
+                     Insert_Arg (Gen_Insn (Left, R_Irm, Num));
+                     return Insert_Intrinsic (Stmt, R_Edx_Eax, Pnum);
+                  when Mode_F32
+                    | Mode_F64 =>
+                     Left := Gen_Insn (Left, R_St0, Num);
+                     Right := Gen_Insn (Right, R_Rm, Num);
+                     Set_Expr_Left (Stmt, Left);
+                     Set_Expr_Right (Stmt, Right);
+                     Free_Insn_Regs (Right);
+                     Free_Insn_Regs (Left);
+                     Set_Expr_Reg (Stmt, Alloc_Reg (R_St0, Stmt, Pnum));
+                     Link_Stmt (Stmt);
+                     return Stmt;
+                  when others =>
+                     Error_Gen_Insn (Stmt, Mode);
+               end case;
+            end;
+
+         when OE_Not
+           | OE_Abs_Ov
+           | OE_Neg_Ov =>
+            Left := Get_Expr_Operand (Stmt);
+            case Reg is
+               when R_Any32
+                 | Regs_R32
+                 | R_Any64
+                 | Regs_R64
+                 | R_Any8
+                 | R_St0 =>
+                  Reg_Res := Reg;
+               when R_Any_Cc =>
+                  if Kind /= OE_Not then
+                     raise Program_Error;
+                  end if;
+                  Left := Gen_Insn (Left, R_Any_Cc, Pnum);
+                  Set_Expr_Operand (Stmt, Left);
+                  Reg_Res := Inverse_Cc (Get_Expr_Reg (Left));
+                  Free_Cc;
+                  Set_Expr_Reg (Stmt, Reg_Res);
+                  Alloc_Cc (Stmt, Pnum);
+                  return Stmt;
+               when R_Irm
+                 | R_Rm
+                 | R_Ir =>
+                  Reg_Res := Get_Reg_Any (Get_Expr_Mode (Left));
+               when others =>
+                  Error_Gen_Insn (Stmt, Reg);
+            end case;
+            Left := Gen_Insn (Left, Reg_Res, Pnum);
+            Set_Expr_Operand (Stmt, Left);
+            Reg_Res := Get_Expr_Reg (Left);
+            Free_Insn_Regs (Left);
+            Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
+            Link_Stmt (Stmt);
+            return Stmt;
+         when OE_Conv =>
+            declare
+               O_Mode : Mode_Type;      --  Operand mode
+               R_Mode : Mode_Type;      --  Result mode
+            begin
+               Left := Get_Expr_Operand (Stmt);
+               O_Mode := Get_Expr_Mode (Left);
+               R_Mode := Get_Expr_Mode (Stmt);
+               --  Simple case: no conversion.
+               --  FIXME: should be handled by EXPR and convert to NOP.
+               if Get_Expr_Mode (Left) = Get_Expr_Mode (Stmt) then
+                  --  A no-op.
+                  return Gen_Insn (Left, Reg, Pnum);
+               end if;
+               case R_Mode is
+                  when Mode_B2 =>
+                     case O_Mode is
+                        when Mode_U32
+                          | Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_U8 =>
+                     case O_Mode is
+                        when Mode_U16
+                          | Mode_U32
+                          | Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_U32 =>
+                     case O_Mode is
+                        when Mode_I32 =>
+                           --  Detect for bound.
+                           null;
+                        when Mode_B2
+                          | Mode_U8
+                          | Mode_U16 =>
+                           --  Zero extend.
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_I32 =>
+                     case O_Mode is
+                        when Mode_U8
+                          | Mode_I8
+                          | Mode_B2
+                          | Mode_U16
+                          | Mode_U32 =>
+                           --  Zero extend
+                           --  Detect for bound (U32).
+                           null;
+                        when Mode_I64 =>
+                           --  Detect for bound (U32)
+                           Num := Get_Insn_Num;
+                           Left := Gen_Insn (Left, R_Edx_Eax, Num);
+                           Free_Insn_Regs (Left);
+                           Set_Expr_Operand (Stmt, Left);
+                           case Reg is
+                              when R_Ax
+                                | R_Any32
+                                | R_Rm
+                                | R_Irm
+                                | R_Ir =>
+                                 Set_Expr_Reg
+                                   (Stmt, Alloc_Reg (R_Ax, Stmt, Num));
+                              when others =>
+                                 raise Program_Error;
+                           end case;
+                           Insert_Reg (Mode_U32);
+                           Link_Stmt (Stmt);
+                           return Stmt;
+                        when Mode_F64
+                          | Mode_F32 =>
+                           return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_I64 =>
+                     case O_Mode is
+                        when Mode_I32 =>
+                           --  Sign extend.
+                           Num := Get_Insn_Num;
+                           Left := Gen_Insn (Left, R_Ax, Num);
+                           Set_Expr_Operand (Stmt, Left);
+                           Free_Insn_Regs (Left);
+                           case Reg is
+                              when R_Edx_Eax
+                                | R_Any64
+                                | R_Rm
+                                | R_Irm
+                                | R_Ir =>
+                                 Set_Expr_Reg
+                                   (Stmt, Alloc_Reg (R_Edx_Eax, Stmt, Pnum));
+                              when others =>
+                                 raise Program_Error;
+                           end case;
+                           Link_Stmt (Stmt);
+                           return Stmt;
+                        when Mode_F64
+                          | Mode_F32 =>
+                           return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when Mode_F64 =>
+                     case O_Mode is
+                        when Mode_I32
+                          | Mode_I64 =>
+                           null;
+                        when others =>
+                           Error_Gen_Insn (Stmt, O_Mode);
+                     end case;
+                  when others =>
+                     Error_Gen_Insn (Stmt, O_Mode);
+               end case;
+               Left := Gen_Insn (Left, R_Rm, Pnum);
+               Set_Expr_Operand (Stmt, Left);
+               case Reg is
+                  when R_Irm
+                    | R_Rm
+                    | R_Ir
+                    | R_Sib
+                    | R_Any32
+                    | Regs_R32
+                    | R_Any64
+                    | R_Any8
+                    | Regs_R64
+                    | Regs_Fp =>
+                     Free_Insn_Regs (Left);
+                     Set_Expr_Reg
+                       (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
+                  when others =>
+                     Error_Gen_Insn (Stmt, Reg);
+               end case;
+               Link_Stmt (Stmt);
+               return Stmt;
+            end;
+         when OE_Arg =>
+            if Reg /= R_None then
+               raise Program_Error;
+            end if;
+            Left := Get_Arg_Link (Stmt);
+            if Left /= O_Enode_Null then
+               --  Recurse on next argument, so the first argument is pushed
+               --  the last one.
+               Left := Gen_Insn (Left, R_None, Pnum);
+            end if;
+
+            Left := Get_Expr_Operand (Stmt);
+            case Get_Expr_Mode (Left) is
+               when Mode_F32 .. Mode_F64 =>
+                  --  fstp instruction.
+                  Reg_Res := R_St0;
+               when others =>
+                  --  Push instruction.
+                  Reg_Res := R_Irm;
+            end case;
+            Left := Gen_Insn (Left, Reg_Res, Pnum);
+            Set_Expr_Operand (Stmt, Left);
+            Push_Offset := Push_Offset +
+              Do_Align (Get_Mode_Size (Get_Expr_Mode (Left)), Mode_U32);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+            return Stmt;
+         when OE_Call =>
+            return Gen_Call (Stmt, Reg, Pnum);
+         when OE_Case_Expr =>
+            Left := Get_Expr_Operand (Stmt);
+            Set_Expr_Reg (Stmt, Alloc_Reg (Get_Expr_Reg (Left), Stmt, Pnum));
+            return Stmt;
+         when OE_Get_Stack =>
+            Set_Expr_Reg (Stmt, R_Sp);
+            return Stmt;
+         when OE_Get_Frame =>
+            Set_Expr_Reg (Stmt, R_Bp);
+            return Stmt;
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("gen_insn: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+   end Gen_Insn;
+
+   procedure Assert_Free_Regs (Stmt : O_Enode) is
+   begin
+      for I in Regs_R32 loop
+         if Regs (I).Num /= O_Free then
+            Error_Reg ("gen_insn_stmt: reg is not free", Stmt, I);
+         end if;
+      end loop;
+      for I in Fp_Stack_Type loop
+         if Fp_Regs (I).Stmt /= O_Enode_Null then
+            Error_Reg ("gen_insn_stmt: reg is not free", Stmt, R_St0);
+         end if;
+      end loop;
+   end Assert_Free_Regs;
+
+   procedure Gen_Insn_Stmt (Stmt : O_Enode)
+   is
+      Kind : OE_Kind;
+
+      Left : O_Enode;
+      Right : O_Enode;
+      P_Reg : O_Reg;
+      Num : O_Inum;
+
+      Prev_Stack_Offset : Uns32;
+   begin
+      Insn_Num := O_Iroot;
+      Num := Get_Insn_Num;
+      Prev_Stack_Offset := Stack_Offset;
+
+      Kind := Get_Expr_Kind (Stmt);
+      case Kind is
+         when OE_Asgn =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Ir, Num);
+            Right := Gen_Insn (Get_Assign_Target (Stmt), R_Sib, Num);
+            Left := Reload (Left, R_Ir, Num);
+            --Right := Reload (Right, R_Sib, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Assign_Target (Stmt, Right);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+            Free_Insn_Regs (Right);
+         when OE_Set_Stack =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Rm, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Expr_Reg (Stmt, R_Sp);
+            Link_Stmt (Stmt);
+         when OE_Jump_F
+           | OE_Jump_T =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Any_Cc, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Link_Stmt (Stmt);
+            Free_Cc;
+         when OE_Beg =>
+            declare
+               Block_Decl : O_Dnode;
+            begin
+               Cur_Block := Stmt;
+               Block_Decl := Get_Block_Decls (Cur_Block);
+               Set_Block_Max_Stack (Block_Decl, Stack_Offset);
+               Expand_Decls (Block_Decl);
+            end;
+            Link_Stmt (Stmt);
+         when OE_End =>
+            Swap_Stack_Offset (Get_Block_Decls (Cur_Block));
+            Cur_Block := Get_Block_Parent (Cur_Block);
+            Link_Stmt (Stmt);
+         when OE_Jump
+           | OE_Label =>
+            Link_Stmt (Stmt);
+         when OE_Leave =>
+            Link_Stmt (Stmt);
+         when OE_Call =>
+            Link_Stmt (Gen_Call (Stmt, R_None, Num));
+         when OE_Ret =>
+            Left := Get_Expr_Operand (Stmt);
+            P_Reg := Get_Call_Register (Get_Expr_Mode (Stmt));
+            Left := Gen_Insn (Left, P_Reg, Num);
+            Set_Expr_Operand (Stmt, Left);
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+         when OE_Case =>
+            Left := Gen_Insn (Get_Expr_Operand (Stmt),
+                              Get_Reg_Any (Get_Expr_Mode (Stmt)),
+                              Num);
+            Set_Expr_Operand (Stmt, Left);
+            Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
+            Link_Stmt (Stmt);
+            Free_Insn_Regs (Left);
+         when OE_Line =>
+            Set_Expr_Reg (Stmt, R_None);
+            Link_Stmt (Stmt);
+         when OE_BB =>
+            --  Keep BB.
+            Link_Stmt (Stmt);
+         when others =>
+            Ada.Text_IO.Put_Line
+              ("gen_insn_stmt: unhandled enode " & OE_Kind'Image (Kind));
+            raise Program_Error;
+      end case;
+
+      --  Free any spill stack slots.
+      case Kind is
+         when OE_Beg
+           | OE_End =>
+            null;
+         when others =>
+            Stack_Offset := Prev_Stack_Offset;
+      end case;
+
+      --  Check all registers are free.
+      if Debug.Flag_Debug_Assert then
+         Assert_Free_Regs (Stmt);
+      end if;
+   end Gen_Insn_Stmt;
+
+   procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc)
+   is
+      First : O_Enode;
+      Stmt : O_Enode;
+      N_Stmt : O_Enode;
+   begin
+      if Debug.Flag_Debug_Insn then
+         declare
+            Inter : O_Dnode;
+         begin
+            Disp_Decl (1, Subprg.D_Decl);
+            Inter := Get_Subprg_Interfaces (Subprg.D_Decl);
+            while Inter /= O_Dnode_Null loop
+               Disp_Decl (2, Inter);
+               Inter := Get_Interface_Chain (Inter);
+            end loop;
+         end;
+      end if;
+
+      for I in Regs_R32 loop
+         Regs (I).Used := False;
+      end loop;
+
+      Stack_Max := 0;
+      Stack_Offset := 0;
+      First := Subprg.E_Entry;
+      Expand_Decls (Subprg.D_Body + 1);
+      Abi.Last_Link := First;
+
+      --  Generate instructions.
+      --  Skip OE_Entry.
+      Stmt := Get_Stmt_Link (First);
+      loop
+         N_Stmt := Get_Stmt_Link (Stmt);
+         Gen_Insn_Stmt (Stmt);
+         exit when Get_Expr_Kind (Stmt) = OE_Leave;
+         Stmt := N_Stmt;
+      end loop;
+
+      --  Keep stack depth for this subprogram.
+      Subprg.Stack_Max := Stack_Max;
+
+      --  Sanity check: there must be no remaining pushed bytes.
+      if Push_Offset /= 0 then
+         raise Program_Error with "gen_subprg_insn: push_offset not 0";
+      end if;
+   end Gen_Subprg_Insns;
+
+end Ortho_Code.X86.Insns;
diff --git a/src/ortho/mcode/ortho_code-x86-insns.ads b/src/ortho/mcode/ortho_code-x86-insns.ads
new file mode 100644
index 000000000..9411737a0
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86-insns.ads
@@ -0,0 +1,25 @@
+--  Mcode back-end for ortho - mcode to X86 instructions.
+--  Copyright (C) 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.
+package Ortho_Code.X86.Insns is
+   function Reg_Used (Reg : Regs_R32) return Boolean;
+
+   --  Split enodes of SUBPRG into instructions.
+   procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc);
+
+end Ortho_Code.X86.Insns;
+
diff --git a/src/ortho/mcode/ortho_code-x86.adb b/src/ortho/mcode/ortho_code-x86.adb
new file mode 100644
index 000000000..175dd7e99
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86.adb
@@ -0,0 +1,109 @@
+--  Mcode back-end for ortho - X86 common definitions.
+--  Copyright (C) 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.
+package body Ortho_Code.X86 is
+   function Inverse_Cc (R : O_Reg) return O_Reg is
+   begin
+      case R is
+         when R_Ult =>
+            return R_Uge;
+         when R_Uge =>
+            return R_Ult;
+         when R_Eq =>
+            return R_Ne;
+         when R_Ne =>
+            return R_Eq;
+         when R_Ule =>
+            return R_Ugt;
+         when R_Ugt =>
+            return R_Ule;
+         when R_Slt =>
+            return R_Sge;
+         when R_Sge =>
+            return R_Slt;
+         when R_Sle =>
+            return R_Sgt;
+         when R_Sgt =>
+            return R_Sle;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Inverse_Cc;
+
+   function Get_R64_High (Reg : Regs_R64) return Regs_R32 is
+   begin
+      case Reg is
+         when R_Edx_Eax =>
+            return R_Dx;
+         when R_Ebx_Ecx =>
+            return R_Bx;
+         when R_Esi_Edi =>
+            return R_Si;
+      end case;
+   end Get_R64_High;
+
+   function Get_R64_Low (Reg : Regs_R64) return Regs_R32 is
+   begin
+      case Reg is
+         when R_Edx_Eax =>
+            return R_Ax;
+         when R_Ebx_Ecx =>
+            return R_Cx;
+         when R_Esi_Edi =>
+            return R_Di;
+      end case;
+   end Get_R64_Low;
+
+   function Ekind_Unsigned_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is
+   begin
+      case Kind is
+         when OE_Eq =>
+            return R_Eq;
+         when OE_Neq =>
+            return R_Ne;
+         when OE_Lt =>
+            return R_Ult;
+         when OE_Le =>
+            return R_Ule;
+         when OE_Gt =>
+            return R_Ugt;
+         when OE_Ge =>
+            return R_Uge;
+      end case;
+   end Ekind_Unsigned_To_Cc;
+
+   function Ekind_Signed_To_Cc (Kind : OE_Kind_Cmp) return O_Reg is
+   begin
+      case Kind is
+         when OE_Eq =>
+            return R_Eq;
+         when OE_Neq =>
+            return R_Ne;
+         when OE_Lt =>
+            return R_Slt;
+         when OE_Le =>
+            return R_Sle;
+         when OE_Gt =>
+            return R_Sgt;
+         when OE_Ge =>
+            return R_Sge;
+      end case;
+   end Ekind_Signed_To_Cc;
+
+end Ortho_Code.X86;
+
+
diff --git a/src/ortho/mcode/ortho_code-x86.ads b/src/ortho/mcode/ortho_code-x86.ads
new file mode 100644
index 000000000..24be1eb6c
--- /dev/null
+++ b/src/ortho/mcode/ortho_code-x86.ads
@@ -0,0 +1,160 @@
+--  Mcode back-end for ortho - X86 common definitions.
+--  Copyright (C) 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 Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+package Ortho_Code.X86 is
+   --  Registers.
+   R_Nil : constant O_Reg := 0;
+
+   --  Not a value.  Used for statements.
+   R_None : constant O_Reg := 1;
+
+   --  Memory.
+   R_Mem : constant O_Reg := 2;
+
+   --  Spilled out.
+   R_Spill : constant O_Reg := 3;
+
+   --  Register or memory.
+   --  THis can only be requested.
+   R_Rm : constant O_Reg := 48;
+
+   --  Immediat
+   R_Imm : constant O_Reg := 49;
+
+   --  Immediat, register or memory.
+   --  This can be requested.
+   R_Irm : constant O_Reg := 50;
+
+   --  Immediat or register.
+   --  This can be requested.
+   R_Ir : constant O_Reg := 51;
+
+   --  BASE + OFFSET
+   R_B_Off : constant O_Reg := 52;
+
+   --  BASE+INDEX*SCALE+OFFSET
+   --  This can be requested.
+   R_Sib : constant O_Reg := 53;
+
+   --  INDEX*SCALE + OFFSET
+   --  This can be requested.
+   R_I_Off : constant O_Reg := 54;
+
+   --  BASE + INDEX*SCALE
+   R_B_I : constant O_Reg := 55;
+
+   --  INDEX*SCALE
+   R_I : constant O_Reg := 56;
+
+   subtype Regs_Imm32 is O_Reg range R_Irm .. R_I_Off;
+
+   R_Any8 : constant O_Reg := 6;
+   R_Any32 : constant O_Reg := 7;
+   R_Ax : constant O_Reg := 8;
+   R_Cx : constant O_Reg := 9;
+   R_Dx : constant O_Reg := 10;
+   R_Bx : constant O_Reg := 11;
+   R_Sp : constant O_Reg := 12;
+   R_Bp : constant O_Reg := 13;
+   R_Si : constant O_Reg := 14;
+   R_Di : constant O_Reg := 15;
+
+   subtype Regs_R8 is O_Reg range R_Ax .. R_Bx;
+   subtype Regs_R32 is O_Reg range R_Ax .. R_Di;
+
+   R_St0 : constant O_Reg := 16;
+   R_St1 : constant O_Reg := 17;
+   R_St2 : constant O_Reg := 18;
+   R_St3 : constant O_Reg := 19;
+   R_St4 : constant O_Reg := 20;
+   R_St5 : constant O_Reg := 21;
+   R_St6 : constant O_Reg := 22;
+   R_St7 : constant O_Reg := 23;
+   --R_Any_Fp : constant O_Reg := 24;
+
+   subtype Regs_Fp is O_Reg range R_St0 .. R_St7;
+
+   --  Any condition register.
+   R_Any_Cc : constant O_Reg := 32;
+   R_Ov : constant O_Reg := 32;
+   R_Ult : constant O_Reg := 34;
+   R_Uge : constant O_Reg := 35;
+   R_Eq : constant O_Reg := 36;
+   R_Ne : constant O_Reg := 37;
+   R_Ule : constant O_Reg := 38;
+   R_Ugt : constant O_Reg := 39;
+   R_Slt : constant O_Reg := 44;
+   R_Sge : constant O_Reg := 45;
+   R_Sle : constant O_Reg := 46;
+   R_Sgt : constant O_Reg := 47;
+
+   subtype Regs_Cc is O_Reg range R_Ov .. R_Sgt;
+
+   R_Edx_Eax : constant O_Reg := 64;
+   R_Ebx_Ecx : constant O_Reg := 65;
+   R_Esi_Edi : constant O_Reg := 66;
+   R_Any64 : constant O_Reg := 67;
+
+   subtype Regs_R64 is O_Reg range R_Edx_Eax .. R_Esi_Edi;
+
+   R_Any_Xmm : constant O_Reg := 79;
+
+   R_Xmm0  : constant O_Reg := 80;
+   R_Xmm1  : constant O_Reg := R_Xmm0 + 1;
+   R_Xmm2  : constant O_Reg := R_Xmm0 + 2;
+   R_Xmm3  : constant O_Reg := R_Xmm0 + 3;
+   R_Xmm4  : constant O_Reg := R_Xmm0 + 4;
+   R_Xmm5  : constant O_Reg := R_Xmm0 + 5;
+   R_Xmm6  : constant O_Reg := R_Xmm0 + 6;
+   R_Xmm7  : constant O_Reg := R_Xmm0 + 7;
+   R_Xmm8  : constant O_Reg := R_Xmm0 + 8;
+   R_Xmm9  : constant O_Reg := R_Xmm0 + 9;
+   R_Xmm10 : constant O_Reg := R_Xmm0 + 10;
+   R_Xmm11 : constant O_Reg := R_Xmm0 + 11;
+   R_Xmm12 : constant O_Reg := R_Xmm0 + 12;
+   R_Xmm13 : constant O_Reg := R_Xmm0 + 13;
+   R_Xmm14 : constant O_Reg := R_Xmm0 + 14;
+   R_Xmm15 : constant O_Reg := R_Xmm0 + 15;
+
+   subtype Regs_X86_64_Xmm is O_Reg range R_Xmm0 .. R_Xmm15;
+   subtype Regs_X86_Xmm is O_Reg range R_Xmm0 .. R_Xmm7;
+   subtype Regs_Xmm is O_Reg range R_Xmm0 .. R_Xmm15;
+
+   function Get_R64_High (Reg : Regs_R64) return Regs_R32;
+   function Get_R64_Low (Reg : Regs_R64) return Regs_R32;
+
+   function Inverse_Cc (R : O_Reg) return O_Reg;
+
+   --  Intrinsic subprograms.
+   Intrinsic_Mul_Ov_U64 : constant Int32 := 1;
+   Intrinsic_Div_Ov_U64 : constant Int32 := 2;
+   Intrinsic_Mod_Ov_U64 : constant Int32 := 3;
+   Intrinsic_Mul_Ov_I64 : constant Int32 := 4;
+   Intrinsic_Div_Ov_I64 : constant Int32 := 5;
+   Intrinsic_Mod_Ov_I64 : constant Int32 := 6;
+   Intrinsic_Rem_Ov_I64 : constant Int32 := 7;
+
+   subtype Intrinsics_X86 is Int32
+     range Intrinsic_Mul_Ov_U64 .. Intrinsic_Rem_Ov_I64;
+
+   --  Convert a KIND to a reg.
+   function Ekind_Unsigned_To_Cc (Kind : OE_Kind_Cmp) return O_Reg;
+   function Ekind_Signed_To_Cc (Kind : OE_Kind_Cmp) return O_Reg;
+
+end Ortho_Code.X86;
diff --git a/src/ortho/mcode/ortho_code.ads b/src/ortho/mcode/ortho_code.ads
new file mode 100644
index 000000000..0657b07e6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code.ads
@@ -0,0 +1,150 @@
+--  Mcode back-end for ortho - common definitions.
+--  Copyright (C) 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 Ada.Unchecked_Conversion;
+
+package Ortho_Code is
+   type Int32 is range -(2 ** 31) .. (2 ** 31) - 1;
+
+   type Uns32 is mod 2 ** 32;
+
+   type Uns64 is mod 2 ** 64;
+
+   function Shift_Right (L : Uns64; R : Natural) return Uns64;
+   function Shift_Right (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Right);
+
+   function Shift_Right_Arithmetic (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Right_Arithmetic);
+
+   function Shift_Left (L : Uns32; R : Natural) return Uns32;
+   pragma Import (Intrinsic, Shift_Left);
+
+   type O_Tnode is new Int32;
+   for O_Tnode'Size use 32;
+   O_Tnode_Null : constant O_Tnode := 0;
+   O_Tnode_First : constant O_Tnode := 2;
+
+   --  A generic pointer.
+   --  This is used by static chains.
+   O_Tnode_Ptr : constant O_Tnode := 2;
+
+   type O_Cnode is new Int32;
+   for O_Cnode'Size use 32;
+   O_Cnode_Null : constant O_Cnode := 0;
+
+   type O_Dnode is new Int32;
+   for O_Dnode'Size use 32;
+   O_Dnode_Null : constant O_Dnode := 0;
+   O_Dnode_First : constant O_Dnode := 2;
+
+   type O_Enode is new Int32;
+   for O_Enode'Size use 32;
+   O_Enode_Null : constant O_Enode := 0;
+   O_Enode_Err : constant O_Enode := 1;
+
+   type O_Fnode is new Int32;
+   for O_Fnode'Size use 32;
+   O_Fnode_Null : constant O_Fnode := 0;
+
+   type O_Lnode is new Int32;
+   for O_Lnode'Size use 32;
+   O_Lnode_Null : constant O_Lnode := 0;
+
+   type O_Ident is new Int32;
+   O_Ident_Nul : constant O_Ident := 0;
+
+   function To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Uns32, Target => Int32);
+
+   function To_Uns32 is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Uns32);
+
+
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+
+   --  Depth of a declaration.
+   --    0 for top-level,
+   --    1 for declared in a top-level subprogram
+   type O_Depth is range 0 .. (2 ** 16) - 1;
+   O_Toplevel : constant O_Depth := 0;
+
+   --  BE representation of a register.
+   type O_Reg is mod 256;
+   R_Nil : constant O_Reg := 0;
+
+   type Mode_Type is (Mode_U8, Mode_U16, Mode_U32, Mode_U64,
+                      Mode_I8, Mode_I16, Mode_I32, Mode_I64,
+                      Mode_X1, Mode_Nil, Mode_F32, Mode_F64,
+                      Mode_B2, Mode_Blk, Mode_P32, Mode_P64);
+
+   subtype Mode_Uns is Mode_Type range Mode_U8 .. Mode_U64;
+   subtype Mode_Int is Mode_Type range Mode_I8 .. Mode_I64;
+   subtype Mode_Fp is Mode_Type range Mode_F32 .. Mode_F64;
+   -- Mode_Ptr : constant Mode_Type := Mode_P32;
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   Syntax_Error : exception;
+end Ortho_Code;
diff --git a/src/ortho/mcode/ortho_code_main.adb b/src/ortho/mcode/ortho_code_main.adb
new file mode 100644
index 000000000..a0e6dc6c6
--- /dev/null
+++ b/src/ortho/mcode/ortho_code_main.adb
@@ -0,0 +1,198 @@
+--  Mcode back-end for ortho - Main subprogram.
+--  Copyright (C) 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 Ada.Unchecked_Conversion;
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Unchecked_Deallocation;
+with Ada.Text_IO; use Ada.Text_IO;
+with Binary_File; use Binary_File;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ortho_Code.Debug;
+with Ortho_Mcode; use Ortho_Mcode;
+with Ortho_Front; use Ortho_Front;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
+with Binary_File.Elf;
+with Binary_File.Coff;
+with Binary_File.Memory;
+
+procedure Ortho_Code_Main
+is
+   Output : String_Acc := null;
+   type Format_Type is (Format_Coff, Format_Elf);
+   Format : constant Format_Type := Format_Elf;
+   Fd : File_Descriptor;
+
+   First_File : Natural;
+   Opt : String_Acc;
+   Opt_Arg : String_Acc;
+   Filename : String_Acc;
+   Exec_Func : String_Acc;
+   Res : Natural;
+   I : Natural;
+   Argc : Natural;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Acc, Object => String);
+begin
+   First_File := Natural'Last;
+   Exec_Func := null;
+
+   Ortho_Front.Init;
+
+   Argc := Argument_Count;
+   I := 1;
+   while I <= Argc loop
+      declare
+         Arg : constant String := Argument (I);
+      begin
+         if Arg (1) = '-' then
+            if Arg'Length > 5 and then Arg (1 .. 5) = "--be-" then
+               Ortho_Code.Debug.Set_Be_Flag (Arg);
+               I := I + 1;
+            elsif Arg = "-o" then
+               if I = Argc then
+                  Put_Line (Standard_Error, "error: missing filename to '-o'");
+                  return;
+               end if;
+               Output := new String'(Argument (I + 1));
+               I := I + 2;
+            elsif Arg = "-quiet" then
+               --  Skip silently.
+               I := I + 1;
+            elsif Arg = "--exec" then
+               if I = Argc then
+                  Put_Line (Standard_Error,
+                            "error: missing function name to '--exec'");
+                  return;
+               end if;
+               Exec_Func := new String'(Argument (I + 1));
+               I := I + 2;
+            elsif Arg = "-g" then
+               Flag_Debug := Debug_Dwarf;
+               I := I + 1;
+            elsif Arg = "-p" or Arg = "-pg" then
+               Flag_Profile := True;
+               I := I + 1;
+            else
+               --  This is really an argument.
+               Opt := new String'(Arg);
+               if I < Argument_Count then
+                  Opt_Arg := new String'(Argument (I + 1));
+               else
+                  Opt_Arg := null;
+               end if;
+               Res := Ortho_Front.Decode_Option (Opt, Opt_Arg);
+               case Res is
+                  when 0 =>
+                     Put_Line (Standard_Error, "unknown option '" & Arg & "'");
+                     return;
+                  when 1 =>
+                     I := I + 1;
+                  when 2 =>
+                     I := I + 2;
+                  when others =>
+                     raise Program_Error;
+               end case;
+               Unchecked_Deallocation (Opt);
+               Unchecked_Deallocation (Opt_Arg);
+            end if;
+         else
+            First_File := I;
+            exit;
+         end if;
+      end;
+   end loop;
+
+   Ortho_Mcode.Init;
+
+   Set_Exit_Status (Failure);
+
+   if First_File > Argument_Count then
+      begin
+         if not Parse (null) then
+            return;
+         end if;
+      exception
+         when others =>
+            return;
+      end;
+   else
+      for I in First_File .. Argument_Count loop
+         Filename := new String'(Argument (First_File));
+         begin
+            if not Parse (Filename) then
+               return;
+            end if;
+         exception
+            when others =>
+               return;
+         end;
+      end loop;
+   end if;
+
+   Ortho_Mcode.Finish;
+
+   if Ortho_Code.Debug.Flag_Debug_Hli then
+      Set_Exit_Status (Success);
+      return;
+   end if;
+
+   if Output /= null then
+      Fd := Create_File (Output.all, Binary);
+      if Fd /= Invalid_FD then
+         case Format is
+            when Format_Elf =>
+               Binary_File.Elf.Write_Elf (Fd);
+            when Format_Coff =>
+               Binary_File.Coff.Write_Coff (Fd);
+         end case;
+         Close (Fd);
+      end if;
+   elsif Exec_Func /= null then
+      declare
+         Sym : Symbol;
+
+         type Func_Acc is access function return Integer;
+         function Conv is new Ada.Unchecked_Conversion
+           (Source => Pc_Type, Target => Func_Acc);
+         F : Func_Acc;
+         V : Integer;
+         Err : Boolean;
+      begin
+         Binary_File.Memory.Write_Memory_Init;
+         Binary_File.Memory.Write_Memory_Relocate (Err);
+         if Err then
+            return;
+         end if;
+         Sym := Binary_File.Get_Symbol (Exec_Func.all);
+         if Sym = Null_Symbol then
+            Put_Line (Standard_Error, "no '" & Exec_Func.all & "' symbol");
+         else
+            F := Conv (Get_Symbol_Vaddr (Sym));
+            V := F.all;
+            Put_Line ("Result is " & Integer'Image (V));
+         end if;
+      end;
+   end if;
+
+   Set_Exit_Status (Success);
+exception
+   when others =>
+      Set_Exit_Status (2);
+      raise;
+end Ortho_Code_Main;
+
+
diff --git a/src/ortho/mcode/ortho_ident.adb b/src/ortho/mcode/ortho_ident.adb
new file mode 100644
index 000000000..0893b75dd
--- /dev/null
+++ b/src/ortho/mcode/ortho_ident.adb
@@ -0,0 +1,117 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 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 Ada.Text_IO;
+with GNAT.Table;
+
+package body Ortho_Ident is
+   package Ids is new GNAT.Table
+     (Table_Component_Type => Natural,
+      Table_Index_Type => O_Ident,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package Strs is new GNAT.Table
+     (Table_Component_Type => Character,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Start : Natural;
+   begin
+      Start := Strs.Allocate (Str'Length + 1);
+      for I in Str'Range loop
+         Strs.Table (Start + I - Str'First) := Str (I);
+      end loop;
+      Strs.Table (Start + Str'Length) := ASCII.Nul;
+      Ids.Append (Start);
+      return Ids.Last;
+   end Get_Identifier;
+
+   function Is_Equal (L, R : O_Ident) return Boolean
+   is
+   begin
+      return L = R;
+   end Is_Equal;
+
+   function Get_String_Length (Id : O_Ident) return Natural
+   is
+      Start : Natural;
+   begin
+      Start := Ids.Table (Id);
+      if Id = Ids.Last then
+         return Strs.Last - Start + 1 - 1;
+      else
+         return Ids.Table (Id + 1) - 1 - Start;
+      end if;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Res : String (1 .. Get_String_Length (Id));
+      Start : constant Natural := Ids.Table (Id);
+   begin
+      for I in Res'Range loop
+         Res (I) := Strs.Table (Start + I - Res'First);
+      end loop;
+      return Res;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Strs.Table (Ids.Table (Id))'Address;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Start : constant Natural := Ids.Table (Id);
+      Len : constant Natural := Get_String_Length (Id);
+   begin
+      if Len /= Str'Length then
+         return False;
+      end if;
+      for I in Str'Range loop
+         if Str (I) /= Strs.Table (Start + I - Str'First) then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Ident: " & O_Ident'Image (Ids.Last));
+      Put_Line ("Number of Ident-Strs: " & Natural'Image (Strs.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Ids.Free;
+      Strs.Free;
+   end Finish;
+end Ortho_Ident;
diff --git a/src/ortho/mcode/ortho_ident.ads b/src/ortho/mcode/ortho_ident.ads
new file mode 100644
index 000000000..cdc42fcad
--- /dev/null
+++ b/src/ortho/mcode/ortho_ident.ads
@@ -0,0 +1,38 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 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 Ortho_Code; use Ortho_Code;
+
+package Ortho_Ident is
+   subtype O_Ident is Ortho_Code.O_Ident;
+
+   function Get_Identifier (Str : String) return O_Ident;
+   function Is_Equal (L, R : O_Ident) return Boolean;
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean;
+   function Is_Nul (Id : O_Ident) return Boolean;
+   function Get_String (Id : O_Ident) return String;
+   function Get_String_Length (Id : O_Ident) return Natural;
+
+   --  Note: the address is valid until the next call to get_identifier.
+   function Get_Cstring (Id : O_Ident) return System.Address;
+
+   O_Ident_Nul : constant O_Ident := Ortho_Code.O_Ident_Nul;
+
+   procedure Disp_Stats;
+   procedure Finish;
+end Ortho_Ident;
diff --git a/src/ortho/mcode/ortho_jit.adb b/src/ortho/mcode/ortho_jit.adb
new file mode 100644
index 000000000..7aa9724f2
--- /dev/null
+++ b/src/ortho/mcode/ortho_jit.adb
@@ -0,0 +1,125 @@
+--  Ortho JIT implementation for mcode.
+--  Copyright (C) 2009 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO;
+
+with Binary_File; use Binary_File;
+with Binary_File.Memory;
+with Ortho_Mcode; use Ortho_Mcode;
+with Ortho_Mcode.Jit;
+with Ortho_Code.Flags; use Ortho_Code.Flags;
+with Ortho_Code.Debug;
+with Ortho_Code.Abi;
+with Binary_File.Elf;
+
+package body Ortho_Jit is
+   Snap_Filename : GNAT.OS_Lib.String_Access := null;
+
+   --  Initialize the whole engine.
+   procedure Init is
+   begin
+      Ortho_Mcode.Init;
+      Binary_File.Memory.Write_Memory_Init;
+   end Init;
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+     renames Ortho_Mcode.Jit.Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+     renames Ortho_Mcode.Jit.Get_Address;
+
+   --  Do link.
+   procedure Link (Status : out Boolean) is
+   begin
+      if Ortho_Code.Debug.Flag_Debug_Hli then
+         --  Can't generate code in HLI.
+         Status := True;
+         return;
+      end if;
+
+      Ortho_Mcode.Finish;
+
+      Ortho_Code.Abi.Link_Intrinsics;
+
+      Binary_File.Memory.Write_Memory_Relocate (Status);
+      if Status then
+         return;
+      end if;
+
+      if Snap_Filename /= null then
+         declare
+            use Ada.Text_IO;
+            Fd : File_Descriptor;
+         begin
+            Fd := Create_File (Snap_Filename.all, Binary);
+            if Fd = Invalid_FD then
+               Put_Line (Standard_Error,
+                         "can't open '" & Snap_Filename.all & "'");
+               Status := False;
+               return;
+            else
+               Binary_File.Elf.Write_Elf (Fd);
+               Close (Fd);
+            end if;
+         end;
+      end if;
+   end Link;
+
+   procedure Finish is
+   begin
+      --  Free all the memory.
+      Ortho_Mcode.Free_All;
+
+      Binary_File.Finish;
+   end Finish;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt = "-g" then
+         Flag_Debug := Debug_Dwarf;
+         return True;
+      elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then
+         Ortho_Code.Debug.Set_Be_Flag (Opt);
+         return True;
+      elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then
+         Snap_Filename := new String'(Opt (8 .. Opt'Last));
+         return True;
+      else
+         return False;
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Help is
+      use Ada.Text_IO;
+   begin
+      Put_Line (" -g             Generate debugging informations");
+      Put_Line (" --debug-be=X   Set X internal debugging flags");
+      Put_Line (" --snap=FILE    Write memory snapshot to FILE");
+   end Disp_Help;
+
+   function Get_Jit_Name return String is
+   begin
+      return "mcode";
+   end Get_Jit_Name;
+
+end Ortho_Jit;
diff --git a/src/ortho/mcode/ortho_mcode-jit.adb b/src/ortho/mcode/ortho_mcode-jit.adb
new file mode 100644
index 000000000..7e845cc6e
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode-jit.adb
@@ -0,0 +1,28 @@
+with Ada.Unchecked_Conversion;
+
+with Ortho_Code.Binary;
+with Binary_File; use Binary_File;
+with Binary_File.Memory;
+
+package body Ortho_Mcode.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address)
+   is
+      use Ortho_Code.Binary;
+   begin
+      Binary_File.Memory.Set_Symbol_Address
+        (Get_Decl_Symbol (Ortho_Code.O_Dnode (Decl)), Addr);
+   end Set_Address;
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address
+   is
+      use Ortho_Code.Binary;
+
+      function Conv is new Ada.Unchecked_Conversion
+        (Source => Pc_Type, Target => Address);
+   begin
+      return Conv (Get_Symbol_Vaddr
+                     (Get_Decl_Symbol (Ortho_Code.O_Dnode (Decl))));
+   end Get_Address;
+end Ortho_Mcode.Jit;
diff --git a/src/ortho/mcode/ortho_mcode-jit.ads b/src/ortho/mcode/ortho_mcode-jit.ads
new file mode 100644
index 000000000..c689a1e12
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode-jit.ads
@@ -0,0 +1,9 @@
+with System; use System;
+
+package Ortho_Mcode.Jit is
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+end Ortho_Mcode.Jit;
diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb
new file mode 100644
index 000000000..55e890bf3
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.adb
@@ -0,0 +1,738 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 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 Ada.Text_IO;
+with Ortho_Code.Debug;
+with Ortho_Ident;
+with Ortho_Code.Abi;
+-- with Binary_File;
+
+package body Ortho_Mcode is
+   procedure New_Debug_Comment_Stmt (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Stmt;
+
+   procedure Start_Const_Value (Const : in out O_Dnode)
+   is
+      pragma Unreferenced (Const);
+   begin
+      null;
+   end Start_Const_Value;
+
+   procedure Start_Record_Type (Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Record_Type
+        (Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Record_Type;
+
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Record_Field
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Fnode (El), Ident, Ortho_Code.O_Tnode (Etype));
+   end New_Record_Field;
+
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Record_Type
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Tnode (Res));
+   end Finish_Record_Type;
+
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Uncomplete_Record_Type (Ortho_Code.O_Tnode (Res));
+   end New_Uncomplete_Record_Type;
+
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Uncomplete_Record_Type
+        (Ortho_Code.O_Tnode (Res),
+         Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Uncomplete_Record_Type;
+
+   procedure Start_Union_Type (Elements : out O_Element_List) is
+   begin
+      Ortho_Code.Types.Start_Union_Type
+        (Ortho_Code.Types.O_Element_List (Elements));
+   end Start_Union_Type;
+
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode) is
+   begin
+      Ortho_Code.Types.New_Union_Field
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Fnode (El),
+         Ident,
+         Ortho_Code.O_Tnode (Etype));
+   end New_Union_Field;
+
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Union_Type
+        (Ortho_Code.Types.O_Element_List (Elements),
+         Ortho_Code.O_Tnode (Res));
+   end Finish_Union_Type;
+
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode is
+   begin
+      return O_Tnode
+        (Ortho_Code.Types.New_Access_Type (Ortho_Code.O_Tnode (Dtype)));
+   end New_Access_Type;
+
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Access_Type (Ortho_Code.O_Tnode (Atype),
+                                           Ortho_Code.O_Tnode (Dtype));
+   end Finish_Access_Type;
+
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode)
+   is
+      pragma Warnings (Off, Const);
+   begin
+      New_Const_Value (Ortho_Code.O_Dnode (Const), Ortho_Code.O_Cnode (Val));
+   end Finish_Const_Value;
+
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+                           return O_Tnode is
+   begin
+      return O_Tnode
+        (Ortho_Code.Types.New_Array_Type (Ortho_Code.O_Tnode (El_Type),
+                                          Ortho_Code.O_Tnode (Index_Type)));
+   end New_Array_Type;
+
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+                                       return O_Tnode
+   is
+      Len : constant Ortho_Code.O_Cnode := Ortho_Code.O_Cnode (Length);
+      L_Type : Ortho_Code.O_Tnode;
+   begin
+      L_Type := Get_Const_Type (Len);
+      if Get_Type_Kind (L_Type) /= OT_Unsigned then
+         raise Syntax_Error;
+      end if;
+      return O_Tnode (New_Constrained_Array_Type
+                        (Ortho_Code.O_Tnode (Atype), Get_Const_U32 (Len)));
+   end New_Constrained_Array_Type;
+
+   function New_Unsigned_Type (Size : Natural) return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Unsigned_Type (Size));
+   end New_Unsigned_Type;
+
+   function New_Signed_Type (Size : Natural) return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Signed_Type (Size));
+   end New_Signed_Type;
+
+   function New_Float_Type return O_Tnode is
+   begin
+      return O_Tnode (Ortho_Code.Types.New_Float_Type);
+   end New_Float_Type;
+
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode) is
+   begin
+      Ortho_Code.Types.New_Boolean_Type (Ortho_Code.O_Tnode (Res),
+                                         False_Id,
+                                         Ortho_Code.O_Cnode (False_E),
+                                         True_Id,
+                                         Ortho_Code.O_Cnode (True_E));
+   end New_Boolean_Type;
+
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural) is
+   begin
+      Ortho_Code.Types.Start_Enum_Type (Ortho_Code.Types.O_Enum_List (List),
+                                        Size);
+   end Start_Enum_Type;
+
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode) is
+   begin
+      Ortho_Code.Types.New_Enum_Literal (Ortho_Code.Types.O_Enum_List (List),
+                                         Ident, Ortho_Code.O_Cnode (Res));
+   end New_Enum_Literal;
+
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode) is
+   begin
+      Ortho_Code.Types.Finish_Enum_Type (Ortho_Code.Types.O_Enum_List (List),
+                                         Ortho_Code.O_Tnode (Res));
+   end Finish_Enum_Type;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   To_Op : constant array (ON_Op_Kind) of Ortho_Code.ON_Op_Kind :=
+     (
+      ON_Nil => ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov => ON_Add_Ov,
+      ON_Sub_Ov => ON_Sub_Ov,
+      ON_Mul_Ov => ON_Mul_Ov,
+      ON_Div_Ov => ON_Div_Ov,
+      ON_Rem_Ov => ON_Rem_Ov,
+      ON_Mod_Ov => ON_Mod_Ov,
+
+      --  Binary operations.
+      ON_And => ON_And,
+      ON_Or => ON_Or,
+      ON_Xor => ON_Xor,
+
+      --  Monadic operations.
+      ON_Not => ON_Not,
+      ON_Neg_Ov => ON_Neg_Ov,
+      ON_Abs_Ov => ON_Abs_Ov,
+
+      --  Comparaisons
+      ON_Eq => ON_Eq,
+      ON_Neq => ON_Neq,
+      ON_Le => ON_Le,
+      ON_Lt => ON_Lt,
+      ON_Ge => ON_Ge,
+      ON_Gt => ON_Gt
+     );
+
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+                               return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Signed_Literal (Ortho_Code.O_Tnode (Ltype),
+                                               Value));
+   end New_Signed_Literal;
+
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+                                 return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Unsigned_Literal (Ortho_Code.O_Tnode (Ltype),
+                                                 Value));
+   end New_Unsigned_Literal;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+                              return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Float_Literal (Ortho_Code.O_Tnode (Ltype),
+                                              Value));
+   end New_Float_Literal;
+
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Null_Access (Ortho_Code.O_Tnode (Ltype)));
+   end New_Null_Access;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode) is
+   begin
+      Ortho_Code.Consts.Start_Record_Aggr
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Tnode (Atype));
+   end Start_Record_Aggr;
+
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode) is
+   begin
+      Ortho_Code.Consts.New_Record_Aggr_El
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Cnode (Value));
+   end New_Record_Aggr_El;
+
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode) is
+   begin
+      Ortho_Code.Consts.Finish_Record_Aggr
+        (Ortho_Code.Consts.O_Record_Aggr_List (List),
+         Ortho_Code.O_Cnode (Res));
+   end Finish_Record_Aggr;
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode)
+   is
+   begin
+      Ortho_Code.Consts.Start_Array_Aggr
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Tnode (Atype));
+   end Start_Array_Aggr;
+
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode) is
+   begin
+      Ortho_Code.Consts.New_Array_Aggr_El
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Cnode (Value));
+   end New_Array_Aggr_El;
+
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode) is
+   begin
+      Ortho_Code.Consts.Finish_Array_Aggr
+        (Ortho_Code.Consts.O_Array_Aggr_List (List),
+         Ortho_Code.O_Cnode (Res));
+   end Finish_Array_Aggr;
+
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Union_Aggr (Ortho_Code.O_Tnode (Atype),
+                                           Ortho_Code.O_Fnode (Field),
+                                           Ortho_Code.O_Cnode (Value)));
+   end New_Union_Aggr;
+
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Sizeof (Ortho_Code.O_Tnode (Atype),
+                                       Ortho_Code.O_Tnode (Rtype)));
+   end New_Sizeof;
+
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Alignof (Ortho_Code.O_Tnode (Atype),
+                                        Ortho_Code.O_Tnode (Rtype)));
+   end New_Alignof;
+
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Offsetof (Ortho_Code.O_Tnode (Atype),
+                                         Ortho_Code.O_Fnode (Field),
+                                         Ortho_Code.O_Tnode (Rtype)));
+   end New_Offsetof;
+
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+                                   return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Subprogram_Address
+           (Ortho_Code.O_Dnode (Subprg), Ortho_Code.O_Tnode (Atype)));
+   end New_Subprogram_Address;
+
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Global_Address
+           (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype)));
+   end New_Global_Address;
+
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+                                         return O_Cnode is
+   begin
+      return O_Cnode
+        (Ortho_Code.Consts.New_Global_Unchecked_Address
+           (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype)));
+   end New_Global_Unchecked_Address;
+
+   function New_Lit (Lit : O_Cnode) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Lit (Ortho_Code.O_Cnode (Lit)));
+   end New_Lit;
+
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+                          return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Dyadic_Op (To_Op (Kind),
+                                         Ortho_Code.O_Enode (Left),
+                                         Ortho_Code.O_Enode (Right)));
+   end New_Dyadic_Op;
+
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+                           return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Monadic_Op (To_Op (Kind),
+                                          Ortho_Code.O_Enode (Operand)));
+   end New_Monadic_Op;
+
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Compare_Op (To_Op (Kind),
+                                          Ortho_Code.O_Enode (Left),
+                                          Ortho_Code.O_Enode (Right),
+                                          Ortho_Code.O_Tnode (Ntype)));
+   end New_Compare_Op;
+
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+                                return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Indexed_Element (Ortho_Code.O_Lnode (Arr),
+                                               Ortho_Code.O_Enode (Index)));
+   end New_Indexed_Element;
+
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+                      return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Slice (Ortho_Code.O_Lnode (Arr),
+                                     Ortho_Code.O_Tnode (Res_Type),
+                                     Ortho_Code.O_Enode (Index)));
+   end New_Slice;
+
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+                                 return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Selected_Element (Ortho_Code.O_Lnode (Rec),
+                                                Ortho_Code.O_Fnode (El)));
+   end New_Selected_Element;
+
+   function New_Access_Element (Acc : O_Enode) return O_Lnode is
+   begin
+      return O_Lnode
+        (Ortho_Code.Exprs.New_Access_Element (Ortho_Code.O_Enode (Acc)));
+   end New_Access_Element;
+
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Convert_Ov (Ortho_Code.O_Enode (Val),
+                                          Ortho_Code.O_Tnode (Rtype)));
+   end New_Convert_Ov;
+
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                        return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Address (Ortho_Code.O_Lnode (Lvalue),
+                                       Ortho_Code.O_Tnode (Atype)));
+   end New_Address;
+
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+                                  return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Unchecked_Address (Ortho_Code.O_Lnode (Lvalue),
+                                                 Ortho_Code.O_Tnode (Atype)));
+   end New_Unchecked_Address;
+
+   function New_Value (Lvalue : O_Lnode) return O_Enode is
+   begin
+      return O_Enode
+        (Ortho_Code.Exprs.New_Value (Ortho_Code.O_Lnode (Lvalue)));
+   end New_Value;
+
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode is
+   begin
+      return New_Value (New_Obj (Obj));
+   end New_Obj_Value;
+
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Alloca (Ortho_Code.O_Tnode (Rtype),
+                                                   Ortho_Code.O_Enode (Size)));
+   end New_Alloca;
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   procedure New_Debug_Filename_Decl (Filename : String)
+     renames Ortho_Code.Abi.New_Debug_Filename_Decl;
+
+   procedure New_Debug_Line_Decl (Line : Natural)
+   is
+      pragma Unreferenced (Line);
+   begin
+      null;
+   end New_Debug_Line_Decl;
+
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Type_Decl (Ident, Ortho_Code.O_Tnode (Atype));
+   end New_Type_Decl;
+
+   To_Storage : constant array (O_Storage) of Ortho_Code.O_Storage :=
+     (O_Storage_External => O_Storage_External,
+      O_Storage_Public => O_Storage_Public,
+      O_Storage_Private => O_Storage_Private,
+      O_Storage_Local => O_Storage_Local);
+
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Const_Decl
+        (Ortho_Code.O_Dnode (Res), Ident, To_Storage (Storage),
+         Ortho_Code.O_Tnode (Atype));
+   end New_Const_Decl;
+
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Var_Decl
+        (Ortho_Code.O_Dnode (Res), Ident, To_Storage (Storage),
+         Ortho_Code.O_Tnode (Atype));
+   end New_Var_Decl;
+
+   function New_Obj (Obj : O_Dnode) return O_Lnode is
+   begin
+      return O_Lnode (Ortho_Code.Exprs.New_Obj (Ortho_Code.O_Dnode (Obj)));
+   end New_Obj;
+
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.Start_Function_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ident, To_Storage (Storage), Ortho_Code.O_Tnode (Rtype));
+   end Start_Function_Decl;
+
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage) is
+   begin
+      Ortho_Code.Decls.Start_Procedure_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ident, To_Storage (Storage));
+   end Start_Procedure_Decl;
+
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode) is
+   begin
+      Ortho_Code.Decls.New_Interface_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces),
+         Ortho_Code.O_Dnode (Res),
+         Ident,
+         Ortho_Code.O_Tnode (Atype));
+   end New_Interface_Decl;
+
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode) is
+   begin
+      Ortho_Code.Decls.Finish_Subprogram_Decl
+        (Ortho_Code.Decls.O_Inter_List (Interfaces), Ortho_Code.O_Dnode (Res));
+   end Finish_Subprogram_Decl;
+
+   procedure Start_Subprogram_Body (Func : O_Dnode) is
+   begin
+      Ortho_Code.Exprs.Start_Subprogram_Body (Ortho_Code.O_Dnode (Func));
+   end Start_Subprogram_Body;
+
+   procedure Finish_Subprogram_Body
+     renames Ortho_Code.Exprs.Finish_Subprogram_Body;
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   procedure New_Debug_Line_Stmt (Line : Natural)
+     renames Ortho_Code.Exprs.New_Debug_Line_Stmt;
+
+   procedure New_Debug_Comment_Decl (Comment : String)
+   is
+      pragma Unreferenced (Comment);
+   begin
+      null;
+   end New_Debug_Comment_Decl;
+
+   procedure Start_Declare_Stmt renames
+     Ortho_Code.Exprs.Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt renames
+     Ortho_Code.Exprs.Finish_Declare_Stmt;
+
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode) is
+   begin
+      Ortho_Code.Exprs.Start_Association
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs), Ortho_Code.O_Dnode (Subprg));
+   end Start_Association;
+
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Association
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs), Ortho_Code.O_Enode (Val));
+   end New_Association;
+
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode is
+   begin
+      return O_Enode (Ortho_Code.Exprs.New_Function_Call
+                        (Ortho_Code.Exprs.O_Assoc_List (Assocs)));
+   end New_Function_Call;
+
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List) is
+   begin
+      Ortho_Code.Exprs.New_Procedure_Call
+        (Ortho_Code.Exprs.O_Assoc_List (Assocs));
+   end New_Procedure_Call;
+
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Assign_Stmt (Ortho_Code.O_Lnode (Target),
+                                        Ortho_Code.O_Enode (Value));
+   end New_Assign_Stmt;
+
+   procedure New_Return_Stmt (Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.New_Return_Stmt (Ortho_Code.O_Enode (Value));
+   end New_Return_Stmt;
+
+   procedure New_Return_Stmt
+     renames Ortho_Code.Exprs.New_Return_Stmt;
+
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode) is
+   begin
+      Ortho_Code.Exprs.Start_If_Stmt (Ortho_Code.Exprs.O_If_Block (Block),
+                                      Ortho_Code.O_Enode (Cond));
+   end Start_If_Stmt;
+
+   procedure New_Else_Stmt (Block : in out O_If_Block) is
+   begin
+      Ortho_Code.Exprs.New_Else_Stmt (Ortho_Code.Exprs.O_If_Block (Block));
+   end New_Else_Stmt;
+
+   procedure Finish_If_Stmt (Block : in out O_If_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_If_Stmt (Ortho_Code.Exprs.O_If_Block (Block));
+   end Finish_If_Stmt;
+
+   procedure Start_Loop_Stmt (Label : out O_Snode) is
+   begin
+      Ortho_Code.Exprs.Start_Loop_Stmt (Ortho_Code.Exprs.O_Snode (Label));
+   end Start_Loop_Stmt;
+
+   procedure Finish_Loop_Stmt (Label : in out O_Snode) is
+   begin
+      Ortho_Code.Exprs.Finish_Loop_Stmt (Ortho_Code.Exprs.O_Snode (Label));
+   end Finish_Loop_Stmt;
+
+   procedure New_Exit_Stmt (L : O_Snode) is
+   begin
+      Ortho_Code.Exprs.New_Exit_Stmt (Ortho_Code.Exprs.O_Snode (L));
+   end New_Exit_Stmt;
+
+   procedure New_Next_Stmt (L : O_Snode) is
+   begin
+      Ortho_Code.Exprs.New_Next_Stmt (Ortho_Code.Exprs.O_Snode (L));
+   end New_Next_Stmt;
+
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode) is
+   begin
+      Ortho_Code.Exprs.Start_Case_Stmt
+        (Ortho_Code.Exprs.O_Case_Block (Block), Ortho_Code.O_Enode (Value));
+   end Start_Case_Stmt;
+
+   procedure Start_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Start_Choice (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Start_Choice;
+
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode) is
+   begin
+      Ortho_Code.Exprs.New_Expr_Choice (Ortho_Code.Exprs.O_Case_Block (Block),
+                                        Ortho_Code.O_Cnode (Expr));
+   end New_Expr_Choice;
+
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode) is
+   begin
+      Ortho_Code.Exprs.New_Range_Choice
+        (Ortho_Code.Exprs.O_Case_Block (Block),
+         Ortho_Code.O_Cnode (Low), Ortho_Code.O_Cnode (High));
+   end New_Range_Choice;
+
+   procedure New_Default_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.New_Default_Choice
+        (Ortho_Code.Exprs.O_Case_Block (Block));
+   end New_Default_Choice;
+
+   procedure Finish_Choice (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_Choice (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Finish_Choice;
+
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block) is
+   begin
+      Ortho_Code.Exprs.Finish_Case_Stmt
+        (Ortho_Code.Exprs.O_Case_Block (Block));
+   end Finish_Case_Stmt;
+
+   procedure Init is
+   begin
+      --  Create an anonymous pointer type.
+      if New_Access_Type (O_Tnode_Null) /= O_Tnode (O_Tnode_Ptr) then
+         raise Program_Error;
+      end if;
+      --  Do not finish the access, since this creates an infinite recursion
+      --  in gdb (at least for GDB 6.3).
+      --Finish_Access_Type (O_Tnode_Ptr, O_Tnode_Ptr);
+      Ortho_Code.Abi.Init;
+   end Init;
+
+   procedure Finish is
+   begin
+      if False then
+         Ortho_Code.Decls.Disp_All_Decls;
+         --Ortho_Code.Exprs.Disp_All_Enode;
+      end if;
+      Ortho_Code.Abi.Finish;
+      if Debug.Flag_Debug_Stat then
+         Ada.Text_IO.Put_Line ("Statistics:");
+         Ortho_Code.Exprs.Disp_Stats;
+         Ortho_Code.Decls.Disp_Stats;
+         Ortho_Code.Types.Disp_Stats;
+         Ortho_Code.Consts.Disp_Stats;
+         Ortho_Ident.Disp_Stats;
+         -- Binary_File.Disp_Stats;
+      end if;
+   end Finish;
+
+   procedure Free_All is
+   begin
+      Ortho_Code.Types.Finish;
+      Ortho_Code.Exprs.Finish;
+      Ortho_Code.Consts.Finish;
+      Ortho_Code.Decls.Finish;
+      Ortho_Ident.Finish;
+   end Free_All;
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads
new file mode 100644
index 000000000..45e803690
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.ads
@@ -0,0 +1,583 @@
+--  DO NOT MODIFY - this file was generated from:
+--  ortho_nodes.common.ads and ortho_mcode.private.ads
+--
+--  Mcode back-end for ortho.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with Ortho_Code; use Ortho_Code;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+--  Interface to create nodes.
+package Ortho_Mcode is
+   --  Initialize nodes.
+   procedure Init;
+   procedure Finish;
+
+   procedure Free_All;
+
+--  Start of common part
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+--  End of common part
+private
+   --  MCode supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   type O_Tnode is new Ortho_Code.O_Tnode;
+   type O_Cnode is new Ortho_Code.O_Cnode;
+   type O_Dnode is new Ortho_Code.O_Dnode;
+   type O_Enode is new Ortho_Code.O_Enode;
+   type O_Fnode is new Ortho_Code.O_Fnode;
+   type O_Lnode is new Ortho_Code.O_Lnode;
+   type O_Snode is new Ortho_Code.Exprs.O_Snode;
+
+   O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null);
+   O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null);
+   O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (Ortho_Code.O_Fnode_Null);
+   O_Snode_Null : constant O_Snode := O_Snode (Ortho_Code.Exprs.O_Snode_Null);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (Ortho_Code.O_Tnode_Null);
+
+   type O_Element_List is new Ortho_Code.Types.O_Element_List;
+   type O_Enum_List    is new Ortho_Code.Types.O_Enum_List;
+   type O_Inter_List   is new Ortho_Code.Decls.O_Inter_List;
+   type O_Record_Aggr_List is new Ortho_Code.Consts.O_Record_Aggr_List;
+   type O_Array_Aggr_List is new Ortho_Code.Consts.O_Array_Aggr_List;
+   type O_Assoc_List is new Ortho_Code.Exprs.O_Assoc_List;
+   type O_If_Block   is new Ortho_Code.Exprs.O_If_Block;
+   type O_Case_Block is new Ortho_Code.Exprs.O_Case_Block;
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Dyadic_Op);
+   pragma Inline (New_Monadic_Op);
+   pragma Inline (New_Compare_Op);
+   pragma Inline (New_Signed_Literal);
+   pragma Inline (New_Unsigned_Literal);
+   pragma Inline (New_Float_Literal);
+   pragma Inline (New_Null_Access);
+
+   pragma Inline (Start_Record_Aggr);
+   pragma Inline (New_Record_Aggr_El);
+   pragma Inline (Finish_Record_Aggr);
+
+   pragma Inline (Start_Array_Aggr);
+   pragma Inline (New_Array_Aggr_El);
+   pragma Inline (Finish_Array_Aggr);
+
+   pragma Inline (New_Union_Aggr);
+   pragma Inline (New_Sizeof);
+   pragma Inline (New_Alignof);
+   pragma Inline (New_Offsetof);
+
+   pragma Inline (New_Indexed_Element);
+   pragma Inline (New_Slice);
+   pragma Inline (New_Selected_Element);
+   pragma Inline (New_Access_Element);
+
+   pragma Inline (New_Convert_Ov);
+
+   pragma Inline (New_Address);
+   pragma Inline (New_Global_Address);
+   pragma Inline (New_Unchecked_Address);
+   pragma Inline (New_Global_Unchecked_Address);
+   pragma Inline (New_Subprogram_Address);
+
+   pragma Inline (New_Value);
+   pragma Inline (New_Obj_Value);
+
+   pragma Inline (New_Alloca);
+
+   pragma Inline (New_Debug_Filename_Decl);
+   pragma Inline (New_Debug_Line_Decl);
+   pragma Inline (New_Debug_Comment_Decl);
+
+   pragma Inline (New_Type_Decl);
+   pragma Inline (New_Const_Decl);
+
+   pragma Inline (Start_Const_Value);
+   pragma Inline (Finish_Const_Value);
+   pragma Inline (New_Var_Decl);
+
+   pragma Inline (New_Obj);
+   pragma Inline (Start_Function_Decl);
+   pragma Inline (Start_Procedure_Decl);
+   pragma Inline (New_Interface_Decl);
+   pragma Inline (Finish_Subprogram_Decl);
+   pragma Inline (Start_Subprogram_Body);
+   pragma Inline (Finish_Subprogram_Body);
+
+   pragma Inline (New_Debug_Line_Stmt);
+   pragma Inline (New_Debug_Comment_Stmt);
+
+   pragma Inline (Start_Declare_Stmt);
+   pragma Inline (Finish_Declare_Stmt);
+
+   --  Create a function call or a procedure call.
+   pragma Inline (Start_Association);
+   pragma Inline (New_Association);
+   pragma Inline (New_Function_Call);
+   pragma Inline (New_Procedure_Call);
+
+   pragma Inline (New_Assign_Stmt);
+   pragma Inline (New_Return_Stmt);
+   pragma Inline (Start_If_Stmt);
+   pragma Inline (New_Else_Stmt);
+   pragma Inline (Finish_If_Stmt);
+
+   pragma Inline (Start_Loop_Stmt);
+   pragma Inline (Finish_Loop_Stmt);
+   pragma Inline (New_Exit_Stmt);
+   pragma Inline (New_Next_Stmt);
+
+   pragma Inline (Start_Case_Stmt);
+   pragma Inline (Start_Choice);
+   pragma Inline (New_Expr_Choice);
+   pragma Inline (New_Range_Choice);
+   pragma Inline (New_Default_Choice);
+   pragma Inline (Finish_Choice);
+   pragma Inline (Finish_Case_Stmt);
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_mcode.private.ads b/src/ortho/mcode/ortho_mcode.private.ads
new file mode 100644
index 000000000..1b414773f
--- /dev/null
+++ b/src/ortho/mcode/ortho_mcode.private.ads
@@ -0,0 +1,151 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 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 Interfaces; use Interfaces;
+with Ortho_Code; use Ortho_Code;
+with Ortho_Code.Types; use Ortho_Code.Types;
+with Ortho_Code.Consts; use Ortho_Code.Consts;
+with Ortho_Code.Decls; use Ortho_Code.Decls;
+with Ortho_Code.Exprs; use Ortho_Code.Exprs;
+
+--  Interface to create nodes.
+package Ortho_Mcode is
+   --  Initialize nodes.
+   procedure Init;
+   procedure Finish;
+
+   procedure Free_All;
+
+private
+   --  MCode supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean := True;
+
+   type O_Tnode is new Ortho_Code.O_Tnode;
+   type O_Cnode is new Ortho_Code.O_Cnode;
+   type O_Dnode is new Ortho_Code.O_Dnode;
+   type O_Enode is new Ortho_Code.O_Enode;
+   type O_Fnode is new Ortho_Code.O_Fnode;
+   type O_Lnode is new Ortho_Code.O_Lnode;
+   type O_Snode is new Ortho_Code.Exprs.O_Snode;
+
+   O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null);
+   O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null);
+   O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null);
+   O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null);
+   O_Fnode_Null : constant O_Fnode := O_Fnode (Ortho_Code.O_Fnode_Null);
+   O_Snode_Null : constant O_Snode := O_Snode (Ortho_Code.Exprs.O_Snode_Null);
+   O_Tnode_Null : constant O_Tnode := O_Tnode (Ortho_Code.O_Tnode_Null);
+
+   type O_Element_List is new Ortho_Code.Types.O_Element_List;
+   type O_Enum_List    is new Ortho_Code.Types.O_Enum_List;
+   type O_Inter_List   is new Ortho_Code.Decls.O_Inter_List;
+   type O_Record_Aggr_List is new Ortho_Code.Consts.O_Record_Aggr_List;
+   type O_Array_Aggr_List is new Ortho_Code.Consts.O_Array_Aggr_List;
+   type O_Assoc_List is new Ortho_Code.Exprs.O_Assoc_List;
+   type O_If_Block   is new Ortho_Code.Exprs.O_If_Block;
+   type O_Case_Block is new Ortho_Code.Exprs.O_Case_Block;
+
+   pragma Inline (New_Lit);
+   pragma Inline (New_Dyadic_Op);
+   pragma Inline (New_Monadic_Op);
+   pragma Inline (New_Compare_Op);
+   pragma Inline (New_Signed_Literal);
+   pragma Inline (New_Unsigned_Literal);
+   pragma Inline (New_Float_Literal);
+   pragma Inline (New_Null_Access);
+
+   pragma Inline (Start_Record_Aggr);
+   pragma Inline (New_Record_Aggr_El);
+   pragma Inline (Finish_Record_Aggr);
+
+   pragma Inline (Start_Array_Aggr);
+   pragma Inline (New_Array_Aggr_El);
+   pragma Inline (Finish_Array_Aggr);
+
+   pragma Inline (New_Union_Aggr);
+   pragma Inline (New_Sizeof);
+   pragma Inline (New_Alignof);
+   pragma Inline (New_Offsetof);
+
+   pragma Inline (New_Indexed_Element);
+   pragma Inline (New_Slice);
+   pragma Inline (New_Selected_Element);
+   pragma Inline (New_Access_Element);
+
+   pragma Inline (New_Convert_Ov);
+
+   pragma Inline (New_Address);
+   pragma Inline (New_Global_Address);
+   pragma Inline (New_Unchecked_Address);
+   pragma Inline (New_Global_Unchecked_Address);
+   pragma Inline (New_Subprogram_Address);
+
+   pragma Inline (New_Value);
+   pragma Inline (New_Obj_Value);
+
+   pragma Inline (New_Alloca);
+
+   pragma Inline (New_Debug_Filename_Decl);
+   pragma Inline (New_Debug_Line_Decl);
+   pragma Inline (New_Debug_Comment_Decl);
+
+   pragma Inline (New_Type_Decl);
+   pragma Inline (New_Const_Decl);
+
+   pragma Inline (Start_Const_Value);
+   pragma Inline (Finish_Const_Value);
+   pragma Inline (New_Var_Decl);
+
+   pragma Inline (New_Obj);
+   pragma Inline (Start_Function_Decl);
+   pragma Inline (Start_Procedure_Decl);
+   pragma Inline (New_Interface_Decl);
+   pragma Inline (Finish_Subprogram_Decl);
+   pragma Inline (Start_Subprogram_Body);
+   pragma Inline (Finish_Subprogram_Body);
+
+   pragma Inline (New_Debug_Line_Stmt);
+   pragma Inline (New_Debug_Comment_Stmt);
+
+   pragma Inline (Start_Declare_Stmt);
+   pragma Inline (Finish_Declare_Stmt);
+
+   --  Create a function call or a procedure call.
+   pragma Inline (Start_Association);
+   pragma Inline (New_Association);
+   pragma Inline (New_Function_Call);
+   pragma Inline (New_Procedure_Call);
+
+   pragma Inline (New_Assign_Stmt);
+   pragma Inline (New_Return_Stmt);
+   pragma Inline (Start_If_Stmt);
+   pragma Inline (New_Else_Stmt);
+   pragma Inline (Finish_If_Stmt);
+
+   pragma Inline (Start_Loop_Stmt);
+   pragma Inline (Finish_Loop_Stmt);
+   pragma Inline (New_Exit_Stmt);
+   pragma Inline (New_Next_Stmt);
+
+   pragma Inline (Start_Case_Stmt);
+   pragma Inline (Start_Choice);
+   pragma Inline (New_Expr_Choice);
+   pragma Inline (New_Range_Choice);
+   pragma Inline (New_Default_Choice);
+   pragma Inline (Finish_Choice);
+   pragma Inline (Finish_Case_Stmt);
+end Ortho_Mcode;
diff --git a/src/ortho/mcode/ortho_nodes.ads b/src/ortho/mcode/ortho_nodes.ads
new file mode 100644
index 000000000..7a2df3f30
--- /dev/null
+++ b/src/ortho/mcode/ortho_nodes.ads
@@ -0,0 +1,2 @@
+with Ortho_Mcode;
+package Ortho_Nodes renames Ortho_Mcode;
diff --git a/src/ortho/oread/Makefile b/src/ortho/oread/Makefile
new file mode 100644
index 000000000..f94535181
--- /dev/null
+++ b/src/ortho/oread/Makefile
@@ -0,0 +1,43 @@
+#  -*- Makefile -*- for the ortho-code compiler.
+#  Copyright (C) 2005 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.
+BE = gcc
+ortho_srcdir=..
+BACK_END=$(ortho_srcdir)/$(BE)
+ortho_exec=oread-$(BE)
+
+all: $(ortho_exec)
+
+test: test.s
+	$(CC) -o $@ $^
+
+test.s: $(ortho_exec)
+	./$(ortho_exec) test
+
+$(ortho_exec): force
+	$(MAKE) -f $(BACK_END)/Makefile ortho_exec=$(ortho_exec)
+
+clean:
+	$(MAKE) -f $(BACK_END)/Makefile clean
+	$(RM) -f oread-gcc oread-mcode *.o *~
+
+distclean: clean
+	$(MAKE) -f $(BACK_END)/Makefile distclean
+
+force:
+
+.PHONY: force
diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb
new file mode 100644
index 000000000..84bbd1b9d
--- /dev/null
+++ b/src/ortho/oread/ortho_front.adb
@@ -0,0 +1,2677 @@
+--  Ortho code compiler.
+--  Copyright (C) 2005 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 Ada.Unchecked_Deallocation;
+with Ortho_Nodes; use Ortho_Nodes;
+with Ortho_Ident; use Ortho_Ident;
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Interfaces; use Interfaces;
+with Ada.Exceptions;
+--with GNAT.Debug_Pools;
+
+--  TODO:
+--  uncomplete type: check for type redefinition
+
+package body Ortho_Front is
+   --  If true, emit line number before each statement.
+   --  If flase, keep line number indication in the source file.
+   Flag_Renumber : Boolean := True;
+
+   procedure Init is
+   begin
+      null;
+   end Init;
+
+   function Decode_Option (Opt : String_Acc; Arg : String_Acc) return Natural
+   is
+      pragma Unreferenced (Arg);
+   begin
+      if Opt.all = "-r" or Opt.all = "--ghdl-r" then
+         Flag_Renumber := True;
+         return 1;
+      else
+         return 0;
+      end if;
+   end Decode_Option;
+
+   --  File buffer.
+   File_Name : String_Acc;
+   Buf : String (1 .. 2048 + 1);
+   Buf_Len : Natural;
+   Pos : Natural;
+   Lineno : Natural;
+
+   Fd : File_Descriptor;
+
+   Error : exception;
+
+   procedure Puterr (Msg : String)
+   is
+      L : Integer;
+      pragma Unreferenced (L);
+   begin
+      L := Write (Standerr, Msg'Address, Msg'Length);
+   end Puterr;
+
+   procedure Puterr (N : Natural)
+   is
+      Str : constant String := Natural'Image (N);
+   begin
+      Puterr (Str (Str'First + 1 .. Str'Last));
+   end Puterr;
+
+   procedure Newline_Err is
+   begin
+      Puterr ((1 => LF));
+   end Newline_Err;
+
+   procedure Scan_Error (Msg : String) is
+   begin
+      Puterr (File_Name.all);
+      Puterr (":");
+      Puterr (Lineno);
+      Puterr (": ");
+      Puterr (Msg);
+      Newline_Err;
+      raise Error;
+   end Scan_Error;
+
+   procedure Parse_Error (Msg : String);
+   pragma No_Return (Parse_Error);
+
+   procedure Parse_Error (Msg : String) is
+   begin
+      Puterr (File_Name.all);
+      Puterr (":");
+      Puterr (Lineno);
+      Puterr (": ");
+      Puterr (Msg);
+      Newline_Err;
+      raise Error;
+   end Parse_Error;
+
+
+--    Uniq_Num : Natural := 0;
+
+--    function Get_Uniq_Id return O_Ident
+--    is
+--       Str : String (1 .. 8);
+--       V : Natural;
+--    begin
+--       V := Uniq_Num;
+--       Uniq_Num := Uniq_Num + 1;
+--       Str (1) := 'L';
+--       Str (2) := '.';
+--       for I in reverse 3 .. Str'Last loop
+--          Str (I) := Character'Val ((V mod 10) + Character'Pos('0'));
+--          V := V / 10;
+--       end loop;
+--       return Get_Identifier (Str);
+--    end Get_Uniq_Id;
+
+   --  Get the next character.
+   --  Return NUL on end of file.
+   function Get_Char return Character
+   is
+      Res : Character;
+   begin
+      if Buf (Pos) = NUL then
+         --  Read line.
+         Buf_Len := Read (Fd, Buf'Address, Buf'Length - 1);
+         if Buf_Len = 0 then
+            --  End of file.
+            return NUL;
+         end if;
+         Pos := 1;
+         Buf (Buf_Len + 1) := NUL;
+      end if;
+
+      Res := Buf (Pos);
+      Pos := Pos + 1;
+      return Res;
+   end Get_Char;
+
+   procedure Unget_Char is
+   begin
+      if Pos = Buf'First then
+         raise Program_Error;
+      end if;
+      Pos := Pos - 1;
+   end Unget_Char;
+
+   type Token_Type is
+      (Tok_Eof,
+       Tok_Line_Number, Tok_File_Name, Tok_Comment,
+       Tok_Ident, Tok_Num, Tok_String, Tok_Float_Num,
+       Tok_Plus, Tok_Minus,
+       Tok_Star, Tok_Div, Tok_Mod, Tok_Rem,
+       Tok_Sharp,
+       Tok_Not, Tok_Abs,
+       Tok_Or, Tok_And, Tok_Xor,
+       Tok_Equal, Tok_Not_Equal,
+       Tok_Greater, Tok_Greater_Eq,
+       Tok_Less, Tok_Less_Eq,
+       Tok_Colon, Tok_Semicolon,
+       Tok_Comma, Tok_Dot, Tok_Tick, Tok_Arob, Tok_Elipsis,
+       Tok_Assign,
+       Tok_Left_Paren, Tok_Right_Paren,
+       Tok_Left_Brace, Tok_Right_Brace,
+       Tok_Left_Brack, Tok_Right_Brack,
+       Tok_Unsigned, Tok_Signed, Tok_Float,
+       Tok_Array, Tok_Subarray,
+       Tok_Access, Tok_Record, Tok_Union,
+       Tok_Boolean, Tok_Enum,
+       Tok_If, Tok_Then, Tok_Else, Tok_Elsif,
+       Tok_Loop, Tok_Exit, Tok_Next,
+       Tok_Is, Tok_Of, Tok_All,
+       Tok_Return,
+       Tok_Type,
+       Tok_External, Tok_Private, Tok_Public, Tok_Local,
+       Tok_Procedure, Tok_Function,
+       Tok_Constant, Tok_Var,
+       Tok_Declare, Tok_Begin, Tok_End,
+       Tok_Case, Tok_When, Tok_Default, Tok_Arrow,
+       Tok_Null);
+
+   type Hash_Type is new Unsigned_32;
+
+   type Name_Type;
+   type Name_Acc is access Name_Type;
+
+   --  Symbol table.
+   type Syment_Type;
+   type Syment_Acc is access Syment_Type;
+   type Syment_type is record
+      --  The hash for the symbol.
+      Hash : Hash_Type;
+      --  Identification of the symbol.
+      Ident : O_Ident;
+      --  Next symbol with the same collision.
+      Next : Syment_Acc;
+      --  Meaning of the symbol.
+      Name : Name_Acc;
+   end record;
+
+   --  Well known identifiers (used for attributes).
+   Id_Address : Syment_Acc;
+   Id_Unchecked_Address : Syment_Acc;
+   Id_Subprg_Addr : Syment_Acc;
+   Id_Conv : Syment_Acc;
+   Id_Sizeof : Syment_Acc;
+   Id_Alignof : Syment_Acc;
+   Id_Alloca : Syment_Acc;
+   Id_Offsetof : Syment_Acc;
+
+   Token_Number : Unsigned_64;
+   Token_Float : IEEE_Float_64;
+   Token_Ident : String (1 .. 256);
+   Token_Idlen : Natural;
+   Token_Hash : Hash_Type;
+   Token_Sym : Syment_Acc;
+
+   --  The symbol table.
+   type Syment_Acc_Array is array (Hash_Type range <>) of Syment_Acc;
+   Hash_Max : constant Hash_Type := 511;
+   Symtable : Syment_Acc_Array (0 .. Hash_Max - 1) := (others => null);
+
+   type Node_Kind is (Decl_Keyword, Decl_Type, Decl_Param,
+                      Node_Function, Node_Procedure, Node_Object, Node_Field,
+                      Node_Lit,
+                      Type_Boolean, Type_Enum,
+                      Type_Unsigned, Type_Signed, Type_Float,
+                      Type_Array, Type_Subarray,
+                      Type_Access, Type_Record, Type_Union);
+   subtype Nodes_Subprogram is Node_Kind range Node_Function .. Node_Procedure;
+
+   type Node (<>);
+   type Node_Acc is access Node;
+   type Node (Kind : Node_Kind) is record
+      case Kind is
+         when Decl_Keyword =>
+            --  Keyword.
+            --  A keyword is not a declaration since the identifier has only
+            --  one meaning (the keyword).
+            Keyword : Token_Type;
+         when Decl_Type
+           | Decl_Param
+           | Node_Function
+           | Node_Procedure
+           | Node_Object
+           | Node_Lit =>
+            --  Declarations
+            --  All declarations but NODE_PROCEDURE have a type.
+            Decl_Dtype : Node_Acc;
+            Decl_Storage : O_Storage;
+            case Kind is
+               when Decl_Type =>
+                  --  Type declaration.
+                  null;
+               when Decl_Param =>
+                  --  Parameter identifier.
+                  Param_Name : Syment_Acc;
+                  --  Parameter ortho node.
+                  Param_Node : O_Dnode;
+                  --  Next parameter of the parameters list.
+                  Param_Next : Node_Acc;
+               when Node_Procedure
+                 | Node_Function =>
+                  --  Subprogram symbol name.
+                  Subprg_Name : Syment_Acc;
+                  --  List of parameters.
+                  Subprg_Params : Node_Acc;
+                  --  Subprogram ortho node.
+                  Subprg_Node : O_Dnode;
+               when Node_Object =>
+                  --  Name of the object (constant, variable).
+                  Obj_Name : O_Ident;
+                  --  Ortho node of the object.
+                  Obj_Node : O_Dnode;
+               when Node_Lit =>
+                  --  Name of the literal.
+                  Lit_Name : O_Ident;
+                  --  Enum literal
+                  Lit_Cnode : O_Cnode;
+                  --  Next literal for the type.
+                  Lit_Next : Node_Acc;
+               when others =>
+                  null;
+            end case;
+         when Node_Field =>
+            --  Record field.
+            Field_Ident : Syment_Acc;
+            Field_Fnode : O_Fnode;
+            Field_Type : Node_Acc;
+            Field_Next : Node_Acc;
+         when Type_Signed
+           | Type_Unsigned
+           | Type_Float
+           | Type_Array
+           | Type_Subarray
+           | Type_Record
+           | Type_Union
+           | Type_Access
+           | Type_Boolean
+           | Type_Enum =>
+            --  Ortho node type.
+            Type_Onode : O_Tnode;
+            case Kind is
+               when Type_Array =>
+                  Array_Index : Node_Acc;
+                  Array_Element : Node_Acc;
+               when Type_Subarray =>
+                  Subarray_Base : Node_Acc;
+                  --Subarray_Length : Natural;
+               when Type_Access =>
+                  Access_Dtype : Node_Acc;
+               when Type_Record
+                 | Type_Union =>
+                  Record_Union_Fields : Node_Acc;
+               when Type_Enum
+                 | Type_Boolean =>
+                  Enum_Lits : Node_Acc;
+               when Type_Float =>
+                  null;
+               when others =>
+                  null;
+            end case;
+      end case;
+   end record;
+
+   type Scope_Type;
+   type Scope_Acc is access Scope_Type;
+
+   type Name_Type is record
+      --  Current interpretation of the symbol.
+      Inter : Node_Acc;
+      --  Next declaration in the current scope.
+      Next : Syment_Acc;
+      --  Interpretation in a previous scope.
+      Up : Name_Acc;
+      --  Current scope.
+      Scope : Scope_Acc;
+   end record;
+
+   type Scope_Type is record
+      --  Simply linked list of names.
+      Names : Syment_Acc;
+      --  Previous scope.
+      Prev : Scope_Acc;
+   end record;
+
+   --  Return the current declaration for symbol SYM.
+   function Get_Decl (Sym : Syment_Acc) return Node_Acc;
+   pragma Inline (Get_Decl);
+
+   procedure Scan_Char (C : Character)
+   is
+      R : Character;
+   begin
+
+      if C = '\' then
+         R := Get_Char;
+         case R is
+            when 'n' =>
+               R := LF;
+            when 'r' =>
+               R := CR;
+            when ''' =>
+               R := ''';
+            when '"' => -- "
+               R := '"'; -- "
+            when others =>
+               Scan_Error ("bad character sequence \" & R);
+         end case;
+      else
+         R := C;
+      end if;
+      Token_Idlen := Token_Idlen + 1;
+      Token_Ident (Token_Idlen) := R;
+   end Scan_Char;
+
+   function Get_Hash (Str : String) return Hash_Type
+   is
+      Res : Hash_Type;
+   begin
+      Res := 0;
+      for I in Str'Range loop
+         Res := Res * 31 + Character'Pos (Str (I));
+      end loop;
+      return Res;
+   end Get_Hash;
+
+   --  Previous token.
+   Tok_Previous : Token_Type;
+
+   function Scan_Number (First_Char : Character) return Token_Type
+   is
+      function To_Digit (C : Character) return Integer is
+      begin
+         case C is
+            when '0' .. '9' =>
+               return Character'Pos (C) - Character'Pos ('0');
+            when 'A' .. 'F' =>
+               return Character'Pos (C) - Character'Pos ('A') + 10;
+            when 'a' .. 'f' =>
+               return Character'Pos (C) - Character'Pos ('a') + 10;
+            when others =>
+               return -1;
+         end case;
+      end To_Digit;
+
+      function Is_Digit (C : Character) return Boolean is
+      begin
+         case C is
+            when '0' .. '9'
+              | 'A' .. 'F'
+              | 'a' .. 'f' =>
+               return True;
+            when others =>
+               return False;
+         end case;
+      end Is_Digit;
+
+      After_Point : Integer;
+      C : Character;
+      Exp : Integer;
+      Exp_Neg : Boolean;
+      Base : Unsigned_64;
+   begin
+      Token_Number := 0;
+      C := First_Char;
+      loop
+         Token_Number := Token_Number * 10 + Unsigned_64 (To_Digit (C));
+         C := Get_Char;
+         exit when not Is_Digit (C);
+      end loop;
+      if C = '#' then
+         Base := Token_Number;
+         Token_Number := 0;
+         C := Get_Char;
+         loop
+            Token_Number := Token_Number * Base + Unsigned_64 (To_Digit (C));
+            C := Get_Char;
+            exit when C = '#';
+         end loop;
+         return Tok_Num;
+      end if;
+      if C = '.' then
+         -- A real number.
+         After_Point := 0;
+         Token_Float := IEEE_Float_64 (Token_Number);
+         loop
+            C := Get_Char;
+            exit when C not in '0' .. '9';
+            Token_Float := Token_Float * 10.0 + IEEE_Float_64 (To_Digit (C));
+            After_Point := After_Point + 1;
+         end loop;
+         if C = 'e' or C = 'E' then
+            Exp := 0;
+            C := Get_Char;
+            Exp_Neg := False;
+            if C = '-' then
+               Exp_Neg := True;
+               C := Get_Char;
+            elsif C = '+' then
+               C := Get_Char;
+            elsif not Is_Digit (C) then
+               Scan_Error ("digit expected");
+            end if;
+            while Is_Digit (C) loop
+               Exp := Exp * 10 + To_Digit (C);
+               C := Get_Char;
+            end loop;
+            if Exp_Neg then
+               Exp := -Exp;
+            end if;
+            Exp := Exp - After_Point;
+         else
+            Exp := - After_Point;
+         end if;
+         Unget_Char;
+         Token_Float := Token_Float * 10.0 ** Exp;
+         if Token_Float > IEEE_Float_64'Last then
+            Token_Float := IEEE_Float_64'Last;
+         end if;
+         return Tok_Float_Num;
+      else
+         Unget_Char;
+         return Tok_Num;
+      end if;
+   end Scan_Number;
+
+   procedure Scan_Comment
+   is
+      C : Character;
+   begin
+      Token_Idlen := 0;
+      loop
+         C := Get_Char;
+         exit when C = CR or C = LF;
+         Token_Idlen := Token_Idlen + 1;
+         Token_Ident (Token_Idlen) := C;
+      end loop;
+      Unget_Char;
+   end Scan_Comment;
+
+   --  Get the next token.
+   function Get_Token return Token_Type
+   is
+      C : Character;
+   begin
+      loop
+
+         C := Get_Char;
+         << Again >> null;
+         case C is
+            when NUL =>
+               return Tok_Eof;
+            when ' ' | HT =>
+               null;
+            when LF =>
+               Lineno := Lineno + 1;
+               C := Get_Char;
+               if C /= CR then
+                  goto Again;
+               end if;
+            when CR =>
+               Lineno := Lineno + 1;
+               C := Get_Char;
+               if C /= LF then
+                  goto Again;
+               end if;
+            when '+' =>
+               return Tok_Plus;
+            when '-' =>
+               C := Get_Char;
+               if C = '-' then
+                  C := Get_Char;
+                  if C = '#' then
+                     return Tok_Line_Number;
+                  elsif C = 'F' then
+                     Scan_Comment;
+                     return Tok_File_Name;
+                  elsif C = ' ' then
+                     Scan_Comment;
+                     return Tok_Comment;
+                  else
+                     Scan_Error ("bad comment");
+                  end if;
+               else
+                  Unget_Char;
+                  return Tok_Minus;
+               end if;
+            when '/' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Not_Equal;
+               else
+                  Unget_Char;
+                  return Tok_Div;
+               end if;
+            when '*' =>
+               return Tok_Star;
+            when '#' =>
+               return Tok_Sharp;
+            when '=' =>
+               C := Get_Char;
+               if C = '>' then
+                  return Tok_Arrow;
+               else
+                  Unget_Char;
+                  return Tok_Equal;
+               end if;
+            when '>' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Greater_Eq;
+               else
+                  Unget_Char;
+                  return Tok_Greater;
+               end if;
+            when '(' =>
+               return Tok_Left_Paren;
+            when ')' =>
+               return Tok_Right_Paren;
+            when '{' =>
+               return Tok_Left_Brace;
+            when '}' =>
+               return Tok_Right_Brace;
+            when '[' =>
+               return Tok_Left_Brack;
+            when ']' =>
+               return Tok_Right_Brack;
+            when '<' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Less_Eq;
+               else
+                  Unget_Char;
+                  return Tok_Less;
+               end if;
+            when ':' =>
+               C := Get_Char;
+               if C = '=' then
+                  return Tok_Assign;
+               else
+                  Unget_Char;
+                  return Tok_Colon;
+               end if;
+            when '.' =>
+               C := Get_Char;
+               if C = '.' then
+                  C := Get_Char;
+                  if C = '.' then
+                     return Tok_Elipsis;
+                  else
+                     Scan_Error ("'...' expected");
+                  end if;
+               else
+                  Unget_Char;
+                  return Tok_Dot;
+               end if;
+            when ';' =>
+               return Tok_Semicolon;
+            when ',' =>
+               return Tok_Comma;
+            when '@' =>
+               return Tok_Arob;
+            when ''' =>
+               if Tok_Previous = Tok_Ident then
+                  return Tok_Tick;
+               else
+                  Token_Number := Character'Pos (Get_Char);
+                  C := Get_Char;
+                  if C /= ''' then
+                     Scan_Error ("ending single quote expected");
+                  end if;
+                  return Tok_Num;
+               end if;
+            when '"' => -- "
+               --  Eat double quote.
+               C := Get_Char;
+               Token_Idlen := 0;
+               loop
+                  Scan_Char (C);
+                  C := Get_Char;
+                  exit when C = '"'; -- "
+               end loop;
+               return Tok_String;
+            when '0' .. '9' =>
+               return Scan_Number (C);
+            when 'a' .. 'z'
+              | 'A' .. 'Z'
+              | '_' =>
+               Token_Idlen := 0;
+               Token_Hash := 0;
+               loop
+                  Token_Idlen := Token_Idlen + 1;
+                  Token_Ident (Token_Idlen) := C;
+                  Token_Hash := Token_Hash * 31 + Character'Pos (C);
+                  C := Get_Char;
+                  exit when (C < 'A' or C > 'Z')
+                    and (C < 'a' or C > 'z')
+                    and (C < '0' or C > '9')
+                    and (C /= '_');
+               end loop;
+               Unget_Char;
+               declare
+                  H : Hash_Type;
+                  S : Syment_Acc;
+                  N : Node_Acc;
+               begin
+                  H := Token_Hash mod Hash_Max;
+                  S := Symtable (H);
+                  while S /= null loop
+                     if S.Hash = Token_Hash
+                       and then Is_Equal (S.Ident,
+                                          Token_Ident (1 .. Token_Idlen))
+                     then
+                        --  This identifier is known.
+                        Token_Sym := S;
+
+                        --  It may be a keyword.
+                        if S.Name /= null then
+                           N := Get_Decl (S);
+                           if N.Kind = Decl_Keyword then
+                              return N.Keyword;
+                           end if;
+                        end if;
+
+                        return Tok_Ident;
+                     end if;
+                     S := S.Next;
+                  end loop;
+                  Symtable (H) := new Syment_Type'
+                    (Hash => Token_Hash,
+                     Ident => Get_Identifier (Token_Ident (1 .. Token_Idlen)),
+                     Next => Symtable (H),
+                     Name => null);
+                  Token_Sym := Symtable (H);
+                  return Tok_Ident;
+               end;
+            when others =>
+               Scan_Error ("Bad character:"
+                           & Integer'Image (Character'Pos (C))
+                           & C);
+               return Tok_Eof;
+         end case;
+      end loop;
+   end Get_Token;
+
+   --  The current token.
+   Tok : Token_Type;
+
+   procedure Next_Token is
+   begin
+      Tok_Previous := Tok;
+      Tok := Get_Token;
+   end Next_Token;
+
+   procedure Expect (T : Token_Type; Msg : String := "") is
+   begin
+      if Tok /= T then
+         if Msg'Length = 0 then
+            case T is
+               when Tok_Left_Brace =>
+                  Parse_Error ("'{' expected");
+               when others =>
+                  if Tok = Tok_Ident then
+                     Parse_Error
+                       (Token_Type'Image (T) & " expected, found '" &
+                        Token_Ident (1 .. Token_Idlen) & "'");
+                  else
+                     Parse_Error (Token_Type'Image (T) & " expected, found "
+                                  & Token_Type'Image (Tok));
+                  end if;
+            end case;
+         else
+            Parse_Error (Msg);
+         end if;
+      end if;
+   end Expect;
+
+   procedure Next_Expect (T : Token_Type; Msg : String := "") is
+   begin
+      Next_Token;
+      Expect (T, Msg);
+   end Next_Expect;
+
+   --  Scopes and identifiers.
+
+
+   --  Current scope.
+   Scope : Scope_Acc := null;
+
+   --  Add a declaration for symbol SYM in the current scope.
+   --  INTER defines the meaning of the declaration.
+   --  There must be at most one declaration for a symbol in the current scope,
+   --  i.e. a symbol cannot be redefined.
+   procedure Add_Decl (Sym : Syment_Acc; Inter : Node_Acc);
+
+   --  Return TRUE iff SYM is already defined in the current scope.
+   function Is_Defined (Sym : Syment_Acc) return Boolean;
+
+   --  Create new scope.
+   procedure Push_Scope;
+
+   --  Close the current scope.  Symbols defined in the scope regain their
+   --  previous declaration.
+   procedure Pop_Scope;
+
+
+   procedure Push_Scope
+   is
+      Nscope : Scope_Acc;
+   begin
+      Nscope := new Scope_Type'(Names => null, Prev => Scope);
+      Scope := Nscope;
+   end Push_Scope;
+
+   procedure Pop_Scope
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Object => Name_Type, Name => Name_Acc);
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Object => Scope_Type, Name => Scope_Acc);
+
+      Sym : Syment_Acc;
+      N_Sym : Syment_Acc;
+      Name : Name_Acc;
+      Old_Scope : Scope_Acc;
+   begin
+      Sym := Scope.Names;
+      while Sym /= null loop
+         Name := Sym.Name;
+         --  Check.
+         if Name.Scope /= Scope then
+            raise Program_Error;
+         end if;
+
+         --  Set the interpretation of this symbol.
+         Sym.Name := Name.Up;
+
+         N_Sym := Name.Next;
+
+         Free (Name);
+         Sym := N_Sym;
+      end loop;
+
+      --  Free scope.
+      Old_Scope := Scope;
+      Scope := Scope.Prev;
+      Free (Old_Scope);
+   end Pop_Scope;
+
+   function Is_Defined (Sym : Syment_Acc) return Boolean is
+   begin
+      if Sym.Name /= null
+        and then Sym.Name.Scope = Scope
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Is_Defined;
+
+   function New_Symbol (Str : String) return Syment_Acc
+   is
+      Ent : Syment_Acc;
+      H : Hash_Type;
+   begin
+      Ent := new Syment_Type'(Hash => Get_Hash (Str),
+                              Ident => Get_Identifier (Str),
+                              Next => null,
+                              Name => null);
+      H := Ent.Hash mod Hash_Max;
+      Ent.Next := Symtable (H);
+      Symtable (H) := Ent;
+      return Ent;
+   end New_Symbol;
+
+   procedure Add_Keyword (Str : String; Token : Token_Type)
+   is
+      Ent : Syment_Acc;
+   begin
+      Ent := New_Symbol (Str);
+      if Ent.Name /= null
+        or else Scope /= null
+      then
+         --  Redefinition of a keyword.
+         raise Program_Error;
+      end if;
+      Ent.Name := new Name_Type'(Inter => new Node'(Kind => Decl_Keyword,
+                                                    Keyword => Token),
+                                 Next => null,
+                                 Up => null,
+                                 Scope => null);
+   end Add_Keyword;
+
+   procedure Add_Decl (Sym : Syment_Acc; Inter : Node_Acc)
+   is
+      Name : Name_Acc;
+      Prev : Node_Acc;
+   begin
+      Name := Sym.Name;
+      if Name /= null and then Name.Scope = Scope then
+         Prev := Name.Inter;
+         if Prev.Kind = Inter.Kind
+           and then Prev.Decl_Dtype = Inter.Decl_Dtype
+           and then Prev.Decl_Storage = O_Storage_External
+           and then Inter.Decl_Storage = O_Storage_Public
+         then
+            --  Redefinition
+            Name.Inter := Inter;
+            return;
+         end if;
+         Parse_Error ("redefinition of " & Get_String (Sym.Ident));
+      end if;
+      Name := new Name_Type'(Inter => Inter,
+                             Next => Scope.Names,
+                             Up => Sym.Name,
+                             Scope => Scope);
+      Sym.Name := Name;
+      Scope.Names := Sym;
+   end Add_Decl;
+
+   function Get_Decl (Sym : Syment_Acc) return Node_Acc is
+   begin
+      if Sym.Name = null then
+         Parse_Error ("undefined identifier " & Get_String (Sym.Ident));
+      else
+         return Sym.Name.Inter;
+      end if;
+   end Get_Decl;
+
+   function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode;
+   function Parse_Address (Prefix : Node_Acc) return O_Enode;
+   function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode;
+   procedure Parse_Declaration;
+   procedure Parse_Compound_Statement;
+
+   function Parse_Type return Node_Acc;
+
+   procedure Parse_Fields (Aggr_Type : Node_Acc;
+                           Constr : in out O_Element_List)
+   is
+      F_Type : Node_Acc;
+      F : Syment_Acc;
+      Last_Field : Node_Acc;
+      Field : Node_Acc;
+   begin
+      Last_Field := null;
+      loop
+         exit when Tok = Tok_End;
+
+         if Tok /= Tok_Ident then
+            Parse_Error ("field name expected");
+         end if;
+         F := Token_Sym;
+         Next_Expect (Tok_Colon, "':' expected");
+         Next_Token;
+         F_Type := Parse_Type;
+         Field := new Node'(Kind => Node_Field,
+                            Field_Ident => F,
+                            Field_Fnode => O_Fnode_Null,
+                            Field_Type => F_Type,
+                            Field_Next => null);
+         case Aggr_Type.Kind is
+            when Type_Record =>
+               New_Record_Field (Constr, Field.Field_Fnode, F.Ident,
+                                 F_Type.Type_Onode);
+            when Type_Union =>
+               New_Union_Field (Constr, Field.Field_Fnode, F.Ident,
+                                F_Type.Type_Onode);
+            when others =>
+               raise Program_Error;
+         end case;
+         if Last_Field = null then
+            Aggr_Type.Record_Union_Fields := Field;
+         else
+            Last_Field.Field_Next := Field;
+         end if;
+         Last_Field := Field;
+         Expect (Tok_Semicolon, "';' expected");
+         Next_Token;
+      end loop;
+   end Parse_Fields;
+
+   procedure Parse_Record_Type (Def : Node_Acc)
+   is
+      Constr : O_Element_List;
+   begin
+      if Def.Type_Onode = O_Tnode_Null then
+         Start_Record_Type (Constr);
+      else
+         Start_Uncomplete_Record_Type (Def.Type_Onode, Constr);
+      end if;
+      Parse_Fields (Def, Constr);
+      Next_Expect (Tok_Record, "end record expected");
+      Finish_Record_Type (Constr, Def.Type_Onode);
+   end Parse_Record_Type;
+
+   procedure Parse_Union_Type (Def : Node_Acc)
+   is
+      Constr : O_Element_List;
+   begin
+      Start_Union_Type (Constr);
+      Parse_Fields (Def, Constr);
+      Next_Expect (Tok_Union, "end union expected");
+      Finish_Union_Type (Constr, Def.Type_Onode);
+   end Parse_Union_Type;
+
+   function Parse_Type return Node_Acc
+   is
+      Res : Node_Acc;
+      T : Token_Type;
+   begin
+      T := Tok;
+      case T is
+         when Tok_Unsigned
+           | Tok_Signed =>
+            Next_Expect (Tok_Left_Paren, "'(' expected");
+            Next_Expect (Tok_Num, "number expected");
+            case T is
+               when Tok_Unsigned =>
+                  Res := new Node'
+                    (Kind => Type_Unsigned,
+                     Type_Onode => New_Unsigned_Type (Natural
+                                                      (Token_Number)));
+               when Tok_Signed =>
+                  Res := new Node'
+                     (Kind => Type_Signed,
+                      Type_Onode => New_Signed_Type (Natural
+                                                     (Token_Number)));
+               when others =>
+                  raise Program_Error;
+            end case;
+            Next_Expect (Tok_Right_Paren, "')' expected");
+         when Tok_Float =>
+            Res := new Node'(Kind => Type_Float,
+                             Type_Onode => New_Float_Type);
+         when Tok_Array =>
+            declare
+               Index_Node : Node_Acc;
+               El_Node : Node_Acc;
+            begin
+               Next_Expect (Tok_Left_Brack, "'[' expected");
+               Next_Token;
+               Index_Node := Parse_Type;
+               Expect (Tok_Right_Brack, "']' expected");
+               Next_Expect (Tok_Of, "'of' expected");
+               Next_Token;
+               El_Node := Parse_Type;
+               Res := new Node'
+                 (Kind => Type_Array,
+                  Type_Onode => New_Array_Type (El_Node.Type_Onode,
+                                                Index_Node.Type_Onode),
+                  Array_Index => Index_Node,
+                  Array_Element => El_Node);
+            end;
+            return Res;
+         when Tok_Subarray =>
+            declare
+               Base_Node : Node_Acc;
+               Res_Type : O_Tnode;
+            begin
+               Next_Token;
+               Base_Node := Parse_Type;
+               Expect (Tok_Left_Brack);
+               Next_Token;
+               Res_Type := New_Constrained_Array_Type
+                 (Base_Node.Type_Onode,
+                  Parse_Constant_Value (Base_Node.Array_Index));
+               Expect (Tok_Right_Brack);
+               Next_Token;
+               Res := new Node' (Kind => Type_Subarray,
+                                 Type_Onode => Res_Type,
+                                 Subarray_Base => Base_Node);
+               return Res;
+            end;
+         when Tok_Ident =>
+            declare
+               Inter : Node_Acc;
+            begin
+               Inter := Get_Decl (Token_Sym);
+               if Inter = null then
+                  Parse_Error ("undefined type name symbol "
+                               & Get_String (Token_Sym.Ident));
+               end if;
+               if Inter.Kind /= Decl_Type then
+                  Parse_Error ("type declarator expected");
+               end if;
+               Res := Inter.Decl_Dtype;
+            end;
+         when Tok_Access =>
+            declare
+               Dtype : Node_Acc;
+            begin
+               Next_Token;
+               if Tok = Tok_Semicolon then
+                  Res := new Node'
+                    (Kind => Type_Access,
+                     Type_Onode => New_Access_Type (O_Tnode_Null),
+                     Access_Dtype => null);
+               else
+                  Dtype := Parse_Type;
+                  Res := new Node'
+                    (Kind => Type_Access,
+                     Type_Onode => New_Access_Type (Dtype.Type_Onode),
+                     Access_Dtype => Dtype);
+               end if;
+               return Res;
+            end;
+         when Tok_Record =>
+            Next_Token;
+            if Tok = Tok_Semicolon then
+               --  Uncomplete record type.
+               Res := new Node'(Kind => Type_Record,
+                                Type_Onode => O_Tnode_Null,
+                                Record_Union_Fields => null);
+               New_Uncomplete_Record_Type (Res.Type_Onode);
+               return Res;
+            end if;
+
+            Res := new Node'(Kind => Type_Record,
+                             Type_Onode => O_Tnode_Null,
+                             Record_Union_Fields => null);
+            Parse_Record_Type (Res);
+         when Tok_Union =>
+            Next_Token;
+            Res := new Node'(Kind => Type_Union,
+                             Type_Onode => O_Tnode_Null,
+                             Record_Union_Fields => null);
+            Parse_Union_Type (Res);
+
+         when Tok_Boolean =>
+            declare
+               False_Lit, True_Lit : Node_Acc;
+            begin
+               Res := new Node'(Kind => Type_Boolean,
+                                Type_Onode => O_Tnode_Null,
+                                Enum_Lits => null);
+               Next_Expect (Tok_Left_Brace, "'{' expected");
+               Next_Expect (Tok_Ident, "identifier expected");
+               False_Lit := new Node'(Kind => Node_Lit,
+                                      Decl_Dtype => Res,
+                                      Decl_Storage => O_Storage_Public,
+                                      Lit_Name => Token_Sym.Ident,
+                                      Lit_Cnode => O_Cnode_Null,
+                                      Lit_Next => null);
+               Next_Expect (Tok_Comma, "',' expected");
+               Next_Expect (Tok_Ident, "identifier expected");
+               True_Lit := new Node'(Kind => Node_Lit,
+                                     Decl_Dtype => Res,
+                                     Decl_Storage => O_Storage_Public,
+                                     Lit_Name => Token_Sym.Ident,
+                                     Lit_Cnode => O_Cnode_Null,
+                                     Lit_Next => null);
+               Next_Expect (Tok_Right_Brace, "'}' expected");
+               False_Lit.Lit_Next := True_Lit;
+               Res.Enum_Lits := False_Lit;
+               New_Boolean_Type (Res.Type_Onode,
+                                 False_Lit.Lit_Name, False_Lit.Lit_Cnode,
+                                 True_Lit.Lit_Name, True_Lit.Lit_Cnode);
+            end;
+         when Tok_Enum =>
+            declare
+               List : O_Enum_List;
+               Lit : Node_Acc;
+               Last_Lit : Node_Acc;
+            begin
+               Res := new Node'(Kind => Type_Enum,
+                                Type_Onode => O_Tnode_Null,
+                                Enum_Lits => null);
+               Last_Lit := null;
+               Push_Scope;
+               Next_Expect (Tok_Left_Brace);
+               Next_Token;
+               --  FIXME: set a size to the enum.
+               Start_Enum_Type (List, 8);
+               loop
+                  Expect (Tok_Ident);
+                  Lit := new Node'(Kind => Node_Lit,
+                                   Decl_Dtype => Res,
+                                   Decl_Storage => O_Storage_Public,
+                                   Lit_Name => Token_Sym.Ident,
+                                   Lit_Cnode => O_Cnode_Null,
+                                   Lit_Next => null);
+                  Add_Decl (Token_Sym, Lit);
+                  New_Enum_Literal (List, Lit.Lit_Name, Lit.Lit_Cnode);
+                  if Last_Lit = null then
+                     Res.Enum_Lits := Lit;
+                  else
+                     Last_Lit.Lit_Next := Lit;
+                  end if;
+                  Last_Lit := Lit;
+                  Next_Expect (Tok_Equal);
+                  Next_Expect (Tok_Num);
+                  Next_Token;
+                  exit when Tok = Tok_Right_Brace;
+                  Expect (Tok_Comma);
+                  Next_Token;
+               end loop;
+               Finish_Enum_Type (List, Res.Type_Onode);
+               Pop_Scope;
+            end;
+         when others =>
+            Parse_Error ("bad type " & Token_Type'Image (Tok));
+            return null;
+      end case;
+      Next_Token;
+      return Res;
+   end Parse_Type;
+
+   procedure Parse_Type_Completion (Decl : Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Record =>
+            Next_Token;
+            Parse_Record_Type (Decl.Decl_Dtype);
+            Next_Token;
+         when Tok_Access =>
+            Next_Token;
+            declare
+               Dtype : Node_Acc;
+            begin
+               Dtype := Parse_Type;
+               Decl.Decl_Dtype.Access_Dtype := Dtype;
+               Finish_Access_Type (Decl.Decl_Dtype.Type_Onode,
+                                   Dtype.Type_Onode);
+            end;
+         when others =>
+            Parse_Error ("'access' or 'record' expected");
+      end case;
+   end Parse_Type_Completion;
+
+--    procedure Parse_Declaration;
+
+   procedure Parse_Expression (Expr_Type : Node_Acc;
+                               Expr : out O_Enode;
+                               Res_Type : out Node_Acc);
+   procedure Parse_Name (Prefix : Node_Acc;
+                         Name : out O_Lnode; N_Type : out Node_Acc);
+   procedure Parse_Lvalue (N : in out O_Lnode; N_Type : in out Node_Acc);
+
+   --  Expect: '('
+   --  Let: next token.
+   procedure Parse_Association (Constr : in out O_Assoc_List;
+                                Decl : Node_Acc);
+
+   function Find_Field_By_Name (Aggr_Type : Node_Acc) return Node_Acc
+   is
+      Field : Node_Acc;
+   begin
+      Field := Aggr_Type.Record_Union_Fields;
+      while Field /= null loop
+         exit when Field.Field_Ident = Token_Sym;
+         Field := Field.Field_Next;
+      end loop;
+      if Field = null then
+         Parse_Error ("no such field name");
+      end if;
+      return Field;
+   end Find_Field_By_Name;
+
+   --  expect: offsetof id.
+   function Parse_Offsetof (Atype : Node_Acc) return O_Cnode
+   is
+      Rec_Type : Node_Acc;
+      Rec_Field : Node_Acc;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Rec_Type := Get_Decl (Token_Sym);
+      if Rec_Type.Kind /= Decl_Type
+        or else Rec_Type.Decl_Dtype.Kind /= Type_Record
+      then
+         Parse_Error ("type name expected");
+      end if;
+      Next_Expect (Tok_Dot);
+      Next_Expect (Tok_Ident);
+      Rec_Field := Find_Field_By_Name (Rec_Type.Decl_Dtype);
+      Next_Expect (Tok_Right_Paren);
+      return New_Offsetof (Rec_Type.Decl_Dtype.Type_Onode,
+                           Rec_Field.Field_Fnode,
+                           Atype.Type_Onode);
+   end Parse_Offsetof;
+
+   function Parse_Sizeof (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok /= Tok_Ident then
+         Parse_Error ("type name expected");
+      end if;
+      Res := New_Sizeof
+        (Get_Decl (Token_Sym).Decl_Dtype.Type_Onode,
+         Atype.Type_Onode);
+      Next_Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Sizeof;
+
+   function Parse_Alignof (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok /= Tok_Ident then
+         Parse_Error ("type name expected");
+      end if;
+      Res := New_Alignof
+        (Get_Decl (Token_Sym).Decl_Dtype.Type_Onode,
+         Atype.Type_Onode);
+      Next_Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Alignof;
+
+   --  Parse a literal whose type is ATYPE.
+   function Parse_Typed_Literal (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      case Tok is
+         when Tok_Num =>
+            case Atype.Kind is
+               when Type_Signed =>
+                  Res := New_Signed_Literal
+                    (Atype.Type_Onode, Integer_64 (Token_Number));
+               when Type_Unsigned =>
+                  Res := New_Unsigned_Literal
+                    (Atype.Type_Onode, Token_Number);
+               when others =>
+                  Parse_Error ("bad type for integer literal");
+            end case;
+         when Tok_Minus =>
+            Next_Token;
+            case Tok is
+               when Tok_Num =>
+                  declare
+                     V : Integer_64;
+                  begin
+                     if Token_Number = Unsigned_64 (Integer_64'Last) + 1 then
+                        V := Integer_64'First;
+                     else
+                        V := -Integer_64 (Token_Number);
+                     end if;
+                     Res := New_Signed_Literal (Atype.Type_Onode, V);
+                  end;
+               when Tok_Float_Num =>
+                  Res := New_Float_Literal (Atype.Type_Onode, -Token_Float);
+               when others =>
+                  Parse_Error ("bad token after '-'");
+            end case;
+         when Tok_Float_Num =>
+            Res := New_Float_Literal (Atype.Type_Onode, Token_Float);
+         when Tok_Ident =>
+            declare
+               Pfx : Node_Acc;
+               N : Node_Acc;
+            begin
+               --  Note: we don't use get_decl, since the name can be a literal
+               --  name, which is not directly visible.
+               if Token_Sym.Name /= null
+                 and then Token_Sym.Name.Inter.Kind = Decl_Type
+               then
+                  --  A typed expression.
+                  Pfx := Token_Sym.Name.Inter;
+                  N := Pfx.Decl_Dtype;
+                  if Atype /= null and then N /= Atype then
+                     Parse_Error ("type mismatch");
+                  end if;
+                  Next_Expect (Tok_Tick);
+                  Next_Token;
+                  if Tok = Tok_Left_Brack then
+                     Next_Token;
+                     Res := Parse_Typed_Literal (N);
+                     Expect (Tok_Right_Brack);
+                  elsif Tok = Tok_Ident then
+                     if Token_Sym = Id_Offsetof then
+                        Res := Parse_Offsetof (N);
+                     elsif Token_Sym = Id_Sizeof then
+                        Res := Parse_Sizeof (N);
+                     elsif Token_Sym = Id_Alignof then
+                        Res := Parse_Alignof (N);
+                     elsif Token_Sym = Id_Address
+                       or Token_Sym = Id_Unchecked_Address
+                       or Token_Sym = Id_Subprg_Addr
+                     then
+                        Res := Parse_Constant_Address (Pfx);
+                     elsif Token_Sym = Id_Conv then
+                        Next_Expect (Tok_Left_Paren);
+                        Next_Token;
+                        Res := Parse_Typed_Literal (N);
+                        Expect (Tok_Right_Paren);
+                     else
+                        Parse_Error ("offsetof or sizeof attributes expected");
+                     end if;
+                  else
+                     Parse_Error ("'[' or attribute expected");
+                  end if;
+               else
+                  if Atype.Kind /= Type_Enum
+                    and then Atype.Kind /= Type_Boolean
+                  then
+                     Parse_Error ("name allowed only for enumeration");
+                  end if;
+                  N := Atype.Enum_Lits;
+                  while N /= null loop
+                     if Is_Equal (N.Lit_Name, Token_Sym.Ident) then
+                        Res := N.Lit_Cnode;
+                        exit;
+                     end if;
+                     N := N.Lit_Next;
+                  end loop;
+                  if N = null then
+                     Parse_Error ("no matching literal");
+                     return O_Cnode_Null;
+                  end if;
+               end if;
+            end;
+         when Tok_Null =>
+            Res := New_Null_Access (Atype.Type_Onode);
+         when others =>
+            Parse_Error ("bad primary expression: " & Token_Type'Image (Tok));
+            return O_Cnode_Null;
+      end case;
+      Next_Token;
+      return Res;
+   end Parse_Typed_Literal;
+
+   --  expect: next token
+   --  Parse an expression starting with NAME.
+   procedure Parse_Named_Expression
+     (Atype : Node_Acc; Name : Node_Acc; Stop_At_All : Boolean;
+                                         Res : out O_Enode;
+                                         Res_Type : out Node_Acc)
+   is
+   begin
+      if Tok = Tok_Tick then
+         Next_Token;
+         if Tok = Tok_Left_Brack then
+            --  Typed literal.
+            Next_Token;
+            Res := New_Lit (Parse_Typed_Literal (Name.Decl_Dtype));
+            Res_Type := Name.Decl_Dtype;
+            Expect (Tok_Right_Brack);
+            Next_Token;
+         elsif Tok = Tok_Left_Paren then
+            --  Typed expression (used for comparaison operators)
+            Next_Token;
+            Parse_Expression (Name.Decl_Dtype, Res, Res_Type);
+            Expect (Tok_Right_Paren);
+            Next_Token;
+         elsif Tok = Tok_Ident then
+            --  Attribute.
+            if Token_Sym = Id_Conv then
+               Next_Expect (Tok_Left_Paren);
+               Next_Token;
+               Parse_Expression (null, Res, Res_Type);
+               --  Discard Res_Type.
+               Expect (Tok_Right_Paren);
+               Next_Token;
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Convert_Ov (Res, Res_Type.Type_Onode);
+               --  Fall-through.
+            elsif Token_Sym = Id_Address
+              or Token_Sym = Id_Unchecked_Address
+              or Token_Sym = Id_Subprg_Addr
+            then
+               Res_Type := Name.Decl_Dtype;
+               Res := Parse_Address (Name);
+               --  Fall-through.
+            elsif Token_Sym = Id_Sizeof then
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Lit (Parse_Sizeof (Res_Type));
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Alignof then
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Lit (Parse_Alignof (Res_Type));
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Alloca then
+               Next_Expect (Tok_Left_Paren);
+               Next_Token;
+               Parse_Expression (null, Res, Res_Type);
+               --  Discard Res_Type.
+               Res_Type := Name.Decl_Dtype;
+               Res := New_Alloca (Res_Type.Type_Onode, Res);
+               Expect (Tok_Right_Paren);
+               Next_Token;
+               return;
+            elsif Token_Sym = Id_Offsetof then
+               Res_Type := Atype;
+               Res := New_Lit (Parse_Offsetof (Res_Type));
+               Next_Token;
+               return;
+            else
+               Parse_Error ("unknown attribute name");
+            end if;
+            -- Fall-through.
+         else
+            Parse_Error ("typed expression expected");
+         end if;
+      elsif Tok = Tok_Left_Paren then
+         if Name.Kind /= Node_Function then
+            Parse_Error ("function name expected");
+         end if;
+         declare
+            Constr : O_Assoc_List;
+         begin
+            Parse_Association (Constr, Name);
+            Res := New_Function_Call (Constr);
+            Res_Type := Name.Decl_Dtype;
+            --  Fall-through.
+         end;
+      elsif Name.Kind = Node_Object
+        or else Name.Kind = Decl_Param
+      then
+         --  Name.
+         declare
+            Lval : O_Lnode;
+         begin
+            Parse_Name (Name, Lval, Res_Type);
+            Res := New_Value (Lval);
+         end;
+      else
+         Parse_Error ("bad ident expression: "
+                      & Token_Type'Image (Tok));
+      end if;
+
+      -- Continue.
+      --  R_TYPE and RES must be set.
+      if Tok = Tok_Dot then
+         if Stop_At_All then
+            return;
+         end if;
+         Next_Token;
+         if Tok = Tok_All then
+            if Res_Type.Kind /= Type_Access then
+               Parse_Error ("type of prefix is not an access");
+            end if;
+            declare
+               N : O_Lnode;
+            begin
+               Next_Token;
+               N := New_Access_Element (Res);
+               Res_Type := Res_Type.Access_Dtype;
+               Parse_Lvalue (N, Res_Type);
+               Res := New_Value (N);
+            end;
+            return;
+         else
+            Parse_Error ("'.all' expected");
+         end if;
+      end if;
+   end Parse_Named_Expression;
+
+   procedure Parse_Primary_Expression (Atype : Node_Acc;
+                                       Res : out O_Enode;
+                                       Res_Type : out Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Num
+           | Tok_Float_Num =>
+            if Atype = null then
+               Parse_Error ("numeric literal without type context");
+            end if;
+            Res_Type := Atype;
+            Res := New_Lit (Parse_Typed_Literal (Atype));
+         when Tok_Ident =>
+            declare
+               N : Node_Acc;
+            begin
+               N := Get_Decl (Token_Sym);
+               Next_Token;
+               Parse_Named_Expression (Atype, N, False, Res, Res_Type);
+            end;
+         when Tok_Left_Paren =>
+            Next_Token;
+            Parse_Expression (Atype, Res, Res_Type);
+            Expect (Tok_Right_Paren);
+            Next_Token;
+         when others =>
+            Parse_Error ("bad primary expression: " & Token_Type'Image (Tok));
+      end case;
+   end Parse_Primary_Expression;
+
+   --  Parse '-' EXPR, 'not' EXPR, 'abs' EXPR or EXPR.
+   procedure Parse_Unary_Expression (Atype : Node_Acc;
+                                     Res : out O_Enode;
+                                     Res_Type : out Node_Acc)
+   is
+   begin
+      case Tok is
+         when Tok_Minus =>
+            Next_Token;
+            Parse_Primary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Neg_Ov, Res);
+         when Tok_Not =>
+            Next_Token;
+            Parse_Unary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Not, Res);
+         when Tok_Abs =>
+            Next_Token;
+            Parse_Unary_Expression (Atype, Res, Res_Type);
+            Res := New_Monadic_Op (ON_Abs_Ov, Res);
+         when others =>
+            Parse_Primary_Expression (Atype, Res, Res_Type);
+      end case;
+   end Parse_Unary_Expression;
+
+   function Check_Sharp (Op_Ov : ON_Op_Kind) return ON_Op_Kind is
+   begin
+      Next_Expect (Tok_Sharp);
+      Next_Token;
+      return Op_Ov;
+   end Check_Sharp;
+
+   procedure Parse_Expression (Expr_Type : Node_Acc;
+                               Expr : out O_Enode;
+                               Res_Type : out Node_Acc)
+   is
+      Op_Type : Node_Acc;
+      L : O_Enode;
+      R : O_Enode;
+      Op : ON_Op_Kind;
+   begin
+      if Expr_Type = null or else Expr_Type.Kind = Type_Boolean then
+         --  The type of the expression isn't known, as this can be a
+         --  comparaison operator.
+         Op_Type := null;
+      else
+         Op_Type := Expr_Type;
+      end if;
+      Parse_Unary_Expression (Op_Type, L, Res_Type);
+      case Tok is
+         when Tok_Div =>
+            Op := Check_Sharp (ON_Div_Ov);
+         when Tok_Plus =>
+            Op := Check_Sharp (ON_Add_Ov);
+         when Tok_Minus =>
+            Op := Check_Sharp (ON_Sub_Ov);
+         when Tok_Star =>
+            Op := Check_Sharp (ON_Mul_Ov);
+         when Tok_Mod =>
+            Op := Check_Sharp (ON_Mod_Ov);
+         when Tok_Rem =>
+            Op := Check_Sharp (ON_Rem_Ov);
+
+         when Tok_Equal =>
+            Op := ON_Eq;
+         when Tok_Not_Equal =>
+            Op := ON_Neq;
+         when Tok_Greater =>
+            Op := ON_Gt;
+         when Tok_Greater_Eq =>
+            Op := ON_Ge;
+         when Tok_Less =>
+            Op := ON_Lt;
+         when Tok_Less_Eq =>
+            Op := ON_Le;
+
+         when Tok_Or =>
+            Op := ON_Or;
+            Next_Token;
+         when Tok_And =>
+            Op := ON_And;
+            Next_Token;
+         when Tok_Xor =>
+            Op := ON_Xor;
+            Next_Token;
+
+         when others =>
+            Expr := L;
+            return;
+      end case;
+      if Op in ON_Compare_Op_Kind then
+         Next_Token;
+      end if;
+
+      Parse_Unary_Expression (Res_Type, R, Res_Type);
+      case Op is
+         when ON_Dyadic_Op_Kind =>
+            Expr := New_Dyadic_Op (Op, L, R);
+         when ON_Compare_Op_Kind =>
+            if Expr_Type = null then
+               Parse_Error ("comparaison operator requires a type");
+            end if;
+            Expr := New_Compare_Op (Op, L, R, Expr_Type.Type_Onode);
+            Res_Type := Expr_Type;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Parse_Expression;
+
+   --  Expect and leave: next token
+   procedure Parse_Lvalue (N : in out O_Lnode; N_Type : in out Node_Acc)
+   is
+   begin
+      loop
+         case Tok is
+            when Tok_Dot =>
+               Next_Token;
+               if Tok = Tok_All then
+                  if N_Type.Kind /= Type_Access then
+                     Parse_Error ("type of prefix is not an access");
+                  end if;
+                  N := New_Access_Element (New_Value (N));
+                  N_Type := N_Type.Access_Dtype;
+                  Next_Token;
+               elsif Tok = Tok_Ident then
+                  if N_Type.Kind /= Type_Record and N_Type.Kind /= Type_Union
+                  then
+                     Parse_Error
+                       ("type of prefix is neither a record nor an union");
+                  end if;
+                  declare
+                     Field : Node_Acc;
+                  begin
+                     Field := Find_Field_By_Name (N_Type);
+                     N := New_Selected_Element (N, Field.Field_Fnode);
+                     N_Type := Field.Field_Type;
+                     Next_Token;
+                  end;
+               else
+                  Parse_Error
+                    ("'.' must be followed by 'all' or a field name");
+               end if;
+            when Tok_Left_Brack =>
+               declare
+                  V : O_Enode;
+                  Bt : Node_Acc;
+                  Res_Type : Node_Acc;
+               begin
+                  Next_Token;
+                  if N_Type.Kind = Type_Subarray then
+                     Bt := N_Type.Subarray_Base;
+                  else
+                     Bt := N_Type;
+                  end if;
+                  if Bt.Kind /= Type_Array then
+                     Parse_Error ("type of prefix is not an array");
+                  end if;
+                  Parse_Expression (Bt.Array_Index, V, Res_Type);
+                  if Tok = Tok_Elipsis then
+                     N := New_Slice (N, Bt.Type_Onode, V);
+                     Next_Token;
+                  else
+                     N := New_Indexed_Element (N, V);
+                     N_Type := Bt.Array_Element;
+                  end if;
+                  Expect (Tok_Right_Brack);
+                  Next_Token;
+               end;
+            when others =>
+               return;
+         end case;
+      end loop;
+   end Parse_Lvalue;
+
+   procedure Parse_Name (Prefix : Node_Acc;
+                         Name : out O_Lnode; N_Type : out Node_Acc)
+   is
+   begin
+      case Prefix.Kind is
+         when Decl_Param =>
+            Name := New_Obj (Prefix.Param_Node);
+            N_Type := Prefix.Decl_Dtype;
+         when Node_Object =>
+            Name := New_Obj (Prefix.Obj_Node);
+            N_Type := Prefix.Decl_Dtype;
+         when Decl_Type =>
+            declare
+               Val : O_Enode;
+            begin
+               Parse_Named_Expression (null, Prefix, True, Val, N_Type);
+               if N_Type /= Prefix.Decl_Dtype then
+                  Parse_Error ("type doesn't match");
+               end if;
+               if Tok = Tok_Dot then
+                  Next_Token;
+                  if Tok = Tok_All then
+                     if N_Type.Kind /= Type_Access then
+                        Parse_Error ("type of prefix is not an access");
+                     end if;
+                     Name := New_Access_Element (Val);
+                     N_Type := N_Type.Access_Dtype;
+                     Next_Token;
+                  else
+                     Parse_Error ("'.all' expected");
+                  end if;
+               else
+                  Parse_Error ("name expected");
+               end if;
+            end;
+         when others =>
+            Parse_Error ("invalid name");
+      end case;
+      Parse_Lvalue (Name, N_Type);
+   end Parse_Name;
+
+   --  Expect: '('
+   --  Let: next token.
+   procedure Parse_Association (Constr : in out O_Assoc_List; Decl : Node_Acc)
+   is
+      Param : Node_Acc;
+      Expr : O_Enode;
+      Expr_Type : Node_Acc;
+   begin
+      Start_Association (Constr, Decl.Subprg_Node);
+      if Tok /= Tok_Left_Paren then
+         Parse_Error ("'(' expected for a subprogram call");
+      end if;
+      Next_Token;
+      Param := Decl.Subprg_Params;
+      while Tok /= Tok_Right_Paren loop
+         if Param = null then
+            Parse_Error ("too many parameters");
+         end if;
+         Parse_Expression (Param.Decl_Dtype, Expr, Expr_Type);
+         New_Association (Constr, Expr);
+         Param := Param.Param_Next;
+         exit when Tok /= Tok_Comma;
+         Next_Token;
+      end loop;
+      if Param /= null then
+         Parse_Error ("missing parameters");
+      end if;
+      if Tok /= Tok_Right_Paren then
+         Parse_Error ("')' expected to finish a subprogram call, found "
+                      & Token_Type'Image (Tok));
+      end if;
+      Next_Token;
+   end Parse_Association;
+
+   type Loop_Info;
+   type Loop_Info_Acc is access Loop_Info;
+   type Loop_Info is record
+      Num : Natural;
+      Blk : O_Snode;
+      Prev : Loop_Info_Acc;
+   end record;
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Loop_Info_Acc, Object => Loop_Info);
+
+   Loop_Stack : Loop_Info_Acc := null;
+
+   function Find_Loop (N : Natural) return Loop_Info_Acc
+   is
+      Res : Loop_Info_Acc;
+   begin
+      Res := Loop_Stack;
+      while Res /= null loop
+         if Res.Num = N then
+            return Res;
+         end if;
+         Res := Res.Prev;
+      end loop;
+      return null;
+   end Find_Loop;
+
+   Current_Subprg : Node_Acc := null;
+
+   procedure Parse_Statement;
+
+   --  Expect : next token
+   --  Let: next token
+   procedure Parse_Statements is
+   begin
+      loop
+         exit when Tok = Tok_End;
+         exit when Tok = Tok_Else;
+         exit when Tok = Tok_When;
+         Parse_Statement;
+      end loop;
+   end Parse_Statements;
+
+   --  Expect : next token
+   --  Let: next token
+   procedure Parse_Statement is
+   begin
+      if Flag_Renumber then
+         New_Debug_Line_Stmt (Lineno);
+      end if;
+
+      case Tok is
+         when Tok_Comment =>
+            Next_Token;
+
+         when Tok_Declare =>
+            Start_Declare_Stmt;
+            Parse_Compound_Statement;
+            Expect (Tok_Semicolon);
+            Next_Token;
+            Finish_Declare_Stmt;
+
+         when Tok_Line_Number =>
+            Next_Expect (Tok_Num);
+            if Flag_Renumber = False then
+               New_Debug_Line_Stmt (Natural (Token_Number));
+            end if;
+            Next_Token;
+
+         when Tok_If =>
+            declare
+               If_Blk : O_If_Block;
+               Cond : O_Enode;
+               Cond_Type : Node_Acc;
+            begin
+               Next_Token;
+               Parse_Expression (null, Cond, Cond_Type);
+               Start_If_Stmt (If_Blk, Cond);
+               Expect (Tok_Then);
+               Next_Token;
+               Parse_Statements;
+               if Tok = Tok_Else then
+                  Next_Token;
+                  New_Else_Stmt (If_Blk);
+                  Parse_Statements;
+               end if;
+               Finish_If_Stmt (If_Blk);
+               Expect (Tok_End);
+               Next_Expect (Tok_If);
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+
+         when Tok_Loop =>
+            declare
+               Info : Loop_Info_Acc;
+               Num : Natural;
+            begin
+               Next_Expect (Tok_Num);
+               Num := Natural (Token_Number);
+               if Find_Loop (Num) /= null then
+                  Parse_Error ("loop label already defined");
+               end if;
+               Info := new Loop_Info;
+               Info.Num := Num;
+               Info.Prev := Loop_Stack;
+               Loop_Stack := Info;
+               Start_Loop_Stmt (Info.Blk);
+               Next_Expect (Tok_Colon);
+               Next_Token;
+               Parse_Statements;
+               Finish_Loop_Stmt (Info.Blk);
+               Next_Expect (Tok_Loop);
+               Next_Expect (Tok_Semicolon);
+               Loop_Stack := Info.Prev;
+               Free (Info);
+               Next_Token;
+            end;
+
+         when Tok_Exit
+           | Tok_Next =>
+            declare
+               Label : Loop_Info_Acc;
+               Etok : Token_Type;
+            begin
+               Etok := Tok;
+               Next_Expect (Tok_Loop);
+               Next_Expect (Tok_Num);
+               Label := Find_Loop (Natural (Token_Number));
+               if Label = null then
+                  Parse_Error ("no such loop");
+               end if;
+               if Etok = Tok_Exit then
+                  New_Exit_Stmt (Label.Blk);
+               else
+                  New_Next_Stmt (Label.Blk);
+               end if;
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+
+         when Tok_Return =>
+            declare
+               Res : O_Enode;
+               Res_Type : Node_Acc;
+            begin
+               Next_Token;
+               if Tok /= Tok_Semicolon then
+                  Parse_Expression (Current_Subprg.Decl_Dtype, Res, Res_Type);
+                  New_Return_Stmt (Res);
+                  if Tok /= Tok_Semicolon then
+                     Parse_Error ("';' expected at end of return statement");
+                  end if;
+               else
+                  New_Return_Stmt;
+               end if;
+               Next_Token;
+            end;
+
+         when Tok_Ident =>
+            --  This is either a procedure call or an assignment.
+            declare
+               Inter : Node_Acc;
+            begin
+               Inter := Get_Decl (Token_Sym);
+               Next_Token;
+               if Tok = Tok_Left_Paren then
+                  --  A procedure call.
+                  declare
+                     Constr : O_Assoc_List;
+                  begin
+                     Parse_Association (Constr, Inter);
+                     New_Procedure_Call (Constr);
+                     if Tok /= Tok_Semicolon then
+                        Parse_Error ("';' expected after call");
+                     end if;
+                     Next_Token;
+                     return;
+                  end;
+               else
+                  --  An assignment.
+                  declare
+                     Name : O_Lnode;
+                     Expr : O_Enode;
+                     Expr_Type : Node_Acc;
+                     N_Type : Node_Acc;
+                  begin
+                     Parse_Name (Inter, Name, N_Type);
+                     if Tok /= Tok_Assign then
+                        Parse_Error ("`:=' expected after a variable");
+                     end if;
+                     Next_Token;
+                     Parse_Expression (N_Type, Expr, Expr_Type);
+                     New_Assign_Stmt (Name, Expr);
+                     if Tok /= Tok_Semicolon then
+                        Parse_Error ("';' expected at end of assignment");
+                     end if;
+                     Next_Token;
+                     return;
+                  end;
+               end if;
+            end;
+
+         when Tok_Case =>
+            declare
+               Case_Blk : O_Case_Block;
+               L : O_Cnode;
+               Choice : O_Enode;
+               Choice_Type : Node_Acc;
+            begin
+               Next_Token;
+               Parse_Expression (null, Choice, Choice_Type);
+               Start_Case_Stmt (Case_Blk, Choice);
+               Expect (Tok_Is);
+               Next_Token;
+               loop
+                  exit when Tok = Tok_End;
+                  Expect (Tok_When);
+                  Next_Token;
+                  Start_Choice (Case_Blk);
+                  loop
+                     if Tok = Tok_Default then
+                        New_Default_Choice (Case_Blk);
+                        Next_Token;
+                     else
+                        L := Parse_Typed_Literal (Choice_Type);
+                        if Tok = Tok_Elipsis then
+                           Next_Token;
+                           New_Range_Choice
+                             (Case_Blk, L, Parse_Typed_Literal (Choice_Type));
+                        else
+                           New_Expr_Choice (Case_Blk, L);
+                        end if;
+                     end if;
+                     exit when Tok = Tok_Arrow;
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end loop;
+                  --  Skip '=>'.
+                  Next_Token;
+                  Finish_Choice (Case_Blk);
+                  Parse_Statements;
+               end loop;
+               Finish_Case_Stmt (Case_Blk);
+               Expect (Tok_End);
+               Next_Expect (Tok_Case);
+               Next_Expect (Tok_Semicolon);
+               Next_Token;
+            end;
+         when others =>
+            Parse_Error ("bad statement: " & Token_Type'Image (Tok));
+      end case;
+   end Parse_Statement;
+
+   procedure Parse_Compound_Statement is
+   begin
+      if Tok /= Tok_Declare then
+         Parse_Error ("'declare' expected to start a statements block");
+      end if;
+      Next_Token;
+
+      Push_Scope;
+
+      --  Parse declarations.
+      while Tok /= Tok_Begin loop
+         Parse_Declaration;
+      end loop;
+      Next_Token;
+
+      --  Parse statements.
+      Parse_Statements;
+      Expect (Tok_End);
+      Next_Token;
+
+      Pop_Scope;
+   end Parse_Compound_Statement;
+
+   --  Parse (P1 : T1; P2: T2; ...)
+   function Parse_Parameter_List return Node_Acc
+   is
+      First, Last : Node_Acc;
+      P : Node_Acc;
+   begin
+      Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok = Tok_Right_Paren then
+         Next_Token;
+         return null;
+      end if;
+      First := null;
+      Last := null;
+      loop
+         Expect (Tok_Ident);
+         P := new Node'(Kind => Decl_Param,
+                        Decl_Dtype => null,
+                        Decl_Storage => O_Storage_Public,
+                        Param_Node => O_Dnode_Null,
+                        Param_Name => Token_Sym,
+                        Param_Next => null);
+         --  Link
+         if Last = null then
+            First := P;
+         else
+            Last.Param_Next := P;
+         end if;
+         Last := P;
+         Next_Expect (Tok_Colon);
+         Next_Token;
+         P.Decl_Dtype := Parse_Type;
+         exit when Tok = Tok_Right_Paren;
+         Expect (Tok_Semicolon);
+         Next_Token;
+      end loop;
+      Next_Token;
+      return First;
+   end Parse_Parameter_List;
+
+   procedure Create_Interface_List (Constr : in out O_Inter_List;
+                                    First_Inter : Node_Acc)
+   is
+      Inter : Node_Acc;
+   begin
+      Inter := First_Inter;
+      while Inter /= null loop
+         New_Interface_Decl (Constr, Inter.Param_Node, Inter.Param_Name.Ident,
+                             Inter.Decl_Dtype.Type_Onode);
+         Inter := Inter.Param_Next;
+      end loop;
+   end Create_Interface_List;
+
+   procedure Check_Parameter_List (List : Node_Acc)
+   is
+      Param : Node_Acc;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      Param := List;
+      while Tok /= Tok_Right_Paren loop
+         if Param = null then
+            Parse_Error ("subprogram redefined with more parameters");
+         end if;
+         Expect (Tok_Ident);
+         if Token_Sym /= Param.Param_Name then
+            Parse_Error ("subprogram redefined with different parameter name");
+         end if;
+         Next_Expect (Tok_Colon);
+         Next_Token;
+         if Parse_Type /= Param.Decl_Dtype then
+            Parse_Error ("subprogram redefined with different parameter type");
+         end if;
+         Param := Param.Param_Next;
+         exit when Tok = Tok_Right_Paren;
+         Expect (Tok_Semicolon);
+         Next_Token;
+      end loop;
+      Expect (Tok_Right_Paren);
+      Next_Token;
+      if Param /= null then
+         Parse_Error ("subprogram redefined with less parameters");
+      end if;
+   end Check_Parameter_List;
+
+   procedure Parse_Subprogram_Body (Subprg : Node_Acc)
+   is
+      Param : Node_Acc;
+      Prev_Subprg : Node_Acc;
+   begin
+      Prev_Subprg := Current_Subprg;
+      Current_Subprg := Subprg;
+
+      Start_Subprogram_Body (Subprg.Subprg_Node);
+      Push_Scope;
+
+      --  Put parameters in the current scope.
+      Param := Subprg.Subprg_Params;
+      while Param /= null loop
+         Add_Decl (Param.Param_Name, Param);
+         Param := Param.Param_Next;
+      end loop;
+
+      Parse_Compound_Statement;
+
+      Pop_Scope;
+      Finish_Subprogram_Body;
+
+      Current_Subprg := Prev_Subprg;
+   end Parse_Subprogram_Body;
+
+   procedure Parse_Function_Definition (Storage : O_Storage)
+   is
+      Constr : O_Inter_List;
+      Sym : Syment_Acc;
+      N : Node_Acc;
+   begin
+      Expect (Tok_Function);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      if Sym.Name /= null then
+         N := Get_Decl (Sym);
+         Check_Parameter_List (N.Subprg_Params);
+         Expect (Tok_Return);
+         Next_Expect (Tok_Ident);
+         Next_Token;
+      else
+         N := new Node'(Kind => Node_Function,
+                        Decl_Dtype => null,
+                        Decl_Storage => Storage,
+                        Subprg_Node => O_Dnode_Null,
+                        Subprg_Name => Sym,
+                        Subprg_Params => null);
+         Next_Token;
+         N.Subprg_Params := Parse_Parameter_List;
+         Expect (Tok_Return);
+         Next_Token;
+         N.Decl_Dtype := Parse_Type;
+
+         Start_Function_Decl (Constr, N.Subprg_Name.Ident, Storage,
+                              N.Decl_Dtype.Type_Onode);
+         Create_Interface_List (Constr, N.Subprg_Params);
+         Finish_Subprogram_Decl (Constr, N.Subprg_Node);
+
+         Add_Decl (Sym, N);
+      end if;
+
+      if Tok = Tok_Declare then
+         Parse_Subprogram_Body (N);
+      end if;
+   end Parse_Function_Definition;
+
+   procedure Parse_Procedure_Definition (Storage : O_Storage)
+   is
+      Constr : O_Inter_List;
+      Sym : Syment_Acc;
+      N : Node_Acc;
+   begin
+      Expect (Tok_Procedure);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      if Sym.Name /= null then
+         N := Get_Decl (Sym);
+         Check_Parameter_List (N.Subprg_Params);
+      else
+         N := new Node'(Kind => Node_Procedure,
+                        Decl_Dtype => null,
+                        Decl_Storage => Storage,
+                        Subprg_Node => O_Dnode_Null,
+                        Subprg_Name => Sym,
+                        Subprg_Params => null);
+         Next_Token;
+         N.Subprg_Params := Parse_Parameter_List;
+
+         Start_Procedure_Decl (Constr, N.Subprg_Name.Ident, Storage);
+         Create_Interface_List (Constr, N.Subprg_Params);
+         Finish_Subprogram_Decl (Constr, N.Subprg_Node);
+
+         Add_Decl (Sym, N);
+      end if;
+
+      if Tok = Tok_Declare then
+         Parse_Subprogram_Body (N);
+      end if;
+   end Parse_Procedure_Definition;
+
+   function Parse_Address (Prefix : Node_Acc) return O_Enode
+   is
+      Pfx : Node_Acc;
+      N : O_Lnode;
+      N_Type : Node_Acc;
+      Res : O_Enode;
+      Attr : Syment_Acc;
+      T : O_Tnode;
+   begin
+      Attr := Token_Sym;
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Pfx := Get_Decl (Token_Sym);
+      T := Prefix.Decl_Dtype.Type_Onode;
+      if Attr = Id_Subprg_Addr then
+         Expect (Tok_Ident);
+         Pfx := Get_Decl (Token_Sym);
+         if Pfx.Kind not in Nodes_Subprogram then
+            Parse_Error ("subprogram identifier expected");
+         end if;
+         Res := New_Lit (New_Subprogram_Address (Pfx.Subprg_Node, T));
+         Next_Token;
+      else
+         Next_Token;
+         Parse_Name (Pfx, N, N_Type);
+         if Attr = Id_Address then
+            Res := New_Address (N, T);
+         elsif Attr = Id_Unchecked_Address then
+            Res := New_Unchecked_Address (N, T);
+         else
+            Parse_Error ("address attribute expected");
+         end if;
+      end if;
+      Expect (Tok_Right_Paren);
+      Next_Token;
+      return Res;
+   end Parse_Address;
+
+   function Parse_Constant_Address (Prefix : Node_Acc) return O_Cnode
+   is
+      Pfx : Node_Acc;
+      Res : O_Cnode;
+      Attr : Syment_Acc;
+      T : O_Tnode;
+   begin
+      Attr := Token_Sym;
+      Next_Expect (Tok_Left_Paren);
+      Next_Expect (Tok_Ident);
+      Pfx := Get_Decl (Token_Sym);
+      T := Prefix.Decl_Dtype.Type_Onode;
+      if Attr = Id_Subprg_Addr then
+         Expect (Tok_Ident);
+         Pfx := Get_Decl (Token_Sym);
+         if Pfx.Kind not in Nodes_Subprogram then
+            Parse_Error ("subprogram identifier expected");
+         end if;
+         Res := New_Subprogram_Address (Pfx.Subprg_Node, T);
+         Next_Token;
+      else
+         Next_Token;
+         if Attr = Id_Address then
+            Res := New_Global_Address (Pfx.Obj_Node, T);
+         elsif Attr = Id_Unchecked_Address then
+            Res := New_Global_Unchecked_Address (Pfx.Obj_Node, T);
+         else
+            Parse_Error ("address attribute expected");
+         end if;
+      end if;
+      Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Constant_Address;
+
+   function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      case Atype.Kind is
+         when Type_Subarray =>
+            declare
+               Constr : O_Array_Aggr_List;
+               El : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Start_Array_Aggr (Constr, Atype.Type_Onode);
+               El := Atype.Subarray_Base.Array_Element;
+               for I in Natural loop
+                  exit when Tok = Tok_Right_Brace;
+                  if I /= 0 then
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end if;
+                  New_Array_Aggr_El (Constr, Parse_Constant_Value (El));
+               end loop;
+               Finish_Array_Aggr (Constr, Res);
+               Next_Token;
+               return Res;
+            end;
+         when Type_Unsigned
+           | Type_Signed
+           | Type_Enum
+           | Type_Float
+           | Type_Boolean
+           | Type_Access =>
+            --return Parse_Primary_Expression (Atype);
+            return Parse_Typed_Literal (Atype);
+         when Type_Record =>
+            declare
+               Constr : O_Record_Aggr_List;
+               Field : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Start_Record_Aggr (Constr, Atype.Type_Onode);
+               Field := Atype.Record_Union_Fields;
+               while Field /= null loop
+                  if Tok = Tok_Dot then
+                     Next_Expect (Tok_Ident);
+                     if Token_Sym /= Field.Field_Ident then
+                        Parse_Error ("bad field name");
+                     end if;
+                     Next_Expect (Tok_Equal);
+                     Next_Token;
+                  end if;
+                  New_Record_Aggr_El
+                    (Constr, Parse_Constant_Value (Field.Field_Type));
+                  Field := Field.Field_Next;
+                  if Field /= null then
+                     Expect (Tok_Comma);
+                     Next_Token;
+                  end if;
+               end loop;
+               Finish_Record_Aggr (Constr, Res);
+               Expect (Tok_Right_Brace);
+               Next_Token;
+               return Res;
+            end;
+         when Type_Union =>
+            declare
+               Field : Node_Acc;
+            begin
+               Expect (Tok_Left_Brace);
+               Next_Token;
+               Expect (Tok_Dot);
+               Next_Expect (Tok_Ident);
+               Field := Find_Field_By_Name (Atype);
+               Next_Expect (Tok_Equal);
+               Next_Token;
+               Res := New_Union_Aggr
+                 (Atype.Type_Onode, Field.Field_Fnode,
+                  Parse_Constant_Value (Field.Field_Type));
+               Expect (Tok_Right_Brace);
+               Next_Token;
+               return Res;
+            end;
+         when others =>
+            raise Program_Error;
+      end case;
+   end Parse_Constant_Value;
+
+   procedure Parse_Constant_Declaration (Storage : O_Storage)
+   is
+      N : Node_Acc;
+      Sym : Syment_Acc;
+      --Val : O_Cnode;
+   begin
+      Expect (Tok_Constant);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      N := new Node'(Kind => Node_Object,
+                     Decl_Dtype => null,
+                     Decl_Storage => Storage,
+                     Obj_Name => Sym.Ident,
+                     Obj_Node => O_Dnode_Null);
+      Next_Expect (Tok_Colon);
+      Next_Token;
+      N.Decl_Dtype := Parse_Type;
+      New_Const_Decl (N.Obj_Node, Sym.Ident, Storage, N.Decl_Dtype.Type_Onode);
+      Add_Decl (Sym, N);
+
+--        if Storage /= O_Storage_External then
+--           Expect (Tok_Assign);
+--           Next_Token;
+--           Start_Const_Value (N.Obj_Node);
+--           Val := Parse_Constant_Value (N.Decl_Dtype);
+--           Finish_Const_Value (N.Obj_Node, Val);
+--        end if;
+   end Parse_Constant_Declaration;
+
+   procedure Parse_Constant_Value_Declaration
+   is
+      N : Node_Acc;
+      Val : O_Cnode;
+   begin
+      Next_Expect (Tok_Ident);
+      N := Get_Decl (Token_Sym);
+      if N.Kind /= Node_Object then
+         Parse_Error ("name of a constant expected");
+      end if;
+      --  FIXME: should check storage,
+      --         should check the object is a constant,
+      --         should check the object has no value.
+      Next_Expect (Tok_Assign);
+      Next_Token;
+      Start_Const_Value (N.Obj_Node);
+      Val := Parse_Constant_Value (N.Decl_Dtype);
+      Finish_Const_Value (N.Obj_Node, Val);
+   end Parse_Constant_Value_Declaration;
+
+   procedure Parse_Var_Declaration (Storage : O_Storage)
+   is
+      N : Node_Acc;
+      Sym : Syment_Acc;
+   begin
+      Expect (Tok_Var);
+      Next_Expect (Tok_Ident);
+      Sym := Token_Sym;
+      N := new Node'(Kind => Node_Object,
+                     Decl_Dtype => null,
+                     Decl_Storage => Storage,
+                     Obj_Name => Sym.Ident,
+                     Obj_Node => O_Dnode_Null);
+      Next_Expect (Tok_Colon);
+      Next_Token;
+      N.Decl_Dtype := Parse_Type;
+      New_Var_Decl (N.Obj_Node, Sym.Ident, Storage, N.Decl_Dtype.Type_Onode);
+      Add_Decl (Sym, N);
+   end Parse_Var_Declaration;
+
+   procedure Parse_Stored_Decl (Storage : O_Storage)
+   is
+   begin
+      Next_Token;
+      if Tok = Tok_Function then
+         Parse_Function_Definition (Storage);
+      elsif Tok = Tok_Procedure then
+         Parse_Procedure_Definition (Storage);
+      elsif Tok = Tok_Constant then
+         Parse_Constant_Declaration (Storage);
+      elsif Tok = Tok_Var then
+         Parse_Var_Declaration (Storage);
+      else
+         Parse_Error ("function declaration expected");
+      end if;
+   end Parse_Stored_Decl;
+
+   procedure Parse_Declaration
+   is
+      Inter : Node_Acc;
+      S : Syment_Acc;
+   begin
+      if Flag_Renumber then
+         New_Debug_Line_Decl (Lineno);
+      end if;
+
+      case Tok is
+         when Tok_Type =>
+            Next_Token;
+            if Tok /= Tok_Ident then
+               Parse_Error ("identifier for type expected");
+            end if;
+            S := Token_Sym;
+            Next_Expect (Tok_Is);
+            Next_Token;
+            if Is_Defined (S) then
+               Parse_Type_Completion (Get_Decl (S));
+            else
+               Inter := new Node'(Kind => Decl_Type,
+                                  Decl_Storage => O_Storage_Public,
+                                  Decl_Dtype => Parse_Type);
+               Add_Decl (S, Inter);
+               New_Type_Decl (S.Ident, Inter.Decl_Dtype.Type_Onode);
+            end if;
+         when Tok_External =>
+            Parse_Stored_Decl (O_Storage_External);
+         when Tok_Private =>
+            Parse_Stored_Decl (O_Storage_Private);
+         when Tok_Public =>
+            Parse_Stored_Decl (O_Storage_Public);
+         when Tok_Local =>
+            Parse_Stored_Decl (O_Storage_Local);
+         when Tok_Constant =>
+            Parse_Constant_Value_Declaration;
+         when Tok_Comment =>
+            New_Debug_Comment_Decl (Token_Ident (1 .. Token_Idlen));
+            Next_Token;
+            return;
+         when Tok_File_Name =>
+            if Flag_Renumber = False then
+               New_Debug_Filename_Decl (Token_Ident (1 .. Token_Idlen));
+            end if;
+            Next_Token;
+            return;
+         when others =>
+            Parse_Error ("declaration expected");
+      end case;
+      Expect (Tok_Semicolon);
+      Next_Token;
+   end Parse_Declaration;
+
+--    procedure Put (Str : String)
+--    is
+--       L : Integer;
+--    begin
+--       L := Write (Standout, Str'Address, Str'Length);
+--    end Put;
+
+   function Parse (Filename : String_Acc) return Boolean
+   is
+   begin
+      --  Initialize symbol table.
+      Add_Keyword ("type", Tok_Type);
+      Add_Keyword ("return", Tok_Return);
+      Add_Keyword ("if", Tok_If);
+      Add_Keyword ("then", Tok_Then);
+      Add_Keyword ("else", Tok_Else);
+      Add_Keyword ("elsif", Tok_Elsif);
+      Add_Keyword ("loop", Tok_Loop);
+      Add_Keyword ("exit", Tok_Exit);
+      Add_Keyword ("next", Tok_Next);
+      Add_Keyword ("signed", Tok_Signed);
+      Add_Keyword ("unsigned", Tok_Unsigned);
+      Add_Keyword ("float", Tok_Float);
+      Add_Keyword ("is", Tok_Is);
+      Add_Keyword ("of", Tok_Of);
+      Add_Keyword ("all", Tok_All);
+      Add_Keyword ("not", Tok_Not);
+      Add_Keyword ("abs", Tok_Abs);
+      Add_Keyword ("or", Tok_Or);
+      Add_Keyword ("and", Tok_And);
+      Add_Keyword ("xor", Tok_Xor);
+      Add_Keyword ("mod", Tok_Mod);
+      Add_Keyword ("rem", Tok_Rem);
+      Add_Keyword ("array", Tok_Array);
+      Add_Keyword ("access", Tok_Access);
+      Add_Keyword ("record", Tok_Record);
+      Add_Keyword ("union", Tok_Union);
+      Add_Keyword ("end", Tok_End);
+      Add_Keyword ("boolean", Tok_Boolean);
+      Add_Keyword ("enum", Tok_Enum);
+      Add_Keyword ("external", Tok_External);
+      Add_Keyword ("private", Tok_Private);
+      Add_Keyword ("public", Tok_Public);
+      Add_Keyword ("local", Tok_Local);
+      Add_Keyword ("procedure", Tok_Procedure);
+      Add_Keyword ("function", Tok_Function);
+      Add_Keyword ("constant", Tok_Constant);
+      Add_Keyword ("var", Tok_Var);
+      Add_Keyword ("subarray", Tok_Subarray);
+      Add_Keyword ("declare", Tok_Declare);
+      Add_Keyword ("begin", Tok_Begin);
+      Add_Keyword ("end", Tok_End);
+      Add_Keyword ("null", Tok_Null);
+      Add_Keyword ("case", Tok_Case);
+      Add_Keyword ("when", Tok_When);
+      Add_Keyword ("default", Tok_Default);
+
+      Id_Address := New_Symbol ("address");
+      Id_Unchecked_Address := New_Symbol ("unchecked_address");
+      Id_Subprg_Addr := New_Symbol ("subprg_addr");
+      Id_Conv := New_Symbol ("conv");
+      Id_Sizeof := New_Symbol ("sizeof");
+      Id_Alignof := New_Symbol ("alignof");
+      Id_Alloca := New_Symbol ("alloca");
+      Id_Offsetof := New_Symbol ("offsetof");
+
+      --  Initialize the scanner.
+      Buf (1) := NUL;
+      Pos := 1;
+      Lineno := 1;
+      if Filename = null then
+         Fd := Standin;
+         File_Name := new String'("*stdin*");
+      else
+         declare
+            Name : String (1 .. Filename'Length + 1);
+            --("C:\cygwin\home\tgingold\src\ortho\x86\tests\olang\ex2.ol",
+         begin
+            Name (1 .. Filename'Length) := Filename.all;
+            Name (Name'Last) := NUL;
+            File_Name := Filename;
+            Fd := Open_Read (Name'Address, Text);
+            if Fd = Invalid_FD then
+               Puterr ("cannot open '" & Filename.all & ''');
+               Newline_Err;
+               return False;
+            end if;
+         end;
+      end if;
+
+      New_Debug_Filename_Decl (File_Name.all);
+
+      Push_Scope;
+      Next_Token;
+      while Tok /= Tok_Eof loop
+         Parse_Declaration;
+      end loop;
+      Pop_Scope;
+
+      if Fd /= Standin then
+         Close (Fd);
+      end if;
+      return True;
+   exception
+      when E : others =>
+         Puterr (Ada.Exceptions.Exception_Information (E));
+         raise;
+   end Parse;
+end Ortho_Front;
diff --git a/src/ortho/ortho_front.ads b/src/ortho/ortho_front.ads
new file mode 100644
index 000000000..1d20e15d7
--- /dev/null
+++ b/src/ortho/ortho_front.ads
@@ -0,0 +1,41 @@
+--  Ortho front-end specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+package Ortho_Front is
+   type String_Acc is access String;
+
+   --  Called before decode_option.
+   --  This procedure can only do internal initializations.  It cannot call
+   --  ortho subprograms.
+   procedure Init;
+
+   --  An ortho back-end decodes the command line.  Unknown options may
+   --  be decoded by the user, with this function.
+   --  When an ortho back-end encounter an unknown option, it sets OPT with
+   --  this option and ARG with the next one, if any.
+   --
+   --  DECODE_OPTION must return the number of argument used, ie:
+   --   0 if OPT is unknown.
+   --   1 if OPT is known but ARG is unused.
+   --   2 if OPT is known and ARG used.
+   function Decode_Option (Opt : String_Acc; Arg : String_Acc) return Natural;
+
+   --  Start to parse file FILENAME.
+   --  Return False in case of error.
+   function Parse (Filename : String_Acc) return Boolean;
+end Ortho_Front;
diff --git a/src/ortho/ortho_jit.ads b/src/ortho/ortho_jit.ads
new file mode 100644
index 000000000..89c3663f3
--- /dev/null
+++ b/src/ortho/ortho_jit.ads
@@ -0,0 +1,43 @@
+--  Ortho JIT specifications.
+--  Copyright (C) 2009 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; use System;
+with Ortho_Nodes; use Ortho_Nodes;
+
+package Ortho_Jit is
+   --  Initialize the whole engine.
+   procedure Init;
+
+   --  Set address of non-defined global variables or functions.
+   procedure Set_Address (Decl : O_Dnode; Addr : Address);
+   --  Get address of a global.
+   function Get_Address (Decl : O_Dnode) return Address;
+
+   --  Do link.
+   procedure Link (Status : out Boolean);
+
+   --  Release memory (but the generated code).
+   procedure Finish;
+
+   function Decode_Option (Option : String) return Boolean;
+   procedure Disp_Help;
+
+   --  Return the name of the code generator, to be displayed by --version.
+   function Get_Jit_Name return String;
+end Ortho_Jit;
+
diff --git a/src/ortho/ortho_nodes.common.ads b/src/ortho/ortho_nodes.common.ads
new file mode 100644
index 000000000..178187482
--- /dev/null
+++ b/src/ortho/ortho_nodes.common.ads
@@ -0,0 +1,453 @@
+--  Ortho specifications.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Interfaces; use Interfaces;
+with Ortho_Ident;
+use Ortho_Ident;
+
+--  Interface to create nodes.
+package ORTHO_NODES is
+
+   type O_Enode is private;
+   type O_Cnode is private;
+   type O_Lnode is private;
+   type O_Tnode is private;
+   type O_Snode is private;
+   type O_Dnode is private;
+   type O_Fnode is private;
+
+   O_Cnode_Null : constant O_Cnode;
+   O_Dnode_Null : constant O_Dnode;
+   O_Enode_Null : constant O_Enode;
+   O_Fnode_Null : constant O_Fnode;
+   O_Lnode_Null : constant O_Lnode;
+   O_Snode_Null : constant O_Snode;
+   O_Tnode_Null : constant O_Tnode;
+
+   --  True if the code generated supports nested subprograms.
+   Has_Nested_Subprograms : constant Boolean;
+
+   ------------------------
+   --  Type definitions  --
+   ------------------------
+
+   type O_Element_List is limited private;
+
+   --  Build a record type.
+   procedure Start_Record_Type (Elements : out O_Element_List);
+   --  Add a field in the record; not constrained array are prohibited, since
+   --  its size is unlimited.
+   procedure New_Record_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident; Etype : O_Tnode);
+   --  Finish the record type.
+   procedure Finish_Record_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   -- Build an uncomplete record type:
+   -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
+   -- This type can be declared or used to define access types on it.
+   -- Then, complete (if necessary) the record type, by calling
+   -- START_UNCOMPLETE_RECORD_TYPE, NEW_RECORD_FIELD and FINISH_RECORD_TYPE.
+   procedure New_Uncomplete_Record_Type (Res : out O_Tnode);
+   procedure Start_Uncomplete_Record_Type (Res : O_Tnode;
+                                           Elements : out O_Element_List);
+
+   --  Build an union type.
+   procedure Start_Union_Type (Elements : out O_Element_List);
+   procedure New_Union_Field
+     (Elements : in out O_Element_List;
+      El : out O_Fnode;
+      Ident : O_Ident;
+      Etype : O_Tnode);
+   procedure Finish_Union_Type
+     (Elements : in out O_Element_List; Res : out O_Tnode);
+
+   --  Build an access type.
+   --  DTYPE may be O_tnode_null in order to build an incomplete access type.
+   --  It is completed with finish_access_type.
+   function New_Access_Type (Dtype : O_Tnode) return O_Tnode;
+   procedure Finish_Access_Type (Atype : O_Tnode; Dtype : O_Tnode);
+
+   --  Build an array type.
+   --  The array is not constrained and unidimensional.
+   function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode)
+     return O_Tnode;
+
+   --  Build a constrained array type.
+   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
+     return O_Tnode;
+
+   --  Build a scalar type; size may be 8, 16, 32 or 64.
+   function New_Unsigned_Type (Size : Natural) return O_Tnode;
+   function New_Signed_Type (Size : Natural) return O_Tnode;
+
+   --  Build a float type.
+   function New_Float_Type return O_Tnode;
+
+   --  Build a boolean type.
+   procedure New_Boolean_Type (Res : out O_Tnode;
+                               False_Id : O_Ident;
+                               False_E : out O_Cnode;
+                               True_Id : O_Ident;
+                               True_E : out O_Cnode);
+
+   --  Create an enumeration
+   type O_Enum_List is limited private;
+
+   --  Elements are declared in order, the first is ordered from 0.
+   procedure Start_Enum_Type (List : out O_Enum_List; Size : Natural);
+   procedure New_Enum_Literal (List : in out O_Enum_List;
+                               Ident : O_Ident; Res : out O_Cnode);
+   procedure Finish_Enum_Type (List : in out O_Enum_List; Res : out O_Tnode);
+
+   ----------------
+   --  Literals  --
+   ----------------
+
+   --  Create a literal from an integer.
+   function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64)
+     return O_Cnode;
+   function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64)
+     return O_Cnode;
+
+   function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64)
+     return O_Cnode;
+
+   --  Create a null access literal.
+   function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
+
+   --  Build a record/array aggregate.
+   --  The aggregate is constant, and therefore can be only used to initialize
+   --  constant declaration.
+   --  ATYPE must be either a record type or an array subtype.
+   --  Elements must be added in the order, and must be literals or aggregates.
+   type O_Record_Aggr_List is limited private;
+   type O_Array_Aggr_List is limited private;
+
+   procedure Start_Record_Aggr (List : out O_Record_Aggr_List;
+                                Atype : O_Tnode);
+   procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List;
+                                 Value : O_Cnode);
+   procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List;
+                                 Res : out O_Cnode);
+
+   procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode);
+   procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List;
+                                Value : O_Cnode);
+   procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List;
+                                Res : out O_Cnode);
+
+   --  Build an union aggregate.
+   function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode)
+                           return O_Cnode;
+
+   --  Returns the size in bytes of ATYPE.  The result is a literal of
+   --  unsigned type RTYPE
+   --  ATYPE cannot be an unconstrained array type.
+   function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
+   --  Returns the offset of FIELD in its record ATYPE.  The result is a
+   --  literal of unsigned type or access type RTYPE.
+   function New_Offsetof (Atype : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+                         return O_Cnode;
+
+   --  Get the address of a subprogram.
+   function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode)
+                               return O_Cnode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+     return O_Cnode;
+
+   -------------------
+   --  Expressions  --
+   -------------------
+
+   type ON_Op_Kind is
+     (
+      --  Not an operation; invalid.
+      ON_Nil,
+
+      --  Dyadic operations.
+      ON_Add_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Sub_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mul_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Div_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Rem_Ov,                --  ON_Dyadic_Op_Kind
+      ON_Mod_Ov,                --  ON_Dyadic_Op_Kind
+
+      --  Binary operations.
+      ON_And,                   --  ON_Dyadic_Op_Kind
+      ON_Or,                    --  ON_Dyadic_Op_Kind
+      ON_Xor,                   --  ON_Dyadic_Op_Kind
+
+      --  Monadic operations.
+      ON_Not,                   --  ON_Monadic_Op_Kind
+      ON_Neg_Ov,                --  ON_Monadic_Op_Kind
+      ON_Abs_Ov,                --  ON_Monadic_Op_Kind
+
+      --  Comparaisons
+      ON_Eq,                    --  ON_Compare_Op_Kind
+      ON_Neq,                   --  ON_Compare_Op_Kind
+      ON_Le,                    --  ON_Compare_Op_Kind
+      ON_Lt,                    --  ON_Compare_Op_Kind
+      ON_Ge,                    --  ON_Compare_Op_Kind
+      ON_Gt                     --  ON_Compare_Op_Kind
+      );
+
+   subtype ON_Dyadic_Op_Kind is ON_Op_Kind range ON_Add_Ov .. ON_Xor;
+   subtype ON_Monadic_Op_Kind is ON_Op_Kind range ON_Not .. ON_Abs_Ov;
+   subtype ON_Compare_Op_Kind is ON_Op_Kind range ON_Eq .. ON_Gt;
+
+   type O_Storage is (O_Storage_External,
+                      O_Storage_Public,
+                      O_Storage_Private,
+                      O_Storage_Local);
+   --  Specifies the storage kind of a declaration.
+   --  O_STORAGE_EXTERNAL:
+   --    The declaration do not either reserve memory nor generate code, and
+   --    is imported either from an other file or from a later place in the
+   --    current file.
+   --  O_STORAGE_PUBLIC, O_STORAGE_PRIVATE:
+   --    The declaration reserves memory or generates code.
+   --    With O_STORAGE_PUBLIC, the declaration is exported outside of the
+   --    file while with O_STORAGE_PRIVATE, the declaration is local to the
+   --    file.
+
+   Type_Error : exception;
+   Syntax_Error : exception;
+
+   --  Create a value from a literal.
+   function New_Lit (Lit : O_Cnode) return O_Enode;
+
+   --  Create a dyadic operation.
+   --  Left and right nodes must have the same type.
+   --  Binary operation is allowed only on boolean types.
+   --  The result is of the type of the operands.
+   function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode)
+     return O_Enode;
+
+   --  Create a monadic operation.
+   --  Result is of the type of operand.
+   function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode)
+     return O_Enode;
+
+   --  Create a comparaison operator.
+   --  NTYPE is the type of the result and must be a boolean type.
+   function New_Compare_Op
+     (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode)
+     return O_Enode;
+
+
+   type O_Inter_List is limited private;
+   type O_Assoc_List is limited private;
+   type O_If_Block is limited private;
+   type O_Case_Block is limited private;
+
+
+   --  Get an element of an array.
+   --  INDEX must be of the type of the array index.
+   function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get a slice of an array; this is equivalent to a conversion between
+   --  an array or an array subtype and an array subtype.
+   --  RES_TYPE must be an array_sub_type whose base type is the same as the
+   --  base type of ARR.
+   --  INDEX must be of the type of the array index.
+   function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
+     return O_Lnode;
+
+   --  Get an element of a record.
+   --  Type of REC must be a record type.
+   function New_Selected_Element (Rec : O_Lnode; El : O_Fnode)
+     return O_Lnode;
+
+   --  Reference an access.
+   --  Type of ACC must be an access type.
+   function New_Access_Element (Acc : O_Enode) return O_Lnode;
+
+   --  Do a conversion.
+   --  Allowed conversions are:
+   --  FIXME: to write.
+   function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode;
+
+   --  Get the address of LVALUE.
+   --  ATYPE must be a type access whose designated type is the type of LVALUE.
+   --  FIXME: what about arrays.
+   function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode;
+
+   --  Same as New_Address but without any restriction.
+   function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode)
+     return O_Enode;
+
+   --  Get the value of an Lvalue.
+   function New_Value (Lvalue : O_Lnode) return O_Enode;
+   function New_Obj_Value (Obj : O_Dnode) return O_Enode;
+
+   --  Get an lvalue from a declaration.
+   function New_Obj (Obj : O_Dnode) return O_Lnode;
+
+   --  Return a pointer of type RTPE to SIZE bytes allocated on the stack.
+   function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode;
+
+   --  Declare a type.
+   --  This simply gives a name to a type.
+   procedure New_Type_Decl (Ident : O_Ident; Atype : O_Tnode);
+
+   ---------------------
+   --  Declarations.  --
+   ---------------------
+
+   --  Filename of the next declaration.
+   procedure New_Debug_Filename_Decl (Filename : String);
+
+   --  Line number of the next declaration.
+   procedure New_Debug_Line_Decl (Line : Natural);
+
+   --  Add a comment in the declarative region.
+   procedure New_Debug_Comment_Decl (Comment : String);
+
+   --  Declare a constant.
+   --  This simply gives a name to a constant value or aggregate.
+   --  A constant cannot be modified and its storage cannot be local.
+   --  ATYPE must be constrained.
+   procedure New_Const_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Set the value of a non-external constant.
+   procedure Start_Const_Value (Const : in out O_Dnode);
+   procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode);
+
+   --  Create a variable declaration.
+   --  A variable can be local only inside a function.
+   --  ATYPE must be constrained.
+   procedure New_Var_Decl
+     (Res : out O_Dnode;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Atype : O_Tnode);
+
+   --  Start a subprogram declaration.
+   --  Note: nested subprograms are allowed, ie o_storage_local subprograms can
+   --   be declared inside a subprograms.  It is not allowed to declare
+   --   o_storage_external subprograms inside a subprograms.
+   --  Return type and interfaces cannot be a composite type.
+   procedure Start_Function_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage;
+      Rtype : O_Tnode);
+   --  For a subprogram without return value.
+   procedure Start_Procedure_Decl
+     (Interfaces : out O_Inter_List;
+      Ident : O_Ident;
+      Storage : O_Storage);
+
+   --  Add an interface declaration to INTERFACES.
+   procedure New_Interface_Decl
+     (Interfaces : in out O_Inter_List;
+      Res : out O_Dnode;
+      Ident : O_Ident;
+      Atype : O_Tnode);
+   --  Finish the function declaration, get the node and a statement list.
+   procedure Finish_Subprogram_Decl
+     (Interfaces : in out O_Inter_List; Res : out O_Dnode);
+   --  Start a subprogram body.
+   --  Note: the declaration may have an external storage, in this case it
+   --  becomes public.
+   procedure Start_Subprogram_Body (Func : O_Dnode);
+   --  Finish a subprogram body.
+   procedure Finish_Subprogram_Body;
+
+
+   -------------------
+   --  Statements.  --
+   -------------------
+
+   --  Add a line number as a statement.
+   procedure New_Debug_Line_Stmt (Line : Natural);
+
+   --  Add a comment as a statement.
+   procedure New_Debug_Comment_Stmt (Comment : String);
+
+   --  Start a declarative region.
+   procedure Start_Declare_Stmt;
+   procedure Finish_Declare_Stmt;
+
+   --  Create a function call or a procedure call.
+   procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode);
+   procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode);
+   function New_Function_Call (Assocs : O_Assoc_List) return O_Enode;
+   procedure New_Procedure_Call (Assocs : in out O_Assoc_List);
+
+   --  Assign VALUE to TARGET, type must be the same or compatible.
+   --  FIXME: what about slice assignment?
+   procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode);
+
+   --  Exit from the subprogram and return VALUE.
+   procedure New_Return_Stmt (Value : O_Enode);
+   --  Exit from the subprogram, which doesn't return value.
+   procedure New_Return_Stmt;
+
+   --  Build an IF statement.
+   procedure Start_If_Stmt (Block : in out O_If_Block; Cond : O_Enode);
+   procedure New_Else_Stmt (Block : in out O_If_Block);
+   procedure Finish_If_Stmt (Block : in out O_If_Block);
+
+   --  Create a infinite loop statement.
+   procedure Start_Loop_Stmt (Label : out O_Snode);
+   procedure Finish_Loop_Stmt (Label : in out O_Snode);
+
+   --  Exit from a loop stmt or from a for stmt.
+   procedure New_Exit_Stmt (L : O_Snode);
+   --  Go to the start of a loop stmt or of a for stmt.
+   --  Loops/Fors between L and the current points are exited.
+   procedure New_Next_Stmt (L : O_Snode);
+
+   --  Case statement.
+   --  VALUE is the selector and must be a discrete type.
+   procedure Start_Case_Stmt (Block : in out O_Case_Block; Value : O_Enode);
+   --  A choice branch is composed of expr, range or default choices.
+   --  A choice branch is enclosed between a Start_Choice and a Finish_Choice.
+   --  The statements are after the finish_choice.
+   procedure Start_Choice (Block : in out O_Case_Block);
+   procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode);
+   procedure New_Range_Choice (Block : in out O_Case_Block;
+                               Low, High : O_Cnode);
+   procedure New_Default_Choice (Block : in out O_Case_Block);
+   procedure Finish_Choice (Block : in out O_Case_Block);
+   procedure Finish_Case_Stmt (Block : in out O_Case_Block);
+
+private
+   --- PRIVATE PART is defined by ortho_nodes.ads in one of the subdirectory.
+end ORTHO_NODES;
diff --git a/src/parse.adb b/src/parse.adb
new file mode 100644
index 000000000..97ff87691
--- /dev/null
+++ b/src/parse.adb
@@ -0,0 +1,7143 @@
+--  VHDL parser.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iir_Chains; use Iir_Chains;
+with Ada.Text_IO; use Ada.Text_IO;
+with Types; use Types;
+with Tokens; use Tokens;
+with Scanner; use Scanner;
+with Iirs_Utils; use Iirs_Utils;
+with Errorout; use Errorout;
+with Std_Names; use Std_Names;
+with Flags; use Flags;
+with Parse_Psl;
+with Name_Table;
+with Str_Table;
+with Xrefs;
+
+--  Recursive descendant parser.
+--  Each subprogram (should) parse one production rules.
+--  Rules are written in a comment just before the subprogram.
+--  terminals are written in upper case.
+--  non-terminal are written in lower case.
+--  syntaxic category of a non-terminal are written in upper case.
+--  eg: next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ;
+--  Or (|) must be aligned by the previous or, or with the '=' character.
+--  Indentation is 4.
+--
+--  To document what is expected for input and what is left as an output
+--  concerning token stream, a precond and a postcond comment shoud be
+--  added before the above rules.
+--    a token (such as IF or ';') means the current token is this token.
+--    'a token' means the current token was analysed.
+--    'next token' means the current token is to be analysed.
+
+
+package body Parse is
+
+   -- current_token must be valid.
+   -- Leaves a token.
+   function Parse_Simple_Expression (Primary : Iir := Null_Iir)
+                                    return Iir_Expression;
+   function Parse_Primary return Iir_Expression;
+   function Parse_Use_Clause return Iir_Use_Clause;
+
+   function Parse_Association_List return Iir;
+   function Parse_Association_List_In_Parenthesis return Iir;
+
+   function Parse_Sequential_Statements (Parent : Iir) return Iir;
+   function Parse_Configuration_Item return Iir;
+   function Parse_Block_Configuration return Iir_Block_Configuration;
+   procedure Parse_Concurrent_Statements (Parent : Iir);
+   function Parse_Subprogram_Declaration (Parent : Iir) return Iir;
+   function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir;
+   procedure Parse_Component_Specification (Res : Iir);
+   function Parse_Binding_Indication return Iir_Binding_Indication;
+   function Parse_Aggregate return Iir;
+   function Parse_Signature return Iir_Signature;
+   procedure Parse_Declarative_Part (Parent : Iir);
+   function Parse_Tolerance_Aspect_Opt return Iir;
+
+   Expect_Error: exception;
+
+   -- Copy the current location into an iir.
+   procedure Set_Location (Node : Iir) is
+   begin
+      Set_Location (Node, Get_Token_Location);
+   end Set_Location;
+
+   procedure Set_End_Location (Node : Iir) is
+   begin
+      Set_End_Location (Node, Get_Token_Location);
+   end Set_End_Location;
+
+   procedure Unexpected (Where: String) is
+   begin
+      Error_Msg_Parse
+        ("unexpected token '" & Image (Current_Token) & "' in a " & Where);
+   end Unexpected;
+
+--   procedure Unexpected_Eof is
+--   begin
+--      Error_Msg_Parse ("unexpected end of file");
+--   end Unexpected_Eof;
+
+   --  Emit an error if the current_token if different from TOKEN.
+   --  Otherwise, accept the current_token (ie set it to tok_invalid, unless
+   --  TOKEN is Tok_Identifier).
+   procedure Expect (Token: Token_Type; Msg: String := "") is
+   begin
+      if Current_Token /= Token then
+         if Msg'Length > 0 then
+            Error_Msg_Parse (Msg);
+            Error_Msg_Parse ("(found: " & Image (Current_Token) & ")");
+         else
+            Error_Msg_Parse
+              (''' & Image(Token) & "' is expected instead of '"
+               & Image (Current_Token) & ''');
+         end if;
+         raise Expect_Error;
+      end if;
+
+      -- Accept the current_token.
+      if Current_Token /= Tok_Identifier then
+         Invalidate_Current_Token;
+      end if;
+   exception
+      when Parse_Error =>
+         Put_Line ("found " & Token_Type'Image (Current_Token));
+         if Current_Token = Tok_Identifier then
+            Put_Line ("identifier: " & Name_Table.Image (Current_Identifier));
+         end if;
+         raise;
+   end Expect;
+
+   --  Scan a token and expect it.
+   procedure Scan_Expect (Token: Token_Type; Msg: String := "") is
+   begin
+      Scan;
+      Expect (Token, Msg);
+   end Scan_Expect;
+
+   --  If the current_token is an identifier, it must be equal to name.
+   --  In this case, a token is eaten.
+   --  If the current_token is not an identifier, this is a noop.
+   procedure Check_End_Name (Name : Name_Id; Decl : Iir) is
+   begin
+      if Current_Token /= Tok_Identifier then
+         return;
+      end if;
+      if Name = Null_Identifier then
+         Error_Msg_Parse
+           ("end label for an unlabeled declaration or statement");
+      else
+         if Current_Identifier /= Name then
+            Error_Msg_Parse
+              ("mispelling, """ & Name_Table.Image (Name) & """ expected");
+         else
+            Set_End_Has_Identifier (Decl, True);
+            Xrefs.Xref_End (Get_Token_Location, Decl);
+         end if;
+      end if;
+      Scan;
+   end Check_End_Name;
+
+   procedure Check_End_Name (Decl : Iir) is
+   begin
+      Check_End_Name (Get_Identifier (Decl), Decl);
+   end Check_End_Name;
+
+
+   --  Expect ' END tok [ name ] ; '
+   procedure Check_End_Name (Tok : Token_Type; Decl : Iir) is
+   begin
+      if Current_Token /= Tok_End then
+         Error_Msg_Parse ("""end " & Image (Tok) & ";"" expected");
+      else
+         Scan;
+         if Current_Token /= Tok then
+            Error_Msg_Parse
+              ("""end"" must be followed by """ & Image (Tok) & """");
+         else
+            Set_End_Has_Reserved_Id (Decl, True);
+            Scan;
+         end if;
+         Check_End_Name (Decl);
+         Expect (Tok_Semi_Colon);
+      end if;
+   end Check_End_Name;
+
+   procedure Eat_Tokens_Until_Semi_Colon is
+   begin
+      loop
+         case Current_Token is
+            when Tok_Semi_Colon
+              | Tok_Eof =>
+               exit;
+            when others =>
+               Scan;
+         end case;
+      end loop;
+   end Eat_Tokens_Until_Semi_Colon;
+
+   --  Expect and scan ';' emit an error message using MSG if not present.
+   procedure Scan_Semi_Colon (Msg : String) is
+   begin
+      if Current_Token /= Tok_Semi_Colon then
+         Error_Msg_Parse ("missing "";"" at end of " & Msg);
+      else
+         Scan;
+      end if;
+   end Scan_Semi_Colon;
+
+   --  precond : next token
+   --  postcond: next token.
+   --
+   --  [§ 4.3.2 ]
+   --  mode ::= IN | OUT | INOUT | BUFFER | LINKAGE
+   --
+   --  If there is no mode, DEFAULT is returned.
+   function Parse_Mode (Default: Iir_Mode) return Iir_Mode is
+   begin
+      case Current_Token is
+         when Tok_Identifier =>
+            return Default;
+         when Tok_In =>
+            Scan;
+            if Current_Token = Tok_Out then
+               --  Nice message for Ada users...
+               Error_Msg_Parse ("typo error, in out must be 'inout' in vhdl");
+               Scan;
+               return Iir_Inout_Mode;
+            end if;
+            return Iir_In_Mode;
+         when Tok_Out =>
+            Scan;
+            return Iir_Out_Mode;
+         when Tok_Inout =>
+            Scan;
+            return Iir_Inout_Mode;
+         when Tok_Linkage =>
+            Scan;
+            return Iir_Linkage_Mode;
+         when Tok_Buffer =>
+            Scan;
+            return Iir_Buffer_Mode;
+         when others =>
+            Error_Msg_Parse
+              ("mode is 'in', 'out', 'inout', 'buffer' or 'linkage'");
+            return Iir_In_Mode;
+      end case;
+   end Parse_Mode;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §4.3.1.2 ]
+   --  signal_kind ::= REGISTER | BUS
+   --
+   --  If there is no signal_kind, then no_signal_kind is returned.
+   function Parse_Signal_Kind return Iir_Signal_Kind is
+   begin
+      if Current_Token = Tok_Bus then
+         Scan;
+         return Iir_Bus_Kind;
+      elsif Current_Token = Tok_Register then
+         Scan;
+         return Iir_Register_Kind;
+      else
+         return Iir_No_Signal_Kind;
+      end if;
+   end Parse_Signal_Kind;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   -- Parse a range.
+   -- If LEFT is not null_iir, then it must be an expression corresponding to
+   -- the left limit of the range, and the current_token must be either
+   -- tok_to or tok_downto.
+   -- If left is null_iir, the current token is used to create the left limit
+   -- expression.
+   --
+   -- [3.1]
+   -- range ::= RANGE_attribute_name
+   --         | simple_expression direction simple_expression
+   function Parse_Range_Expression (Left: Iir; Discrete: Boolean := False)
+                                   return Iir
+   is
+      Res : Iir;
+      Left1: Iir;
+   begin
+      if Left /= Null_Iir then
+         Left1 := Left;
+      else
+         Left1 := Parse_Simple_Expression;
+      end if;
+
+      case Current_Token is
+         when Tok_To =>
+            Res := Create_Iir (Iir_Kind_Range_Expression);
+            Set_Direction (Res, Iir_To);
+         when Tok_Downto =>
+            Res := Create_Iir (Iir_Kind_Range_Expression);
+            Set_Direction (Res, Iir_Downto);
+         when Tok_Range =>
+            if not Discrete then
+               Unexpected ("range definition");
+            end if;
+            Scan;
+            if Current_Token = Tok_Box then
+               Unexpected ("range expression expected");
+               Scan;
+               return Null_Iir;
+            end if;
+            Res := Parse_Range_Expression (Null_Iir, False);
+            if Res /= Null_Iir then
+               Set_Type (Res, Left1);
+            end if;
+            return Res;
+         when others =>
+            if Left1 = Null_Iir then
+               return Null_Iir;
+            end if;
+            if Is_Range_Attribute_Name (Left1) then
+               return Left1;
+            end if;
+            if Discrete
+              and then Get_Kind (Left1) in Iir_Kinds_Denoting_Name
+            then
+               return Left1;
+            end if;
+            Error_Msg_Parse ("'to' or 'downto' expected");
+            return Null_Iir;
+      end case;
+      Set_Left_Limit (Res, Left1);
+      Location_Copy (Res, Left1);
+
+      Scan;
+      Set_Right_Limit (Res, Parse_Simple_Expression);
+      return Res;
+   end Parse_Range_Expression;
+
+   --  [ 3.1 ]
+   --  range_constraint ::= RANGE range
+   --
+   --  [ 3.1 ]
+   --  range ::= range_attribute_name
+   --          | simple_expression direction simple_expression
+   --
+   --  [ 3.1 ]
+   --  direction ::= TO | DOWNTO
+
+   --  precond:  TO or DOWNTO
+   --  postcond: next token
+   function Parse_Range_Right (Left : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Range_Expression);
+      Set_Location (Res);
+      Set_Left_Limit (Res, Left);
+
+      case Current_Token is
+         when Tok_To =>
+            Set_Direction (Res, Iir_To);
+         when Tok_Downto =>
+            Set_Direction (Res, Iir_Downto);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Scan;
+      Set_Right_Limit (Res, Parse_Simple_Expression);
+      return Res;
+   end Parse_Range_Right;
+
+   --  precond:  next token
+   --  postcond: next token
+   function Parse_Range return Iir
+   is
+      Left: Iir;
+   begin
+      Left := Parse_Simple_Expression;
+
+      case Current_Token is
+         when Tok_To
+           | Tok_Downto =>
+            return Parse_Range_Right (Left);
+         when others =>
+            if Left /= Null_Iir then
+               if Is_Range_Attribute_Name (Left) then
+                  return Left;
+               end if;
+               Error_Msg_Parse ("'to' or 'downto' expected");
+            end if;
+            return Null_Iir;
+      end case;
+   end Parse_Range;
+
+   --  precond:  next token (after RANGE)
+   --  postcond: next token
+   function Parse_Range_Constraint return Iir is
+   begin
+      if Current_Token = Tok_Box then
+         Error_Msg_Parse ("range constraint required");
+         Scan;
+         return Null_Iir;
+      end if;
+
+      return Parse_Range;
+   end Parse_Range_Constraint;
+
+   --  precond:  next token (after RANGE)
+   --  postcond: next token
+   function Parse_Range_Constraint_Of_Subtype_Indication
+     (Type_Mark : Iir;
+      Resolution_Indication : Iir := Null_Iir)
+     return Iir
+   is
+      Def : Iir;
+   begin
+      Def := Create_Iir (Iir_Kind_Subtype_Definition);
+      Location_Copy (Def, Type_Mark);
+      Set_Subtype_Type_Mark (Def, Type_Mark);
+      Set_Range_Constraint (Def, Parse_Range_Constraint);
+      Set_Resolution_Indication (Def, Resolution_Indication);
+      Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt);
+
+      return Def;
+   end Parse_Range_Constraint_Of_Subtype_Indication;
+
+   --  precond:  next token
+   --  postcond: next token
+   --
+   --  [ 3.2.1 ]
+   --  discrete_range ::= discrete_subtype_indication | range
+   function Parse_Discrete_Range return Iir
+   is
+      Left: Iir;
+   begin
+      Left := Parse_Simple_Expression;
+
+      case Current_Token is
+         when Tok_To
+           | Tok_Downto =>
+            return Parse_Range_Right (Left);
+         when Tok_Range =>
+            return Parse_Subtype_Indication (Left);
+         when others =>
+            --  Either a /range/_attribute_name or a type_mark.
+            return Left;
+      end case;
+   end Parse_Discrete_Range;
+
+   --  Convert the STR (0 .. LEN - 1) into a operator symbol identifier.
+   --  Emit an error message if the name is not an operator name.
+   function Str_To_Operator_Name (Str : String_Fat_Acc;
+                                  Len : Nat32;
+                                  Loc : Location_Type) return Name_Id
+   is
+      --  LRM93 2.1
+      --  Extra spaces are not allowed in an operator symbol, and the
+      --  case of letters is not signifiant.
+
+      --  LRM93 2.1
+      --  The sequence of characters represented by an operator symbol
+      --  must be an operator belonging to one of classes of operators
+      --  defined in section 7.2.
+
+      procedure Bad_Operator_Symbol is
+      begin
+         Error_Msg_Parse ("""" & String (Str (1 .. Len))
+                          & """ is not an operator symbol", Loc);
+      end Bad_Operator_Symbol;
+
+      procedure Check_Vhdl93 is
+      begin
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("""" & String (Str (1 .. Len))
+                             & """ is not a vhdl87 operator symbol", Loc);
+         end if;
+      end Check_Vhdl93;
+
+      Id : Name_Id;
+      C1, C2, C3, C4 : Character;
+   begin
+      C1 := Str (1);
+      case Len is
+         when 1 =>
+            --  =, <, >, +, -, *, /, &
+            case C1 is
+               when '=' =>
+                  Id := Name_Op_Equality;
+               when '>' =>
+                  Id := Name_Op_Greater;
+               when '<' =>
+                  Id := Name_Op_Less;
+               when '+' =>
+                  Id := Name_Op_Plus;
+               when '-' =>
+                  Id := Name_Op_Minus;
+               when '*' =>
+                  Id := Name_Op_Mul;
+               when '/' =>
+                  Id := Name_Op_Div;
+               when '&' =>
+                  Id := Name_Op_Concatenation;
+               when others =>
+                  Bad_Operator_Symbol;
+                  Id := Name_Op_Plus;
+            end case;
+         when 2 =>
+            --  or, /=, <=, >=, **
+            C2 := Str (2);
+            case C1 is
+               when 'o' | 'O' =>
+                  Id := Name_Or;
+                  if C2 /= 'r' and C2 /= 'R' then
+                     Bad_Operator_Symbol;
+                  end if;
+               when '/' =>
+                  Id := Name_Op_Inequality;
+                  if C2 /= '=' then
+                     Bad_Operator_Symbol;
+                  end if;
+               when '<' =>
+                  Id := Name_Op_Less_Equal;
+                  if C2 /= '=' then
+                     Bad_Operator_Symbol;
+                  end if;
+               when '>' =>
+                  Id := Name_Op_Greater_Equal;
+                  if C2 /= '=' then
+                     Bad_Operator_Symbol;
+                  end if;
+               when '*' =>
+                  Id := Name_Op_Exp;
+                  if C2 /= '*' then
+                     Bad_Operator_Symbol;
+                  end if;
+               when '?' =>
+                  if Vhdl_Std < Vhdl_08 then
+                     Bad_Operator_Symbol;
+                     Id := Name_Op_Condition;
+                  elsif C2 = '?' then
+                     Id := Name_Op_Condition;
+                  elsif C2 = '=' then
+                     Id := Name_Op_Match_Equality;
+                  elsif C2 = '<' then
+                     Id := Name_Op_Match_Less;
+                  elsif C2 = '>' then
+                     Id := Name_Op_Match_Greater;
+                  else
+                     Bad_Operator_Symbol;
+                     Id := Name_Op_Condition;
+                  end if;
+               when others =>
+                  Bad_Operator_Symbol;
+                  Id := Name_Op_Equality;
+            end case;
+         when 3 =>
+            --  mod, rem, and, xor, nor, abs, not, sll, sla, sra, srl, rol
+            --  ror
+            C2 := Str (2);
+            C3 := Str (3);
+            case C1 is
+               when 'm' | 'M' =>
+                  Id := Name_Mod;
+                  if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'd' and C3 /= 'D')
+                  then
+                     Bad_Operator_Symbol;
+                  end if;
+               when 'a' | 'A' =>
+                  if (C2 = 'n' or C2 = 'N') and (C3 = 'd' or C3 = 'D') then
+                     Id := Name_And;
+                  elsif (C2 = 'b' or C2 = 'B') and (C3 = 's' or C3 = 'S') then
+                     Id := Name_Abs;
+                  else
+                     Id := Name_And;
+                     Bad_Operator_Symbol;
+                  end if;
+               when 'x' | 'X' =>
+                  Id := Name_Xor;
+                  if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'r' and C3 /= 'R')
+                  then
+                     Bad_Operator_Symbol;
+                  end if;
+               when 'n' | 'N' =>
+                  if C2 = 'o' or C2 = 'O' then
+                     if C3 = 'r' or C3 = 'R' then
+                        Id := Name_Nor;
+                     elsif C3 = 't' or C3 = 'T' then
+                        Id := Name_Not;
+                     else
+                        Id := Name_Not;
+                        Bad_Operator_Symbol;
+                     end if;
+                  else
+                     Id := Name_Not;
+                     Bad_Operator_Symbol;
+                  end if;
+               when 's' | 'S' =>
+                  if C2 = 'l' or C2 = 'L' then
+                     if C3 = 'l' or C3 = 'L' then
+                        Check_Vhdl93;
+                        Id := Name_Sll;
+                     elsif C3 = 'a' or C3 = 'A' then
+                        Check_Vhdl93;
+                        Id := Name_Sla;
+                     else
+                        Id := Name_Sll;
+                        Bad_Operator_Symbol;
+                     end if;
+                  elsif C2 = 'r' or C2 = 'R' then
+                     if C3 = 'l' or C3 = 'L' then
+                        Check_Vhdl93;
+                        Id := Name_Srl;
+                     elsif C3 = 'a' or C3 = 'A' then
+                        Check_Vhdl93;
+                        Id := Name_Sra;
+                     else
+                        Id := Name_Srl;
+                        Bad_Operator_Symbol;
+                     end if;
+                  else
+                     Id := Name_Sll;
+                     Bad_Operator_Symbol;
+                  end if;
+               when 'r' | 'R' =>
+                  if C2 = 'e' or C2 = 'E' then
+                     if C3 = 'm' or C3 = 'M' then
+                        Id := Name_Rem;
+                     else
+                        Id := Name_Rem;
+                        Bad_Operator_Symbol;
+                     end if;
+                  elsif C2 = 'o' or C2 = 'O' then
+                     if C3 = 'l' or C3 = 'L' then
+                        Check_Vhdl93;
+                        Id := Name_Rol;
+                     elsif C3 = 'r' or C3 = 'R' then
+                        Check_Vhdl93;
+                        Id := Name_Ror;
+                     else
+                        Id := Name_Rol;
+                        Bad_Operator_Symbol;
+                     end if;
+                  else
+                     Id := Name_Rem;
+                     Bad_Operator_Symbol;
+                  end if;
+               when '?' =>
+                  if Vhdl_Std < Vhdl_08 then
+                     Bad_Operator_Symbol;
+                     Id := Name_Op_Match_Less_Equal;
+                  else
+                     if C2 = '<' and C3 = '=' then
+                        Id := Name_Op_Match_Less_Equal;
+                     elsif C2 = '>' and C3 = '=' then
+                        Id := Name_Op_Match_Greater_Equal;
+                     elsif C2 = '/' and C3 = '=' then
+                        Id := Name_Op_Match_Inequality;
+                     else
+                        Bad_Operator_Symbol;
+                        Id := Name_Op_Match_Less_Equal;
+                     end if;
+                  end if;
+               when others =>
+                  Id := Name_And;
+                  Bad_Operator_Symbol;
+            end case;
+         when 4 =>
+            --  nand, xnor
+            C2 := Str (2);
+            C3 := Str (3);
+            C4 := Str (4);
+            if (C1 = 'n' or C1 = 'N')
+              and (C2 = 'a' or C2 = 'A')
+              and (C3 = 'n' or C3 = 'N')
+              and (C4 = 'd' or C4 = 'D')
+            then
+               Id := Name_Nand;
+            elsif  (C1 = 'x' or C1 = 'X')
+              and (C2 = 'n' or C2 = 'N')
+              and (C3 = 'o' or C3 = 'O')
+              and (C4 = 'r' or C4 = 'R')
+            then
+               Check_Vhdl93;
+               Id := Name_Xnor;
+            else
+               Id := Name_Nand;
+               Bad_Operator_Symbol;
+            end if;
+         when others =>
+            Id := Name_Op_Plus;
+            Bad_Operator_Symbol;
+      end case;
+      return Id;
+   end Str_To_Operator_Name;
+
+   function Scan_To_Operator_Name (Loc : Location_Type) return Name_Id is
+   begin
+      return Str_To_Operator_Name
+        (Str_Table.Get_String_Fat_Acc (Current_String_Id),
+         Current_String_Length,
+         Loc);
+   end Scan_To_Operator_Name;
+   pragma Inline (Scan_To_Operator_Name);
+
+   --  Convert string literal STR to an operator symbol.
+   --  Emit an error message if the string is not an operator name.
+   function String_To_Operator_Symbol (Str : Iir_String_Literal)
+     return Iir
+   is
+      Id : Name_Id;
+      Res : Iir;
+   begin
+      Id := Str_To_Operator_Name
+        (Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)),
+         Get_String_Length (Str),
+         Get_Location (Str));
+      Res := Create_Iir (Iir_Kind_Operator_Symbol);
+      Location_Copy (Res, Str);
+      Set_Identifier (Res, Id);
+      Free_Iir (Str);
+      return Res;
+   end String_To_Operator_Symbol;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §6.1 ]
+   --  name ::= simple_name
+   --         | operator_symbol
+   --         | selected_name
+   --         | indexed_name
+   --         | slice_name
+   --         | attribute_name
+   --
+   --  [ §6.2 ]
+   --  simple_name ::= identifier
+   --
+   --  [ §6.5 ]
+   --  slice_name ::= prefix ( discrete_range )
+   --
+   --  [ §6.3 ]
+   --  selected_name ::= prefix . suffix
+   --
+   --  [ §6.1 ]
+   --  prefix ::= name
+   --           | function_call
+   --
+   --  [ §6.3 ]
+   --  suffix ::= simple_name
+   --           | character_literal
+   --           | operator_symbol
+   --           | ALL
+   --
+   --  [ §3.2.1 ]
+   --  discrete_range ::= DISCRETE_subtype_indication | range
+   --
+   --  [ §3.1 ]
+   --  range ::= RANGE_attribute_name
+   --          | simple_expression direction simple_expression
+   --
+   --  [ §3.1 ]
+   --  direction ::= TO | DOWNTO
+   --
+   --  [ §6.6 ]
+   --  attribute_name ::=
+   --      prefix [ signature ] ' attribute_designator [ ( expression ) ]
+   --
+   --  [ §6.6 ]
+   --  attribute_designator ::= ATTRIBUTE_simple_name
+   --
+   --  Note: in order to simplify the parsing, this function may return a
+   --  signature without attribute designator. Signatures may appear at 3
+   --  places:
+   --  - in attribute name
+   --  - in alias declaration
+   --  - in entity designator
+   function Parse_Name_Suffix (Pfx : Iir; Allow_Indexes: Boolean := True)
+     return Iir
+   is
+      Res: Iir;
+      Prefix: Iir;
+   begin
+      Res := Pfx;
+      loop
+         Prefix := Res;
+
+         case Current_Token is
+            when Tok_Left_Bracket =>
+               if Get_Kind (Prefix) = Iir_Kind_String_Literal then
+                  Prefix := String_To_Operator_Symbol (Prefix);
+               end if;
+
+               --  There is a signature. They are normally followed by an
+               --  attribute.
+               Res := Parse_Signature;
+               Set_Signature_Prefix (Res, Prefix);
+
+            when Tok_Tick =>
+               -- There is an attribute.
+               if Get_Kind (Prefix) = Iir_Kind_String_Literal then
+                  Prefix := String_To_Operator_Symbol (Prefix);
+               end if;
+
+               Scan;
+               if Current_Token = Tok_Left_Paren then
+                  -- A qualified expression.
+                  Res := Create_Iir (Iir_Kind_Qualified_Expression);
+                  Set_Type_Mark (Res, Prefix);
+                  Location_Copy (Res, Prefix);
+                  Set_Expression (Res, Parse_Aggregate);
+                  return Res;
+               elsif Current_Token /= Tok_Range
+                 and then Current_Token /= Tok_Identifier
+               then
+                  Expect (Tok_Identifier, "required for an attribute name");
+                  return Null_Iir;
+               end if;
+               Res := Create_Iir (Iir_Kind_Attribute_Name);
+               Set_Identifier (Res, Current_Identifier);
+               Set_Location (Res);
+               if Get_Kind (Prefix) = Iir_Kind_Signature then
+                  Set_Attribute_Signature (Res, Prefix);
+                  Set_Prefix (Res, Get_Signature_Prefix (Prefix));
+               else
+                  Set_Prefix (Res, Prefix);
+               end if;
+
+               -- accept the identifier.
+               Scan;
+
+            when Tok_Left_Paren =>
+               if not Allow_Indexes then
+                  return Res;
+               end if;
+
+               if Get_Kind (Prefix) = Iir_Kind_String_Literal then
+                  Prefix := String_To_Operator_Symbol (Prefix);
+               end if;
+
+               Res := Create_Iir (Iir_Kind_Parenthesis_Name);
+               Set_Location (Res);
+               Set_Prefix (Res, Prefix);
+               Set_Association_Chain
+                 (Res, Parse_Association_List_In_Parenthesis);
+
+            when Tok_Dot =>
+               if Get_Kind (Prefix) = Iir_Kind_String_Literal then
+                  Prefix := String_To_Operator_Symbol (Prefix);
+               end if;
+
+               Scan;
+               case Current_Token is
+                  when Tok_All =>
+                     Res := Create_Iir (Iir_Kind_Selected_By_All_Name);
+                     Set_Location (Res);
+                     Set_Prefix (Res, Prefix);
+                  when Tok_Identifier
+                    | Tok_Character =>
+                     Res := Create_Iir (Iir_Kind_Selected_Name);
+                     Set_Location (Res);
+                     Set_Prefix (Res, Prefix);
+                     Set_Identifier (Res, Current_Identifier);
+                  when Tok_String =>
+                     Res := Create_Iir (Iir_Kind_Selected_Name);
+                     Set_Location (Res);
+                     Set_Prefix (Res, Prefix);
+                     Set_Identifier
+                       (Res, Scan_To_Operator_Name (Get_Token_Location));
+                  when others =>
+                     Error_Msg_Parse ("an identifier or all is expected");
+               end case;
+               Scan;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Parse_Name_Suffix;
+
+   function Parse_Name (Allow_Indexes: Boolean := True) return Iir
+   is
+      Res: Iir;
+   begin
+      case Current_Token is
+         when Tok_Identifier =>
+            Res := Create_Iir (Iir_Kind_Simple_Name);
+            Set_Identifier (Res, Current_Identifier);
+            Set_Location (Res);
+         when Tok_String =>
+            Res := Create_Iir (Iir_Kind_String_Literal);
+            Set_String_Id (Res, Current_String_Id);
+            Set_String_Length (Res, Current_String_Length);
+            Set_Location (Res);
+         when others =>
+            Error_Msg_Parse ("identifier expected here");
+            raise Parse_Error;
+      end case;
+
+      Scan;
+
+      return Parse_Name_Suffix (Res, Allow_Indexes);
+   end Parse_Name;
+
+   --  Emit an error message if MARK doesn't have the form of a type mark.
+   procedure Check_Type_Mark (Mark : Iir) is
+   begin
+      case Get_Kind (Mark) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            null;
+         when others =>
+            Error_Msg_Parse ("type mark must be a name of a type", Mark);
+      end case;
+   end Check_Type_Mark;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ 4.2 ]
+   --  type_mark ::= type_name
+   --              | subtype_name
+   function Parse_Type_Mark (Check_Paren : Boolean := False) return Iir
+   is
+      Res : Iir;
+      Old : Iir;
+      pragma Unreferenced (Old);
+   begin
+      Res := Parse_Name (Allow_Indexes => False);
+      Check_Type_Mark (Res);
+      if Check_Paren and then Current_Token = Tok_Left_Paren then
+         Error_Msg_Parse ("index constraint not allowed here");
+         Old := Parse_Name_Suffix (Res, True);
+      end if;
+      return Res;
+   end Parse_Type_Mark;
+
+   --  precond : CONSTANT, SIGNAL, VARIABLE. FILE or identifier
+   --  postcond: next token (';' or ')')
+   --
+   --  [ LRM93 4.3.2 ] [ LRM08 6.5.2 ]
+   --  interface_declaration ::= interface_constant_declaration
+   --                          | interface_signal_declaration
+   --                          | interface_variable_declaration
+   --                          | interface_file_declaration
+   --
+   --
+   --  [ LRM93 3.2.2 ]
+   --  identifier_list ::= identifier { , identifier }
+   --
+   --  [ LRM93 4.3.2 ]
+   --  interface_constant_declaration ::=
+   --      [ CONSTANT ] identifier_list : [ IN ] subtype_indication
+   --          [ := STATIC_expression ]
+   --
+   --  [ LRM93 4.3.2 ]
+   --  interface_file_declaration ::= FILE identifier_list : subtype_indication
+   --
+   --  [ LRM93 4.3.2 ]
+   --  interface_signal_declaration ::=
+   --      [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ]
+   --          [ := STATIC_expression ]
+   --
+   --  [ LRM93 4.3.2 ]
+   --  interface_variable_declaration ::=
+   --      [ VARIABLE ] identifier_list : [ mode ] subtype_indication
+   --          [ := STATIC_expression ]
+   --
+   --  The default kind of interface declaration is DEFAULT.
+   function Parse_Interface_Object_Declaration (Ctxt : Interface_Kind_Type)
+                                               return Iir
+   is
+      Kind : Iir_Kind;
+      Res, Last : Iir;
+      First, Prev_First : Iir;
+      Inter: Iir;
+      Is_Default : Boolean;
+      Interface_Mode: Iir_Mode;
+      Interface_Type: Iir;
+      Signal_Kind: Iir_Signal_Kind;
+      Default_Value: Iir;
+      Lexical_Layout : Iir_Lexical_Layout_Type;
+   begin
+      Res := Null_Iir;
+      Last := Null_Iir;
+
+      --  LRM08 6.5.2 Interface object declarations
+      --  Interface obejcts include interface constants that appear as
+      --  generics of a design entity, a component, a block, a package or
+      --  a subprogram, or as constant parameter of subprograms; interface
+      --  signals that appear as ports of a design entity, component or
+      --  block, or as signal parameters of subprograms; interface variables
+      --  that appear as variable parameter subprograms; interface files
+      --  that appear as file parameters of subrograms.
+      case Current_Token is
+         when Tok_Identifier =>
+            --  The class of the object is unknown.  Select default
+            --  according to the above rule, assuming the mode is IN.  If
+            --  the mode is not IN, Parse_Interface_Object_Declaration will
+            --  change the class.
+            case Ctxt is
+               when Generic_Interface_List
+                 | Parameter_Interface_List =>
+                  Kind := Iir_Kind_Interface_Constant_Declaration;
+               when Port_Interface_List =>
+                  Kind := Iir_Kind_Interface_Signal_Declaration;
+            end case;
+         when Tok_Constant =>
+            Kind := Iir_Kind_Interface_Constant_Declaration;
+         when Tok_Signal =>
+            if Ctxt = Generic_Interface_List then
+               Error_Msg_Parse
+                 ("signal interface not allowed in generic clause");
+            end if;
+            Kind := Iir_Kind_Interface_Signal_Declaration;
+         when Tok_Variable =>
+            if Ctxt not in Parameter_Interface_List then
+               Error_Msg_Parse
+                 ("variable interface not allowed in generic or port clause");
+            end if;
+            Kind := Iir_Kind_Interface_Variable_Declaration;
+         when Tok_File =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("file interface not allowed in vhdl 87");
+            end if;
+            if Ctxt not in Parameter_Interface_List then
+               Error_Msg_Parse
+                 ("variable interface not allowed in generic or port clause");
+            end if;
+            Kind := Iir_Kind_Interface_File_Declaration;
+         when others =>
+            --  Fall back in case of parse error.
+            Kind := Iir_Kind_Interface_Variable_Declaration;
+      end case;
+
+      Inter := Create_Iir (Kind);
+
+      if Current_Token = Tok_Identifier then
+         Is_Default := True;
+         Lexical_Layout := 0;
+      else
+         Is_Default := False;
+         Lexical_Layout := Iir_Lexical_Has_Class;
+
+         --  Skip 'signal', 'variable', 'constant' or 'file'.
+         Scan;
+      end if;
+
+      Prev_First := Last;
+      First := Inter;
+      loop
+         if Current_Token /= Tok_Identifier then
+            Expect (Tok_Identifier);
+         end if;
+         Set_Identifier (Inter, Current_Identifier);
+         Set_Location (Inter);
+
+         if Res = Null_Iir then
+            Res := Inter;
+         else
+            Set_Chain (Last, Inter);
+         end if;
+         Last := Inter;
+
+         --  Skip identifier
+         Scan;
+
+         exit when Current_Token = Tok_Colon;
+         Expect (Tok_Comma, "',' or ':' expected after identifier");
+
+         --  Skip ','
+         Scan;
+
+         Inter := Create_Iir (Kind);
+      end loop;
+
+      Expect (Tok_Colon, "':' must follow the interface element identifier");
+
+      --  Skip ':'
+      Scan;
+
+      --  LRM93 2.1.1  LRM08 4.2.2.1
+      --  If the mode is INOUT or OUT, and no object class is explicitly
+      --  specified, variable is assumed.
+      if Is_Default
+        and then Ctxt in Parameter_Interface_List
+        and then (Current_Token = Tok_Inout or else Current_Token = Tok_Out)
+      then
+         --  Convert into variable.
+         declare
+            O_Interface : Iir_Interface_Constant_Declaration;
+            N_Interface : Iir_Interface_Variable_Declaration;
+         begin
+            O_Interface := First;
+            while O_Interface /= Null_Iir loop
+               N_Interface :=
+                 Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+               Location_Copy (N_Interface, O_Interface);
+               Set_Identifier (N_Interface,
+                               Get_Identifier (O_Interface));
+               if Prev_First = Null_Iir then
+                  Res := N_Interface;
+               else
+                  Set_Chain (Prev_First, N_Interface);
+               end if;
+               Prev_First := N_Interface;
+               if O_Interface = First then
+                  First := N_Interface;
+               end if;
+               Last := N_Interface;
+               Inter := Get_Chain (O_Interface);
+               Free_Iir (O_Interface);
+               O_Interface := Inter;
+            end loop;
+            Inter := First;
+         end;
+      end if;
+
+      --  Update lexical layout if mode is present.
+      case Current_Token is
+         when Tok_In
+           | Tok_Out
+           | Tok_Inout
+           | Tok_Linkage
+           | Tok_Buffer =>
+            Lexical_Layout := Lexical_Layout or Iir_Lexical_Has_Mode;
+         when others =>
+            null;
+      end case;
+
+      --  Parse mode (and handle default mode).
+      case Get_Kind (Inter) is
+         when Iir_Kind_Interface_File_Declaration =>
+            if Parse_Mode (Iir_Unknown_Mode) /= Iir_Unknown_Mode then
+               Error_Msg_Parse
+                 ("mode can't be specified for a file interface");
+            end if;
+            Interface_Mode := Iir_Inout_Mode;
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_Variable_Declaration =>
+            --  LRM93 4.3.2
+            --  If no mode is explicitly given in an interface declaration
+            --  other than an interface file declaration, mode IN is
+            --  assumed.
+            Interface_Mode := Parse_Mode (Iir_In_Mode);
+         when Iir_Kind_Interface_Constant_Declaration =>
+            Interface_Mode := Parse_Mode (Iir_In_Mode);
+            if Interface_Mode /= Iir_In_Mode then
+               Error_Msg_Parse ("mode must be 'in' for a constant");
+            end if;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Interface_Type := Parse_Subtype_Indication;
+
+      --  Signal kind (but only for signal).
+      if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
+         Signal_Kind := Parse_Signal_Kind;
+      else
+         Signal_Kind := Iir_No_Signal_Kind;
+      end if;
+
+      if Current_Token = Tok_Assign then
+         if Get_Kind (Inter) = Iir_Kind_Interface_File_Declaration then
+            Error_Msg_Parse
+              ("default expression not allowed for an interface file");
+         end if;
+
+         --  Skip ':='
+         Scan;
+
+         Default_Value := Parse_Expression;
+      else
+         Default_Value := Null_Iir;
+      end if;
+
+      --  Subtype_Indication and Default_Value are set only on the first
+      --  interface.
+      Set_Subtype_Indication (First, Interface_Type);
+      if Get_Kind (First) /= Iir_Kind_Interface_File_Declaration then
+         Set_Default_Value (First, Default_Value);
+      end if;
+
+      Inter := First;
+      while Inter /= Null_Iir loop
+         Set_Mode (Inter, Interface_Mode);
+         Set_Is_Ref (Inter, Inter /= First);
+         if Inter = Last then
+            Set_Lexical_Layout (Inter,
+                                Lexical_Layout or Iir_Lexical_Has_Type);
+         else
+            Set_Lexical_Layout (Inter, Lexical_Layout);
+         end if;
+         if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
+            Set_Signal_Kind (Inter, Signal_Kind);
+         end if;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      return Res;
+   end Parse_Interface_Object_Declaration;
+
+   --  Precond : 'package'
+   --  Postcond: next token
+   --
+   --  LRM08 6.5.5 Interface package declarations
+   --  interface_package_declaration ::=
+   --    PACKAGE identifier IS NEW uninstantiated_package name
+   --      interface_package_generic_map_aspect
+   --
+   --  interface_package_generic_map_aspect ::=
+   --       generic_map_aspect
+   --     | GENERIC MAP ( <> )
+   --     | GENERIC MAP ( DEFAULT )
+   function Parse_Interface_Package_Declaration return Iir
+   is
+      Inter : Iir;
+      Map : Iir;
+   begin
+      Inter := Create_Iir (Iir_Kind_Interface_Package_Declaration);
+
+      --  Skip 'package'
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after ""package""");
+      Set_Identifier (Inter, Current_Identifier);
+      Set_Location (Inter);
+
+      --  Skip identifier
+      Scan_Expect (Tok_Is);
+
+      --  Skip 'is'
+      Scan_Expect (Tok_New);
+
+      --  Skip 'new'
+      Scan;
+
+      Set_Uninstantiated_Package_Name (Inter, Parse_Name (False));
+
+      Expect (Tok_Generic);
+
+      --  Skip 'generic'
+      Scan_Expect (Tok_Map);
+
+      --  Skip 'map'
+      Scan_Expect (Tok_Left_Paren);
+
+      --  Skip '('
+      Scan;
+
+      case Current_Token is
+         when Tok_Box =>
+            Map := Null_Iir;
+            --  Skip '<>'
+            Scan;
+         when others =>
+            Map := Parse_Association_List;
+      end case;
+      Set_Generic_Map_Aspect_Chain (Inter, Map);
+
+      Expect (Tok_Right_Paren);
+
+      --  Skip ')'
+      Scan;
+
+      return Inter;
+   end Parse_Interface_Package_Declaration;
+
+   --  Precond : '('
+   --  Postcond: next token
+   --
+   --  LRM08 6.5.6 Interface lists
+   --  interface_list ::= interface_element { ';' interface_element }
+   --
+   --  interface_element ::= interface_declaration
+   function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir)
+                                 return Iir
+   is
+      Res, Last : Iir;
+      Inters : Iir;
+      Next : Iir;
+      Prev_Loc : Location_Type;
+   begin
+      Expect (Tok_Left_Paren);
+
+      Res := Null_Iir;
+      Last := Null_Iir;
+      loop
+         Prev_Loc := Get_Token_Location;
+
+         --  Skip '(' or ';'
+         Scan;
+
+         case Current_Token is
+            when Tok_Identifier
+              | Tok_Signal
+              | Tok_Variable
+              | Tok_Constant
+              | Tok_File =>
+               --  An inteface object.
+               Inters := Parse_Interface_Object_Declaration (Ctxt);
+            when Tok_Package =>
+               if Ctxt /= Generic_Interface_List then
+                  Error_Msg_Parse
+                    ("package interface only allowed in generic interface");
+               elsif Flags.Vhdl_Std < Vhdl_08 then
+                  Error_Msg_Parse
+                    ("package interface not allowed before vhdl 08");
+               end if;
+               Inters := Parse_Interface_Package_Declaration;
+            when Tok_Right_Paren =>
+               if Res = Null_Iir then
+                  Error_Msg_Parse
+                    ("empty interface list not allowed", Prev_Loc);
+               else
+                  Error_Msg_Parse
+                    ("extra ';' at end of interface list", Prev_Loc);
+               end if;
+               exit;
+            when others =>
+               Error_Msg_Parse
+                 ("'signal', 'constant', 'variable', 'file' "
+                  & "or identifier expected");
+               --  Use a variable interface as a fall-back.
+               Inters := Parse_Interface_Object_Declaration (Ctxt);
+         end case;
+
+         --  Chain
+         if Last = Null_Iir then
+            Res := Inters;
+         else
+            Set_Chain (Last, Inters);
+         end if;
+
+         --  Set parent and set Last to the last interface.
+         Last := Inters;
+         loop
+            Set_Parent (Last, Parent);
+            Next := Get_Chain (Last);
+            exit when Next = Null_Iir;
+            Last := Next;
+         end loop;
+
+         exit when Current_Token /= Tok_Semi_Colon;
+      end loop;
+
+      if Current_Token /= Tok_Right_Paren then
+         Error_Msg_Parse ("')' expected at end of interface list");
+      end if;
+
+      --  Skip ')'
+      Scan;
+
+      return Res;
+   end Parse_Interface_List;
+
+   --  precond : PORT
+   --  postcond: next token
+   --
+   --  [ §1.1.1 ]
+   --  port_clause ::= PORT ( port_list ) ;
+   --
+   --  [ §1.1.1.2 ]
+   --  port_list ::= PORT_interface_list
+   procedure Parse_Port_Clause (Parent : Iir)
+   is
+      Res: Iir;
+      El : Iir;
+   begin
+      --  Skip 'port'
+      pragma Assert (Current_Token = Tok_Port);
+      Scan;
+
+      Res := Parse_Interface_List (Port_Interface_List, Parent);
+
+      --  Check the interface are signal interfaces.
+      El := Res;
+      while El /= Null_Iir loop
+         if Get_Kind (El) /= Iir_Kind_Interface_Signal_Declaration then
+            Error_Msg_Parse ("port must be a signal", El);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      Scan_Semi_Colon ("port clause");
+      Set_Port_Chain (Parent, Res);
+   end Parse_Port_Clause;
+
+   --  precond : GENERIC
+   --  postcond: next token
+   --
+   --  [ LRM93 1.1.1, LRM08 6.5.6.2 ]
+   --  generic_clause ::= GENERIC ( generic_list ) ;
+   --
+   --  [ LRM93 1.1.1.1, LRM08 6.5.6.2]
+   --  generic_list ::= GENERIC_interface_list
+   procedure Parse_Generic_Clause (Parent : Iir)
+   is
+      Res: Iir;
+   begin
+      --  Skip 'generic'
+      pragma Assert (Current_Token = Tok_Generic);
+      Scan;
+
+      Res := Parse_Interface_List (Generic_Interface_List, Parent);
+      Set_Generic_Chain (Parent, Res);
+
+      Scan_Semi_Colon ("generic clause");
+   end Parse_Generic_Clause;
+
+   --  precond : a token.
+   --  postcond: next token
+   --
+   --  [ §1.1.1 ]
+   --  entity_header ::=
+   --      [ FORMAL_generic_clause ]
+   --      [ FORMAL_port_clause ]
+   --
+   --  [ §4.5 ]
+   --          [ LOCAL_generic_clause ]
+   --          [ LOCAL_port_clause ]
+   procedure Parse_Generic_Port_Clauses (Parent : Iir)
+   is
+      Has_Port, Has_Generic : Boolean;
+   begin
+      Has_Port := False;
+      Has_Generic := False;
+      loop
+         if Current_Token = Tok_Generic then
+            if Has_Generic then
+               Error_Msg_Parse ("at most one generic clause is allowed");
+            end if;
+            if Has_Port then
+               Error_Msg_Parse ("generic clause must precede port clause");
+            end if;
+            Has_Generic := True;
+            Parse_Generic_Clause (Parent);
+         elsif Current_Token = Tok_Port then
+            if Has_Port then
+               Error_Msg_Parse ("at most one port clause is allowed");
+            end if;
+            Has_Port := True;
+            Parse_Port_Clause (Parent);
+         else
+            exit;
+         end if;
+      end loop;
+   end Parse_Generic_Port_Clauses;
+
+   --  precond : a token
+   --  postcond: next token
+   --
+   --  [ §3.1.1 ]
+   --  enumeration_type_definition ::=
+   --      ( enumeration_literal { , enumeration_literal } )
+   --
+   --  [ §3.1.1 ]
+   --  enumeration_literal ::= identifier | character_literal
+   function Parse_Enumeration_Type_Definition
+     return Iir_Enumeration_Type_Definition
+   is
+      Pos: Iir_Int32;
+      Enum_Lit: Iir_Enumeration_Literal;
+      Enum_Type: Iir_Enumeration_Type_Definition;
+      Enum_List : Iir_List;
+   begin
+      -- This is an enumeration.
+      Enum_Type := Create_Iir (Iir_Kind_Enumeration_Type_Definition);
+      Set_Location (Enum_Type);
+      Enum_List := Create_Iir_List;
+      Set_Enumeration_Literal_List (Enum_Type, Enum_List);
+
+      -- LRM93 3.1.1
+      -- The position number of the first listed enumeration literal is zero.
+      Pos := 0;
+      -- scan every literal.
+      Scan;
+      if Current_Token = Tok_Right_Paren then
+         Error_Msg_Parse ("at least one literal must be declared");
+         Scan;
+         return Enum_Type;
+      end if;
+      loop
+         if Current_Token /= Tok_Identifier
+           and then Current_Token /= Tok_Character
+         then
+            if Current_Token = Tok_Eof then
+               Error_Msg_Parse ("unexpected end of file");
+               return Enum_Type;
+            end if;
+            Error_Msg_Parse ("identifier or character expected");
+         end if;
+         Enum_Lit := Create_Iir (Iir_Kind_Enumeration_Literal);
+         Set_Identifier (Enum_Lit, Current_Identifier);
+         Set_Location (Enum_Lit);
+         Set_Enum_Pos (Enum_Lit, Pos);
+
+         -- LRM93 3.1.1
+         -- the position number for each additional enumeration literal is
+         -- one more than that if its predecessor in the list.
+         Pos := Pos + 1;
+
+         Append_Element (Enum_List, Enum_Lit);
+
+         -- next token.
+         Scan;
+         exit when Current_Token = Tok_Right_Paren;
+         if Current_Token /= Tok_Comma then
+            Error_Msg_Parse ("')' or ',' is expected after an enum literal");
+         end if;
+
+         -- scan a literal.
+         Scan;
+         if Current_Token = Tok_Right_Paren then
+            Error_Msg_Parse ("extra ',' ignored");
+            exit;
+         end if;
+      end loop;
+      Scan;
+      return Enum_Type;
+   end Parse_Enumeration_Type_Definition;
+
+   --  precond : ARRAY
+   --  postcond: ??
+   --
+   --  [ LRM93 3.2.1 ]
+   --  array_type_definition ::= unconstrained_array_definition
+   --                          | constrained_array_definition
+   --
+   --   unconstrained_array_definition ::=
+   --      ARRAY ( index_subtype_definition { , index_subtype_definition } )
+   --      OF element_subtype_indication
+   --
+   --   constrained_array_definition ::=
+   --      ARRAY index_constraint OF element_subtype_indication
+   --
+   --   index_subtype_definition ::= type_mark RANGE <>
+   --
+   --   index_constraint ::= ( discrete_range { , discrete_range } )
+   --
+   --   discrete_range ::= discrete_subtype_indication | range
+   --
+   --  [ LRM08 5.3.2.1 ]
+   --  array_type_definition ::= unbounded_array_definition
+   --                          | constrained_array_definition
+   --
+   --   unbounded_array_definition ::=
+   --      ARRAY ( index_subtype_definition { , index_subtype_definition } )
+   --      OF element_subtype_indication
+   function Parse_Array_Definition return Iir
+   is
+      Index_Constrained : Boolean;
+      Array_Constrained : Boolean;
+      First : Boolean;
+      Res_Type: Iir;
+      Index_List : Iir_List;
+
+      Loc : Location_Type;
+      Def : Iir;
+      Type_Mark : Iir;
+      Element_Subtype : Iir;
+   begin
+      Loc := Get_Token_Location;
+
+      --  Skip 'array', scan '('
+      Scan_Expect (Tok_Left_Paren);
+      Scan;
+
+      First := True;
+      Index_List := Create_Iir_List;
+
+      loop
+         --  The accepted syntax can be one of:
+         --  * index_subtype_definition, which is:
+         --    * type_mark RANGE <>
+         --  * discrete_range, which is either:
+         --    * /discrete/_subtype_indication
+         --      * [ resolution_indication ] type_mark [ range_constraint ]
+         --        * range_constraint ::= RANGE range
+         --    * range
+         --      * /range/_attribute_name
+         --      * simple_expression direction simple_expression
+
+         --  Parse a simple expression (for the range), which can also parse a
+         --  name.
+         Type_Mark := Parse_Simple_Expression;
+
+         case Current_Token is
+            when Tok_Range =>
+               --  Skip 'range'
+               Scan;
+
+               if Current_Token = Tok_Box then
+                  --  Parsed 'RANGE <>': this is an index_subtype_definition.
+                  Index_Constrained := False;
+                  Scan;
+                  Def := Type_Mark;
+               else
+                  --  This is a /discrete/_subtype_indication
+                  Index_Constrained := True;
+                  Def :=
+                    Parse_Range_Constraint_Of_Subtype_Indication (Type_Mark);
+               end if;
+            when Tok_To
+              | Tok_Downto =>
+               --  A range
+               Index_Constrained := True;
+               Def := Parse_Range_Right (Type_Mark);
+            when others =>
+               --  For a /range/_attribute_name
+               Index_Constrained := True;
+               Def := Type_Mark;
+         end case;
+
+         Append_Element (Index_List, Def);
+
+         if First then
+            Array_Constrained := Index_Constrained;
+            First := False;
+         else
+            if Array_Constrained /= Index_Constrained then
+               Error_Msg_Parse
+                 ("cannot mix constrained and unconstrained index");
+            end if;
+         end if;
+         exit when Current_Token /= Tok_Comma;
+         Scan;
+      end loop;
+
+      --  Skip ')' and 'of'
+      Expect (Tok_Right_Paren);
+      Scan_Expect (Tok_Of);
+      Scan;
+
+      Element_Subtype := Parse_Subtype_Indication;
+
+      if Array_Constrained then
+         --  Sem_Type will create the array type.
+         Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+         Set_Element_Subtype (Res_Type, Element_Subtype);
+         Set_Index_Constraint_List (Res_Type, Index_List);
+      else
+         Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition);
+         Set_Element_Subtype_Indication (Res_Type, Element_Subtype);
+         Set_Index_Subtype_Definition_List (Res_Type, Index_List);
+      end if;
+      Set_Location (Res_Type, Loc);
+
+      return Res_Type;
+   end Parse_Array_Definition;
+
+   --  precond : UNITS
+   --  postcond: next token
+   --
+   --  [ LRM93 3.1.3 ]
+   --  physical_type_definition ::=
+   --      range_constraint
+   --          UNITS
+   --              base_unit_declaration
+   --              { secondary_unit_declaration }
+   --          END UNITS [ PHYSICAL_TYPE_simple_name ]
+   --
+   --  [ LRM93 3.1.3 ]
+   --  base_unit_declaration ::= identifier ;
+   --
+   --  [ LRM93 3.1.3 ]
+   --  secondary_unit_declaration ::= identifier = physical_literal ;
+   function Parse_Physical_Type_Definition (Parent : Iir)
+     return Iir_Physical_Type_Definition
+   is
+      use Iir_Chains.Unit_Chain_Handling;
+      Res: Iir_Physical_Type_Definition;
+      Unit: Iir_Unit_Declaration;
+      Last : Iir_Unit_Declaration;
+      Multiplier : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Physical_Type_Definition);
+      Set_Location (Res);
+
+      --  Skip 'units'
+      Expect (Tok_Units);
+      Scan;
+
+      --  Parse primary unit.
+      Expect (Tok_Identifier);
+      Unit := Create_Iir (Iir_Kind_Unit_Declaration);
+      Set_Location (Unit);
+      Set_Parent (Unit, Parent);
+      Set_Identifier (Unit, Current_Identifier);
+
+      --  Skip identifier
+      Scan;
+
+      Scan_Semi_Colon ("primary unit");
+
+      Build_Init (Last);
+      Append (Last, Res, Unit);
+
+      --  Parse secondary units.
+      while Current_Token /= Tok_End loop
+         Unit := Create_Iir (Iir_Kind_Unit_Declaration);
+         Set_Location (Unit);
+         Set_Identifier (Unit, Current_Identifier);
+
+         --  Skip identifier.
+         Scan_Expect (Tok_Equal);
+
+         --  Skip '='.
+         Scan;
+
+         Multiplier := Parse_Primary;
+         Set_Physical_Literal (Unit, Multiplier);
+         case Get_Kind (Multiplier) is
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name
+              | Iir_Kind_Physical_Int_Literal =>
+               null;
+            when Iir_Kind_Physical_Fp_Literal =>
+               Error_Msg_Parse
+                 ("secondary units may only be defined with integer literals");
+            when others =>
+               Error_Msg_Parse ("a physical literal is expected here");
+         end case;
+         Append (Last, Res, Unit);
+         Scan_Semi_Colon ("secondary unit");
+      end loop;
+
+      --  Skip 'end'.
+      Scan;
+
+      Expect (Tok_Units);
+      Set_End_Has_Reserved_Id (Res, True);
+
+      --  Skip 'units'.
+      Scan;
+      return Res;
+   end Parse_Physical_Type_Definition;
+
+   --  precond : RECORD
+   --  postcond: next token
+   --
+   --  [ LRM93 3.2.2 ]
+   --  record_type_definition ::=
+   --      RECORD
+   --          element_declaration
+   --          { element_declaration }
+   --      END RECORD [ RECORD_TYPE_simple_name ]
+   --
+   --  element_declaration ::=
+   --      identifier_list : element_subtype_definition
+   --
+   --  element_subtype_definition ::= subtype_indication
+   function Parse_Record_Type_Definition return Iir_Record_Type_Definition
+   is
+      Res: Iir_Record_Type_Definition;
+      El_List : Iir_List;
+      El: Iir_Element_Declaration;
+      First : Iir;
+      Pos: Iir_Index32;
+      Subtype_Indication: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Record_Type_Definition);
+      Set_Location (Res);
+      El_List := Create_Iir_List;
+      Set_Elements_Declaration_List (Res, El_List);
+
+      --  Skip 'record'
+      Scan;
+
+      Pos := 0;
+      First := Null_Iir;
+      loop
+         pragma Assert (First = Null_Iir);
+         --  Parse identifier_list
+         loop
+            El := Create_Iir (Iir_Kind_Element_Declaration);
+            Set_Location (El);
+            if First = Null_Iir then
+               First := El;
+            end if;
+            Expect (Tok_Identifier);
+            Set_Identifier (El, Current_Identifier);
+            Append_Element (El_List, El);
+            Set_Element_Position (El, Pos);
+            Pos := Pos + 1;
+            if First = Null_Iir then
+               First := El;
+            end if;
+
+            --  Skip identifier
+            Scan;
+
+            exit when Current_Token /= Tok_Comma;
+
+            Set_Has_Identifier_List (El, True);
+
+            --  Skip ','
+            Scan;
+         end loop;
+
+         --  Scan ':'.
+         Expect (Tok_Colon);
+         Scan;
+
+         --  Parse element subtype indication.
+         Subtype_Indication := Parse_Subtype_Indication;
+         Set_Subtype_Indication (First, Subtype_Indication);
+
+         First := Null_Iir;
+         Scan_Semi_Colon ("element declaration");
+         exit when Current_Token = Tok_End;
+      end loop;
+
+      --  Skip 'end'
+      Scan_Expect (Tok_Record);
+      Set_End_Has_Reserved_Id (Res, True);
+
+      --  Skip 'record'
+      Scan;
+
+      return Res;
+   end Parse_Record_Type_Definition;
+
+   --  precond : ACCESS
+   --  postcond: ?
+   --
+   --  [ LRM93 3.3]
+   --  access_type_definition ::= ACCESS subtype_indication.
+   function Parse_Access_Type_Definition return Iir_Access_Type_Definition
+   is
+      Res : Iir_Access_Type_Definition;
+   begin
+      Res := Create_Iir (Iir_Kind_Access_Type_Definition);
+      Set_Location (Res);
+
+      --  Skip 'access'
+      Expect (Tok_Access);
+      Scan;
+
+      Set_Designated_Subtype_Indication (Res, Parse_Subtype_Indication);
+
+      return Res;
+   end Parse_Access_Type_Definition;
+
+   --  precond : FILE
+   --  postcond: next token
+   --
+   --  [ LRM93 3.4 ]
+   --  file_type_definition ::= FILE OF type_mark
+   function Parse_File_Type_Definition return Iir_File_Type_Definition
+   is
+      Res : Iir_File_Type_Definition;
+      Type_Mark: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_File_Type_Definition);
+      Set_Location (Res);
+      -- Accept token 'file'.
+      Scan_Expect (Tok_Of);
+      Scan;
+      Type_Mark := Parse_Type_Mark (Check_Paren => True);
+      if Get_Kind (Type_Mark) not in Iir_Kinds_Denoting_Name then
+         Error_Msg_Parse ("type mark expected");
+      else
+         Set_File_Type_Mark (Res, Type_Mark);
+      end if;
+      return Res;
+   end Parse_File_Type_Definition;
+
+   --  precond : PROTECTED
+   --  postcond: ';'
+   --
+   --  [ 3.5 ]
+   --  protected_type_definition ::= protected_type_declaration
+   --                              | protected_type_body
+   --
+   --  [ 3.5.1 ]
+   --  protected_type_declaration ::= PROTECTED
+   --                                     protected_type_declarative_part
+   --                                 END PROTECTED [ simple_name ]
+   --
+   --  protected_type_declarative_part ::=
+   --     { protected_type_declarative_item }
+   --
+   --  protected_type_declarative_item ::=
+   --       subprogram_declaration
+   --     | attribute_specification
+   --     | use_clause
+   --
+   --  [ 3.5.2 ]
+   --  protected_type_body ::= PROTECTED BODY
+   --                              protected_type_body_declarative_part
+   --                          END PROTECTED BODY [ simple_name ]
+   --
+   --  protected_type_body_declarative_part ::=
+   --      { protected_type_body_declarative_item }
+   --
+   --  protected_type_body_declarative_item ::=
+   --        subprogram_declaration
+   --      | subprogram_body
+   --      | type_declaration
+   --      | subtype_declaration
+   --      | constant_declaration
+   --      | variable_declaration
+   --      | file_declaration
+   --      | alias_declaration
+   --      | attribute_declaration
+   --      | attribute_specification
+   --      | use_clause
+   --      | group_template_declaration
+   --      | group_declaration
+   function Parse_Protected_Type_Definition
+     (Ident : Name_Id; Loc : Location_Type) return Iir
+   is
+      Res : Iir;
+      Decl : Iir;
+   begin
+      Scan;
+      if Current_Token = Tok_Body then
+         Res := Create_Iir (Iir_Kind_Protected_Type_Body);
+         Scan;
+         Decl := Res;
+      else
+         Decl := Create_Iir (Iir_Kind_Type_Declaration);
+         Res := Create_Iir (Iir_Kind_Protected_Type_Declaration);
+         Set_Location (Res, Loc);
+         Set_Type_Definition (Decl, Res);
+      end if;
+      Set_Identifier (Decl, Ident);
+      Set_Location (Decl, Loc);
+
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_End);
+      Scan_Expect (Tok_Protected);
+      Set_End_Has_Reserved_Id (Res, True);
+      if Get_Kind (Res) = Iir_Kind_Protected_Type_Body then
+         Scan_Expect (Tok_Body);
+      end if;
+      Scan;
+      Check_End_Name (Ident, Res);
+      return Decl;
+   end Parse_Protected_Type_Definition;
+
+   --  precond : TYPE
+   --  postcond: a token
+   --
+   --  [ LRM93 4.1 ]
+   --  type_definition ::= scalar_type_definition
+   --                    | composite_type_definition
+   --                    | access_type_definition
+   --                    | file_type_definition
+   --                    | protected_type_definition
+   --
+   --  [ LRM93 3.1 ]
+   --  scalar_type_definition ::= enumeration_type_definition
+   --                           | integer_type_definition
+   --                           | floating_type_definition
+   --                           | physical_type_definition
+   --
+   --  [ LRM93 3.2 ]
+   --  composite_type_definition ::= array_type_definition
+   --                              | record_type_definition
+   --
+   --  [ LRM93 3.1.2 ]
+   --  integer_type_definition ::= range_constraint
+   --
+   --  [ LRM93 3.1.4 ]
+   --  floating_type_definition ::= range_constraint
+   function Parse_Type_Declaration (Parent : Iir) return Iir
+   is
+      Def : Iir;
+      Loc : Location_Type;
+      Ident : Name_Id;
+      Decl : Iir;
+   begin
+      -- The current token must be type.
+      pragma Assert (Current_Token = Tok_Type);
+
+      -- Get the identifier
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after 'type' keyword");
+      Loc := Get_Token_Location;
+      Ident := Current_Identifier;
+
+      --  Skip identifier
+      Scan;
+
+      if Current_Token = Tok_Semi_Colon then
+         --  If there is a ';', this is an imcomplete type declaration.
+         Invalidate_Current_Token;
+         Decl := Create_Iir (Iir_Kind_Type_Declaration);
+         Set_Identifier (Decl, Ident);
+         Set_Location (Decl, Loc);
+         return Decl;
+      end if;
+
+      if Current_Token /= Tok_Is then
+         Error_Msg_Parse ("'is' expected here");
+         --  Act as if IS token was forgotten.
+      else
+         --  Eat IS token.
+         Scan;
+      end if;
+
+      case Current_Token is
+         when Tok_Left_Paren =>
+            --  This is an enumeration.
+            Def := Parse_Enumeration_Type_Definition;
+            Decl := Null_Iir;
+
+         when Tok_Range =>
+            --  This is a range definition.
+            Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration);
+            Set_Identifier (Decl, Ident);
+            Set_Location (Decl, Loc);
+
+            --  Skip 'range'
+            Scan;
+
+            Def := Parse_Range_Constraint;
+            Set_Type_Definition (Decl, Def);
+
+            if Current_Token = Tok_Units then
+               --  A physical type definition.
+               declare
+                  Unit_Def : Iir;
+               begin
+                  Unit_Def := Parse_Physical_Type_Definition (Parent);
+                  if Current_Token = Tok_Identifier then
+                     if Flags.Vhdl_Std = Vhdl_87 then
+                        Error_Msg_Parse
+                          ("simple_name not allowed here in vhdl87");
+                     end if;
+                     Check_End_Name (Get_Identifier (Decl), Unit_Def);
+                  end if;
+                  if Def /= Null_Iir then
+                     Set_Type (Def, Unit_Def);
+                  end if;
+               end;
+            end if;
+
+         when Tok_Array =>
+            Def := Parse_Array_Definition;
+            Decl := Null_Iir;
+
+         when Tok_Record =>
+            Decl := Create_Iir (Iir_Kind_Type_Declaration);
+            Set_Identifier (Decl, Ident);
+            Set_Location (Decl, Loc);
+            Def := Parse_Record_Type_Definition;
+            Set_Type_Definition (Decl, Def);
+            if Current_Token = Tok_Identifier then
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Parse ("simple_name not allowed here in vhdl87");
+               end if;
+               Check_End_Name (Get_Identifier (Decl), Def);
+            end if;
+
+         when Tok_Access =>
+            Def := Parse_Access_Type_Definition;
+            Decl := Null_Iir;
+
+         when Tok_File =>
+            Def := Parse_File_Type_Definition;
+            Decl := Null_Iir;
+
+         when Tok_Identifier =>
+            if Current_Identifier = Name_Protected then
+               Error_Msg_Parse ("protected type not allowed in vhdl87/93");
+               Decl := Parse_Protected_Type_Definition (Ident, Loc);
+            else
+               Error_Msg_Parse ("type '" & Name_Table.Image (Ident) &
+                                "' cannot be defined from another type");
+               Error_Msg_Parse ("(you should declare a subtype)");
+               Decl := Create_Iir (Iir_Kind_Type_Declaration);
+               Eat_Tokens_Until_Semi_Colon;
+            end if;
+
+         when Tok_Protected =>
+            if Flags.Vhdl_Std < Vhdl_00 then
+               Error_Msg_Parse ("protected type not allowed in vhdl87/93");
+            end if;
+            Decl := Parse_Protected_Type_Definition (Ident, Loc);
+
+         when others =>
+            Error_Msg_Parse
+              ("type definition starting with a keyword such as RANGE, ARRAY");
+            Error_Msg_Parse
+              (" FILE, RECORD or '(' is expected here");
+            Eat_Tokens_Until_Semi_Colon;
+            Decl := Create_Iir (Iir_Kind_Type_Declaration);
+      end case;
+
+      if Decl = Null_Iir then
+         case Get_Kind (Def) is
+            when Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Access_Type_Definition
+              | Iir_Kind_Array_Type_Definition
+              | Iir_Kind_File_Type_Definition =>
+               Decl := Create_Iir (Iir_Kind_Type_Declaration);
+            when Iir_Kind_Array_Subtype_Definition =>
+               Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration);
+            when others =>
+               Error_Kind ("parse_type_declaration", Def);
+         end case;
+         Set_Type_Definition (Decl, Def);
+      end if;
+      Set_Identifier (Decl, Ident);
+      Set_Location (Decl, Loc);
+
+      -- ';' is expected after end of type declaration
+      Expect (Tok_Semi_Colon);
+      Invalidate_Current_Token;
+      return Decl;
+   end Parse_Type_Declaration;
+
+   --  precond: '(' or identifier
+   --  postcond: next token
+   --
+   --  [ LRM08 6.3 ]
+   --
+   --  resolution_indication ::=
+   --      resolution_function_name | ( element_resolution )
+   --
+   --  element_resolution ::=
+   --      array_element_resolution | record_resolution
+   --
+   --  array_element_resolution ::= resolution_indication
+   --
+   --  record_resolution ::=
+   --      record_element_resolution { , record_element_resolution }
+   --
+   --  record_element_resolution ::=
+   --      record_element_simple_name resolution_indication
+   function Parse_Resolution_Indication return Iir
+   is
+      Ind : Iir;
+      Def : Iir;
+      Loc : Location_Type;
+   begin
+      if Current_Token = Tok_Identifier then
+         --  Resolution function name.
+         return Parse_Name (Allow_Indexes => False);
+      elsif Current_Token = Tok_Left_Paren then
+         --  Element resolution.
+         Loc := Get_Token_Location;
+
+         --  Eat '('
+         Scan;
+
+         Ind := Parse_Resolution_Indication;
+         if Current_Token = Tok_Identifier
+           or else Current_Token = Tok_Left_Paren
+         then
+            declare
+               Id : Name_Id;
+               El : Iir;
+               First, Last : Iir;
+            begin
+               --  This was in fact a record_resolution.
+               if Get_Kind (Ind) = Iir_Kind_Simple_Name then
+                  Id := Get_Identifier (Ind);
+               else
+                  Error_Msg_Parse ("element name expected", Ind);
+                  Id := Null_Identifier;
+               end if;
+               Free_Iir (Ind);
+
+               Def := Create_Iir (Iir_Kind_Record_Resolution);
+               Set_Location (Def, Loc);
+               Sub_Chain_Init (First, Last);
+               loop
+                  El := Create_Iir (Iir_Kind_Record_Element_Resolution);
+                  Set_Location (El, Loc);
+                  Set_Identifier (El, Id);
+                  Set_Resolution_Indication (El, Parse_Resolution_Indication);
+                  Sub_Chain_Append (First, Last, El);
+                  exit when Current_Token = Tok_Right_Paren;
+
+                  --  Eat ','
+                  Expect (Tok_Comma);
+                  Scan;
+
+                  if Current_Token /= Tok_Identifier then
+                     Error_Msg_Parse ("record element identifier expected");
+                     exit;
+                  end if;
+                  Id := Current_Identifier;
+                  Loc := Get_Token_Location;
+
+                  --  Eat identifier
+                  Scan;
+               end loop;
+               Set_Record_Element_Resolution_Chain (Def, First);
+            end;
+         else
+            Def := Create_Iir (Iir_Kind_Array_Element_Resolution);
+            Set_Location (Def, Loc);
+            Set_Resolution_Indication (Def, Ind);
+         end if;
+
+         --  Eat ')'
+         Expect (Tok_Right_Paren);
+         Scan;
+
+         return Def;
+      else
+         Error_Msg_Parse ("resolution indication expected");
+         raise Parse_Error;
+      end if;
+   end Parse_Resolution_Indication;
+
+   --  precond : '('
+   --  postcond: next token
+   --
+   --  [ LRM08 6.3 Subtype declarations ]
+   --  element_constraint ::=
+   --      array_constraint | record_constraint
+   --
+   --  [ LRM08 5.3.2.1 Array types ]
+   --  array_constraint ::=
+   --      index_constraint [ array_element_constraint ]
+   --      | ( open ) [ array_element_constraint ]
+   --
+   --  array_element_constraint ::= element_constraint
+   --
+   --  RES is the resolution_indication of the subtype indication.
+   function Parse_Element_Constraint return Iir
+   is
+      Def : Iir;
+      El : Iir;
+      Index_List : Iir_List;
+   begin
+      --  Index_constraint.
+      Def := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      Set_Location (Def);
+
+      --  Eat '('.
+      Scan;
+
+      if Current_Token = Tok_Open then
+         --  Eat 'open'.
+         Scan;
+      else
+         Index_List := Create_Iir_List;
+         Set_Index_Constraint_List (Def, Index_List);
+         --  index_constraint ::= (discrete_range {, discrete_range} )
+         loop
+            El := Parse_Discrete_Range;
+            Append_Element (Index_List, El);
+
+            exit when Current_Token = Tok_Right_Paren;
+
+            --  Eat ','
+            Expect (Tok_Comma);
+            Scan;
+         end loop;
+      end if;
+
+      --  Eat ')'
+      Expect (Tok_Right_Paren);
+      Scan;
+
+      if Current_Token = Tok_Left_Paren then
+         Set_Element_Subtype (Def, Parse_Element_Constraint);
+      end if;
+      return Def;
+   end Parse_Element_Constraint;
+
+   --  precond : tolerance
+   --  postcond: next token
+   --
+   --  [ LRM93 4.2 ]
+   --  tolerance_aspect ::= TOLERANCE string_expression
+   function Parse_Tolerance_Aspect_Opt return Iir is
+   begin
+      if AMS_Vhdl
+        and then Current_Token = Tok_Tolerance
+      then
+         Scan;
+         return Parse_Expression;
+      else
+         return Null_Iir;
+      end if;
+   end Parse_Tolerance_Aspect_Opt;
+
+   --  precond : identifier or '('
+   --  postcond: next token
+   --
+   --  [ LRM93 4.2 ]
+   --  subtype_indication ::=
+   --      [ RESOLUTION_FUNCTION_name ] type_mark [ constraint ]
+   --
+   --  constraint ::= range_constraint | index_constraint
+   --
+   --  [ LRM08 6.3 ]
+   --  subtype_indication ::=
+   --      [ resolution_indication ] type_mark [ constraint ]
+   --
+   --  constraint ::=
+   --      range_constraint | array_constraint | record_constraint
+   --
+   --  NAME is the type_mark when already parsed (in range expression or
+   --   allocator by type).
+   function Parse_Subtype_Indication (Name : Iir := Null_Iir)
+     return Iir
+   is
+      Type_Mark : Iir;
+      Def: Iir;
+      Resolution_Indication: Iir;
+      Tolerance : Iir;
+   begin
+      -- FIXME: location.
+      Resolution_Indication := Null_Iir;
+      Def := Null_Iir;
+
+      if Name /= Null_Iir then
+         --  The type_mark was already parsed.
+         Type_Mark := Name;
+         Check_Type_Mark (Name);
+      else
+         if Current_Token = Tok_Left_Paren then
+            if Vhdl_Std < Vhdl_08 then
+               Error_Msg_Parse
+                 ("resolution_indication not allowed before vhdl08");
+            end if;
+            Resolution_Indication := Parse_Resolution_Indication;
+         end if;
+         if Current_Token /= Tok_Identifier then
+            Error_Msg_Parse ("type mark expected in a subtype indication");
+            raise Parse_Error;
+         end if;
+         Type_Mark := Parse_Type_Mark (Check_Paren => False);
+      end if;
+
+      if Current_Token = Tok_Identifier then
+         if Resolution_Indication /= Null_Iir then
+            Error_Msg_Parse ("resolution function already indicated");
+         end if;
+         Resolution_Indication := Type_Mark;
+         Type_Mark := Parse_Type_Mark (Check_Paren => False);
+      end if;
+
+      case Current_Token is
+         when Tok_Left_Paren =>
+            --  element_constraint.
+            Def := Parse_Element_Constraint;
+            Set_Subtype_Type_Mark (Def, Type_Mark);
+            Set_Resolution_Indication (Def, Resolution_Indication);
+            Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt);
+
+         when Tok_Range =>
+            --  range_constraint.
+            --  Skip 'range'
+            Scan;
+
+            Def := Parse_Range_Constraint_Of_Subtype_Indication
+              (Type_Mark, Resolution_Indication);
+
+         when others =>
+            Tolerance := Parse_Tolerance_Aspect_Opt;
+            if Resolution_Indication /= Null_Iir
+              or else Tolerance /= Null_Iir
+            then
+               --  A subtype needs to be created.
+               Def := Create_Iir (Iir_Kind_Subtype_Definition);
+               Location_Copy (Def, Type_Mark);
+               Set_Subtype_Type_Mark (Def, Type_Mark);
+               Set_Resolution_Indication (Def, Resolution_Indication);
+               Set_Tolerance (Def, Tolerance);
+            else
+               --  This is just an alias.
+               Def := Type_Mark;
+            end if;
+      end case;
+      return Def;
+   end Parse_Subtype_Indication;
+
+   --  precond : SUBTYPE
+   --  postcond: ';'
+   --
+   --  [ §4.2 ]
+   --  subtype_declaration ::= SUBTYPE identifier IS subtype_indication ;
+   function Parse_Subtype_Declaration return Iir_Subtype_Declaration
+   is
+      Decl: Iir_Subtype_Declaration;
+      Def: Iir;
+   begin
+      Decl := Create_Iir (Iir_Kind_Subtype_Declaration);
+
+      Scan_Expect (Tok_Identifier);
+      Set_Identifier (Decl, Current_Identifier);
+      Set_Location (Decl);
+
+      Scan_Expect (Tok_Is);
+      Scan;
+      Def := Parse_Subtype_Indication;
+      Set_Subtype_Indication (Decl, Def);
+
+      Expect (Tok_Semi_Colon);
+      return Decl;
+   end Parse_Subtype_Declaration;
+
+   --  precond : NATURE
+   --  postcond: a token
+   --
+   --  [ §4.8 ]
+   --  nature_definition ::= scalar_nature_definition
+   --                    | composite_nature_definition
+   --
+   --  [ §3.5.1 ]
+   --  scalar_nature_definition ::= type_mark ACROSS
+   --                               type_mark THROUGH
+   --                               identifier REFERENCE
+   --
+   --  [ §3.5.2 ]
+   --  composite_nature_definition ::= array_nature_definition
+   --                              | record_nature_definition
+   function Parse_Nature_Declaration return Iir
+   is
+      Def : Iir;
+      Ref : Iir;
+      Loc : Location_Type;
+      Ident : Name_Id;
+      Decl : Iir;
+   begin
+      -- The current token must be type.
+      if Current_Token /= Tok_Nature then
+         raise Program_Error;
+      end if;
+
+      -- Get the identifier
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after 'nature'");
+      Loc := Get_Token_Location;
+      Ident := Current_Identifier;
+
+      Scan;
+
+      if Current_Token /= Tok_Is then
+         Error_Msg_Parse ("'is' expected here");
+         --  Act as if IS token was forgotten.
+      else
+         --  Eat IS token.
+         Scan;
+      end if;
+
+      case Current_Token is
+         when Tok_Array =>
+            --  TODO
+            Error_Msg_Parse ("array nature definition not supported");
+            Def := Null_Iir;
+            Eat_Tokens_Until_Semi_Colon;
+         when Tok_Record =>
+            --  TODO
+            Error_Msg_Parse ("record nature definition not supported");
+            Def := Null_Iir;
+            Eat_Tokens_Until_Semi_Colon;
+         when Tok_Identifier =>
+            Def := Create_Iir (Iir_Kind_Scalar_Nature_Definition);
+            Set_Location (Def, Loc);
+            Set_Across_Type (Def, Parse_Type_Mark);
+            if Current_Token = Tok_Across then
+               Scan;
+            else
+               Expect (Tok_Across, "'across' expected after type mark");
+            end if;
+            Set_Through_Type (Def, Parse_Type_Mark);
+            if Current_Token = Tok_Through then
+               Scan;
+            else
+               Expect (Tok_Across, "'through' expected after type mark");
+            end if;
+            if Current_Token = Tok_Identifier then
+               Ref := Create_Iir (Iir_Kind_Terminal_Declaration);
+               Set_Identifier (Ref, Current_Identifier);
+               Set_Location (Ref);
+               Set_Reference (Def, Ref);
+               Scan;
+               if Current_Token = Tok_Reference then
+                  Scan;
+               else
+                  Expect (Tok_Reference, "'reference' expected");
+                  Eat_Tokens_Until_Semi_Colon;
+               end if;
+            else
+               Error_Msg_Parse ("reference identifier expected");
+               Eat_Tokens_Until_Semi_Colon;
+            end if;
+         when others =>
+            Error_Msg_Parse ("nature definition expected here");
+            Eat_Tokens_Until_Semi_Colon;
+      end case;
+
+      Decl := Create_Iir (Iir_Kind_Nature_Declaration);
+      Set_Nature (Decl, Def);
+      Set_Identifier (Decl, Ident);
+      Set_Location (Decl, Loc);
+
+      -- ';' is expected after end of type declaration
+      Expect (Tok_Semi_Colon);
+      Invalidate_Current_Token;
+      return Decl;
+   end Parse_Nature_Declaration;
+
+   --  precond : identifier
+   --  postcond: next token
+   --
+   --  LRM 4.8 Nature declaration
+   --
+   --  subnature_indication ::=
+   --      nature_mark [ index_constraint ]
+   --      [ TOLERANCE string_expression ACROSS string_expression THROUGH ]
+   --
+   --  nature_mark ::=
+   --      nature_name | subnature_name
+   function Parse_Subnature_Indication return Iir is
+      Nature_Mark : Iir;
+   begin
+      if Current_Token /= Tok_Identifier then
+         Error_Msg_Parse ("nature mark expected in a subnature indication");
+         raise Parse_Error;
+      end if;
+      Nature_Mark := Parse_Name (Allow_Indexes => False);
+
+      if Current_Token = Tok_Left_Paren then
+         --  TODO
+         Error_Msg_Parse
+           ("index constraint not supported for subnature indication");
+         raise Parse_Error;
+      end if;
+
+      if Current_Token = Tok_Tolerance then
+         Error_Msg_Parse
+           ("tolerance not supported for subnature indication");
+         raise Parse_Error;
+      end if;
+      return Nature_Mark;
+   end Parse_Subnature_Indication;
+
+   --  precond : TERMINAL
+   --  postcond: ;
+   --
+   --  [ 4.3.1.5 Terminal declarations ]
+   --  terminal_declaration ::=
+   --      TERMINAL identifier_list : subnature_indication
+   function Parse_Terminal_Declaration (Parent : Iir) return Iir
+   is
+      --  First and last element of the chain to be returned.
+      First, Last : Iir;
+      Terminal : Iir;
+      Subnature : Iir;
+   begin
+      Sub_Chain_Init (First, Last);
+
+      loop
+         -- 'terminal' or "," was just scanned.
+         Terminal := Create_Iir (Iir_Kind_Terminal_Declaration);
+         Scan_Expect (Tok_Identifier);
+         Set_Identifier (Terminal, Current_Identifier);
+         Set_Location (Terminal);
+         Set_Parent (Terminal, Parent);
+
+         Sub_Chain_Append (First, Last, Terminal);
+
+         Scan;
+         exit when Current_Token = Tok_Colon;
+         if Current_Token /= Tok_Comma then
+            Error_Msg_Parse
+              ("',' or ':' is expected after "
+                 & "identifier in terminal declaration");
+            raise Expect_Error;
+         end if;
+      end loop;
+
+      -- The colon was parsed.
+      Scan;
+      Subnature := Parse_Subnature_Indication;
+
+      Terminal := First;
+      while Terminal /= Null_Iir loop
+         -- Type definitions are factorized.  This is OK, but not done by
+         -- sem.
+         if Terminal = First then
+            Set_Nature (Terminal, Subnature);
+         else
+            Set_Nature (Terminal, Null_Iir);
+         end if;
+         Terminal := Get_Chain (Terminal);
+      end loop;
+      Expect (Tok_Semi_Colon);
+      return First;
+   end Parse_Terminal_Declaration;
+
+   --  precond : QUANTITY
+   --  postcond: ;
+   --
+   --  [ 4.3.1.6 Quantity declarations ]
+   --  quantity_declaration ::=
+   --      free_quantity_declaration
+   --      | branch_quantity_declaration
+   --      | source_quantity_declaration
+   --
+   --  free_quantity_declaration ::=
+   --      QUANTITY identifier_list : subtype_indication [ := expression ] ;
+   --
+   --  branch_quantity_declaration ::=
+   --      QUANTITY [ across_aspect ] [ through_aspect ] terminal_aspect ;
+   --
+   --  source_quantity_declaration ::=
+   --      QUANTITY identifier_list : subtype_indication source_aspect ;
+   --
+   --  across_aspect ::=
+   --      identifier_list [ tolerance_aspect ] [ := expression ] ACROSS
+   --
+   --  through_aspect ::=
+   --      identifier_list [ tolerance_aspect ] [ := expression ] THROUGH
+   --
+   --  terminal_aspect ::=
+   --      plus_terminal_name [ TO minus_terminal_name ]
+   function Parse_Quantity_Declaration (Parent : Iir) return Iir
+   is
+      --  First and last element of the chain to be returned.
+      First, Last : Iir;
+      Object : Iir;
+      New_Object : Iir;
+      Tolerance : Iir;
+      Default_Value : Iir;
+      Kind : Iir_Kind;
+      Plus_Terminal : Iir;
+   begin
+      Sub_Chain_Init (First, Last);
+
+      --  Eat 'quantity'
+      Scan;
+
+      loop
+         --  Quantity or "," was just scanned.  We assume a free quantity
+         --  declaration and will change to branch or source quantity if
+         --  necessary.
+         Object := Create_Iir (Iir_Kind_Free_Quantity_Declaration);
+         Expect (Tok_Identifier);
+         Set_Identifier (Object, Current_Identifier);
+         Set_Location (Object);
+         Set_Parent (Object, Parent);
+
+         Sub_Chain_Append (First, Last, Object);
+
+         --  Eat identifier
+         Scan;
+         exit when Current_Token /= Tok_Comma;
+
+         --  Eat ','
+         Scan;
+      end loop;
+
+      case Current_Token is
+         when Tok_Colon =>
+            --  Either a free quantity (or a source quantity)
+            --  TODO
+            raise Program_Error;
+         when Tok_Tolerance
+           | Tok_Assign
+           | Tok_Across
+           | Tok_Through =>
+            --  A branch quantity
+
+            --  Parse tolerance aspect
+            Tolerance := Parse_Tolerance_Aspect_Opt;
+
+            --  Parse default value
+            if Current_Token = Tok_Assign then
+               Scan;
+               Default_Value := Parse_Expression;
+            else
+               Default_Value := Null_Iir;
+            end if;
+
+            case Current_Token is
+               when Tok_Across =>
+                  Kind := Iir_Kind_Across_Quantity_Declaration;
+               when Tok_Through =>
+                  Kind := Iir_Kind_Through_Quantity_Declaration;
+               when others =>
+                  Error_Msg_Parse ("'across' or 'through' expected here");
+                  Eat_Tokens_Until_Semi_Colon;
+                  raise Expect_Error;
+            end case;
+
+            --  Eat across/through
+            Scan;
+
+            --  Change declarations
+            Object := First;
+            Sub_Chain_Init (First, Last);
+            while Object /= Null_Iir loop
+               New_Object := Create_Iir (Kind);
+               Location_Copy (New_Object, Object);
+               Set_Identifier (New_Object, Get_Identifier (Object));
+               Set_Parent (New_Object, Parent);
+               Set_Tolerance (New_Object, Tolerance);
+               Set_Default_Value (New_Object, Default_Value);
+
+               Sub_Chain_Append (First, Last, New_Object);
+
+               if Object /= First then
+                  Set_Plus_Terminal (New_Object, Null_Iir);
+               end if;
+               New_Object := Get_Chain (Object);
+               Free_Iir (Object);
+               Object := New_Object;
+            end loop;
+
+            --  Parse terminal (or first identifier of through declarations)
+            Plus_Terminal := Parse_Name;
+
+            case Current_Token is
+               when Tok_Comma
+                 | Tok_Tolerance
+                 | Tok_Assign
+                 | Tok_Through
+                 | Tok_Across =>
+                  --  Through quantity declaration.  Convert the Plus_Terminal
+                  --  to a declaration.
+                  Object := Create_Iir (Iir_Kind_Through_Quantity_Declaration);
+                  New_Object := Object;
+                  Location_Copy (Object, Plus_Terminal);
+                  if Get_Kind (Plus_Terminal) /= Iir_Kind_Simple_Name then
+                     Error_Msg_Parse
+                       ("identifier for quantity declaration expected");
+                  else
+                     Set_Identifier (Object, Get_Identifier (Plus_Terminal));
+                  end if;
+                  Set_Plus_Terminal (Object, Null_Iir);
+                  Free_Iir (Plus_Terminal);
+
+                  loop
+                     Set_Parent (Object, Parent);
+                     Sub_Chain_Append (First, Last, Object);
+                     exit when Current_Token /= Tok_Comma;
+                     Scan;
+
+                     Object := Create_Iir
+                       (Iir_Kind_Through_Quantity_Declaration);
+                     Set_Location (Object);
+                     if Current_Token /= Tok_Identifier then
+                        Error_Msg_Parse
+                          ("identifier for quantity declaration expected");
+                     else
+                        Set_Identifier (Object, Current_Identifier);
+                        Scan;
+                     end if;
+                     Set_Plus_Terminal (Object, Null_Iir);
+
+                  end loop;
+
+                  --  Parse tolerance aspect
+                  Set_Tolerance (Object, Parse_Tolerance_Aspect_Opt);
+
+                  --  Parse default value
+                  if Current_Token = Tok_Assign then
+                     Scan;
+                     Set_Default_Value (Object, Parse_Expression);
+                  end if;
+
+                  --  Scan 'through'
+                  if Current_Token = Tok_Through then
+                     Scan;
+                  elsif Current_Token = Tok_Across then
+                     Error_Msg_Parse ("across quantity declaration must appear"
+                                        & " before though declaration");
+                     Scan;
+                  else
+                     Error_Msg_Parse ("'through' expected");
+                  end if;
+
+                  --  Parse plus terminal
+                  Plus_Terminal := Parse_Name;
+               when others =>
+                  null;
+            end case;
+
+            Set_Plus_Terminal (First, Plus_Terminal);
+
+            --  Parse minus terminal (if present)
+            if Current_Token = Tok_To then
+               Scan;
+               Set_Minus_Terminal (First, Parse_Name);
+            end if;
+         when others =>
+            Error_Msg_Parse ("missign type or across/throught aspect "
+                               & "in quantity declaration");
+            Eat_Tokens_Until_Semi_Colon;
+            raise Expect_Error;
+      end case;
+      Expect (Tok_Semi_Colon);
+      return First;
+   end Parse_Quantity_Declaration;
+
+   --  precond : token (CONSTANT, SIGNAL, VARIABLE, FILE)
+   --  postcond: ;
+   --
+   --  KIND can be iir_kind_constant_declaration, iir_kind_file_declaration
+   --   or iir_kind_variable_declaration
+   --
+   --  [ LRM93 4.3.1 ]
+   --  object_declaration ::= constant_declaration
+   --                       | signal_declaration
+   --                       | variable_declaration
+   --                       | file_declaration
+   --
+   --  [ LRM93 4.3.1.1 ]
+   --  constant_declaration ::=
+   --      CONSTANT identifier_list : subtype_indication [ := expression ]
+   --
+   --  [ LRM87 4.3.2 ]
+   --  file_declaration ::=
+   --      FILE identifier : subtype_indication IS [ mode ] file_logical_name
+   --
+   --  [ LRM93 4.3.1.4 ]
+   --  file_declaration ::=
+   --      FILE identifier_list : subtype_indication [ file_open_information ]
+   --
+   --  [ LRM93 4.3.1.4 ]
+   --  file_open_information ::=
+   --      [ OPEN FILE_OPEN_KIND_expression ] IS file_logical_name
+   --
+   --  [ LRM93 4.3.1.4 ]
+   --  file_logical_name ::= STRING_expression
+   --
+   --  [ LRM93 4.3.1.3 ]
+   --  variable_declaration ::=
+   --      [ SHARED ] VARIABLE identifier_list : subtype_indication
+   --          [ := expression ]
+   --
+   --  [ LRM93 4.3.1.2 ]
+   --  signal_declaration ::=
+   --      SIGNAL identifier_list : subtype_information [ signal_kind ]
+   --          [ := expression ]
+   --
+   --  [ LRM93 4.3.1.2 ]
+   --  signal_kind ::= REGISTER | BUS
+   --
+   --  FIXME: file_open_information.
+   function Parse_Object_Declaration (Parent : Iir) return Iir
+   is
+      --  First and last element of the chain to be returned.
+      First, Last : Iir;
+      Object: Iir;
+      Object_Type: Iir;
+      Default_Value : Iir;
+      Mode: Iir_Mode;
+      Signal_Kind : Iir_Signal_Kind;
+      Open_Kind : Iir;
+      Logical_Name : Iir;
+      Kind: Iir_Kind;
+      Shared : Boolean;
+      Has_Mode : Boolean;
+   begin
+      Sub_Chain_Init (First, Last);
+
+      -- object keyword was just scanned.
+      case Current_Token is
+         when Tok_Signal =>
+            Kind := Iir_Kind_Signal_Declaration;
+         when Tok_Constant =>
+            Kind := Iir_Kind_Constant_Declaration;
+         when Tok_File =>
+            Kind := Iir_Kind_File_Declaration;
+         when Tok_Variable =>
+            Kind := Iir_Kind_Variable_Declaration;
+            Shared := False;
+         when Tok_Shared =>
+            Kind := Iir_Kind_Variable_Declaration;
+            Shared := True;
+            Scan_Expect (Tok_Variable);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      loop
+         -- object or "," was just scanned.
+         Object := Create_Iir (Kind);
+         if Kind = Iir_Kind_Variable_Declaration then
+            Set_Shared_Flag (Object, Shared);
+         end if;
+         Scan_Expect (Tok_Identifier);
+         Set_Identifier (Object, Current_Identifier);
+         Set_Location (Object);
+         Set_Parent (Object, Parent);
+
+         Sub_Chain_Append (First, Last, Object);
+
+         Scan;
+         exit when Current_Token = Tok_Colon;
+         if Current_Token /= Tok_Comma then
+            case Current_Token is
+               when Tok_Assign =>
+                  Error_Msg_Parse ("missign type in " & Disp_Name (Kind));
+                  exit;
+               when others =>
+                  Error_Msg_Parse
+                    ("',' or ':' is expected after identifier in "
+                     & Disp_Name (Kind));
+                  raise Expect_Error;
+            end case;
+         end if;
+         Set_Has_Identifier_List (Object, True);
+      end loop;
+
+      -- Eat ':'
+      Scan;
+
+      Object_Type := Parse_Subtype_Indication;
+
+      if Kind = Iir_Kind_Signal_Declaration then
+         Signal_Kind := Parse_Signal_Kind;
+      end if;
+
+      if Current_Token = Tok_Assign then
+         if Kind = Iir_Kind_File_Declaration then
+            Error_Msg_Parse
+              ("default expression not allowed for a file declaration");
+         end if;
+
+         --  Skip ':='.
+         Scan;
+
+         Default_Value := Parse_Expression;
+      else
+         Default_Value := Null_Iir;
+      end if;
+
+      if Kind = Iir_Kind_File_Declaration then
+         if Current_Token = Tok_Open then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse
+                 ("'open' and open kind expression not allowed in vhdl 87");
+            end if;
+            Scan;
+            Open_Kind := Parse_Expression;
+         else
+            Open_Kind := Null_Iir;
+         end if;
+
+         --  LRM 4.3.1.4
+         --  The default mode is IN, if no mode is specified.
+         Mode := Iir_In_Mode;
+
+         Logical_Name := Null_Iir;
+         Has_Mode := False;
+         if Current_Token = Tok_Is then
+            --  Skip 'is'.
+            Scan;
+
+            case Current_Token is
+               when Tok_In | Tok_Out | Tok_Inout =>
+                  if Flags.Vhdl_Std >= Vhdl_93 then
+                     Error_Msg_Parse ("mode allowed only in vhdl 87");
+                  end if;
+                  Mode := Parse_Mode (Iir_In_Mode);
+                  if Mode = Iir_Inout_Mode then
+                     Error_Msg_Parse ("inout mode not allowed for file");
+                  end if;
+                  Has_Mode := True;
+               when others =>
+                  null;
+            end case;
+            Logical_Name := Parse_Expression;
+         elsif Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("file name expected (vhdl 87)");
+         end if;
+      end if;
+
+      Set_Subtype_Indication (First, Object_Type);
+      if Kind /= Iir_Kind_File_Declaration then
+         Set_Default_Value (First, Default_Value);
+      end if;
+
+      Object := First;
+      while Object /= Null_Iir loop
+         case Kind is
+            when Iir_Kind_File_Declaration =>
+               Set_Mode (Object, Mode);
+               Set_File_Open_Kind (Object, Open_Kind);
+               Set_File_Logical_Name (Object, Logical_Name);
+               Set_Has_Mode (Object, Has_Mode);
+            when Iir_Kind_Signal_Declaration =>
+               Set_Signal_Kind (Object, Signal_Kind);
+            when others =>
+               null;
+         end case;
+         Set_Is_Ref (Object, Object /= First);
+         Object := Get_Chain (Object);
+      end loop;
+
+      --  ';' is not eaten.
+      Expect (Tok_Semi_Colon);
+
+      return First;
+   end Parse_Object_Declaration;
+
+   --  precond : COMPONENT
+   --  postcond: ';'
+   --
+   --  [ §4.5 ]
+   --  component_declaration ::=
+   --      COMPONENT identifier [ IS ]
+   --          [ LOCAL_generic_clause ]
+   --          [ LOCAL_port_clause ]
+   --      END COMPONENT [ COMPONENT_simple_name ] ;
+   function Parse_Component_Declaration
+     return Iir_Component_Declaration
+   is
+      Component: Iir_Component_Declaration;
+   begin
+      Component := Create_Iir (Iir_Kind_Component_Declaration);
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after 'component'");
+      Set_Identifier (Component, Current_Identifier);
+      Set_Location (Component);
+      Scan;
+      if Current_Token = Tok_Is then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("""is"" keyword is not allowed here by vhdl 87");
+         end if;
+         Set_Has_Is (Component, True);
+         Scan;
+      end if;
+      Parse_Generic_Port_Clauses (Component);
+      Check_End_Name (Tok_Component, Component);
+      return Component;
+   end Parse_Component_Declaration;
+
+   --  precond : '['
+   --  postcond: next token after ']'
+   --
+   --  [ 2.3.2 ]
+   --  signature ::= [ [ type_mark { , type_mark } ] [ RETURN type_mark ] ]
+   function Parse_Signature return Iir_Signature
+   is
+      Res : Iir_Signature;
+      List : Iir_List;
+   begin
+      Expect (Tok_Left_Bracket);
+      Res := Create_Iir (Iir_Kind_Signature);
+      Set_Location (Res);
+
+      --  Skip '['
+      Scan;
+
+      --  List of type_marks.
+      if Current_Token = Tok_Identifier then
+         List := Create_Iir_List;
+         Set_Type_Marks_List (Res, List);
+         loop
+            Append_Element (List, Parse_Type_Mark (Check_Paren => True));
+            exit when Current_Token /= Tok_Comma;
+            Scan;
+         end loop;
+      end if;
+
+      if Current_Token = Tok_Return then
+         --  Skip 'return'
+         Scan;
+
+         Set_Return_Type_Mark (Res, Parse_Name);
+      end if;
+
+      --  Skip ']'
+      Expect (Tok_Right_Bracket);
+      Scan;
+
+      return Res;
+   end Parse_Signature;
+
+   --  precond : ALIAS
+   --  postcond: a token
+   --
+   --  [ LRM93 4.3.3 ]
+   --  alias_declaration ::=
+   --      ALIAS alias_designator [ : subtype_indication ]
+   --          IS name [ signature ] ;
+   --
+   --  [ LRM93 4.3.3 ]
+   --  alias_designator ::= identifier | character_literal | operator_symbol
+   --
+   --  FIXME: signature is not part of the node.
+   function Parse_Alias_Declaration return Iir
+   is
+      Res: Iir;
+      Ident : Name_Id;
+   begin
+      --  Eat 'alias'.
+      Scan;
+
+      Res := Create_Iir (Iir_Kind_Object_Alias_Declaration);
+      Set_Location (Res);
+
+      case Current_Token is
+         when Tok_Identifier =>
+            Ident := Current_Identifier;
+         when Tok_Character =>
+            Ident := Current_Identifier;
+         when Tok_String =>
+            Ident := Scan_To_Operator_Name (Get_Token_Location);
+            --  FIXME: vhdl87
+            --  FIXME: operator symbol.
+         when others =>
+            Error_Msg_Parse ("alias designator expected");
+      end case;
+
+      --  Eat identifier.
+      Set_Identifier (Res, Ident);
+      Scan;
+
+      if Current_Token = Tok_Colon then
+         Scan;
+         Set_Subtype_Indication (Res, Parse_Subtype_Indication);
+      end if;
+
+      --  FIXME: nice message if token is ':=' ?
+      Expect (Tok_Is);
+      Scan;
+      Set_Name (Res, Parse_Name);
+
+      return Res;
+   end Parse_Alias_Declaration;
+
+   --  precond : FOR
+   --  postcond: ';'
+   --
+   --  [ §5.2 ]
+   --  configuration_specification ::=
+   --      FOR component_specification binding_indication ;
+   function Parse_Configuration_Specification
+     return Iir_Configuration_Specification
+   is
+      Res : Iir_Configuration_Specification;
+   begin
+      Res := Create_Iir (Iir_Kind_Configuration_Specification);
+      Set_Location (Res);
+      Expect (Tok_For);
+      Scan;
+      Parse_Component_Specification (Res);
+      Set_Binding_Indication (Res, Parse_Binding_Indication);
+      Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Configuration_Specification;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ § 5.2 ]
+   --  entity_class := ENTITY | ARCHITECTURE | CONFIGURATION | PROCEDURE
+   --                | FUNCTION | PACKAGE | TYPE | SUBTYPE | CONSTANT
+   --                | SIGNAL | VARIABLE | COMPONENT | LABEL | LITERAL
+   --                | UNITS | GROUP | FILE
+   function Parse_Entity_Class return Token_Type
+   is
+      Res : Token_Type;
+   begin
+      case Current_Token is
+         when Tok_Entity
+           | Tok_Architecture
+           | Tok_Configuration
+           | Tok_Procedure
+           | Tok_Function
+           | Tok_Package
+           | Tok_Type
+           | Tok_Subtype
+           | Tok_Constant
+           | Tok_Signal
+           | Tok_Variable
+           | Tok_Component
+           | Tok_Label =>
+            null;
+         when Tok_Literal
+           | Tok_Units
+           | Tok_Group
+           | Tok_File =>
+            null;
+         when others =>
+            Error_Msg_Parse
+              (''' & Tokens.Image (Current_Token) & "' is not a entity class");
+      end case;
+      Res := Current_Token;
+      Scan;
+      return Res;
+   end Parse_Entity_Class;
+
+   function Parse_Entity_Class_Entry return Iir_Entity_Class
+   is
+      Res : Iir_Entity_Class;
+   begin
+      Res := Create_Iir (Iir_Kind_Entity_Class);
+      Set_Location (Res);
+      Set_Entity_Class (Res, Parse_Entity_Class);
+      return Res;
+   end Parse_Entity_Class_Entry;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §5.1 ]
+   --  entity_designator ::= entity_tag [ signature ]
+   --
+   --  entity_tag ::= simple_name | character_literal | operator_symbol
+   function Parse_Entity_Designator return Iir
+   is
+      Res : Iir;
+      Name : Iir;
+   begin
+      case Current_Token is
+         when Tok_Identifier =>
+            Res := Create_Iir (Iir_Kind_Simple_Name);
+            Set_Location (Res);
+            Set_Identifier (Res, Current_Identifier);
+         when Tok_Character =>
+            Res := Create_Iir (Iir_Kind_Character_Literal);
+            Set_Location (Res);
+            Set_Identifier (Res, Current_Identifier);
+         when Tok_String =>
+            Res := Create_Iir (Iir_Kind_Operator_Symbol);
+            Set_Location (Res);
+            Set_Identifier (Res, Scan_To_Operator_Name (Get_Token_Location));
+         when others =>
+            Error_Msg_Parse ("identifier, character or string expected");
+            raise Expect_Error;
+      end case;
+      Scan;
+      if Current_Token = Tok_Left_Bracket then
+         Name := Res;
+         Res := Parse_Signature;
+         Set_Signature_Prefix (Res, Name);
+      end if;
+      return Res;
+   end Parse_Entity_Designator;
+
+   --  precond : next token
+   --  postcond: IS
+   --
+   --  [ §5.1 ]
+   --  entity_name_list ::= entity_designator { , entity_designator }
+   --                     | OTHERS
+   --                     | ALL
+   procedure Parse_Entity_Name_List
+     (Attribute : Iir_Attribute_Specification)
+   is
+      List : Iir_List;
+      El : Iir;
+   begin
+      case Current_Token is
+         when Tok_All =>
+            List := Iir_List_All;
+            Scan;
+         when Tok_Others =>
+            List := Iir_List_Others;
+            Scan;
+         when others =>
+            List := Create_Iir_List;
+            loop
+               El := Parse_Entity_Designator;
+               Append_Element (List, El);
+               exit when Current_Token /= Tok_Comma;
+               Scan;
+            end loop;
+      end case;
+      Set_Entity_Name_List (Attribute, List);
+      if Current_Token = Tok_Colon then
+         Scan;
+         Set_Entity_Class (Attribute, Parse_Entity_Class);
+      else
+         Error_Msg_Parse
+           ("missing ':' and entity kind in attribute specification");
+      end if;
+   end Parse_Entity_Name_List;
+
+   --  precond : ATTRIBUTE
+   --  postcond: ';'
+   --
+   --  [ 4.4 ]
+   --  attribute_declaration ::= ATTRIBUTE identifier : type_mark ;
+   --
+   --  [ 5.1 ]
+   --  attribute_specification ::=
+   --     ATTRIBUTE attribute_designator OF entity_specification
+   --       IS expression ;
+   function Parse_Attribute return Iir
+   is
+      Loc : Location_Type;
+      Ident : Name_Id;
+   begin
+      Expect (Tok_Attribute);
+      Scan_Expect (Tok_Identifier);
+      Loc := Get_Token_Location;
+      Ident := Current_Identifier;
+      Scan;
+      case Current_Token is
+         when Tok_Colon =>
+            declare
+               Res : Iir_Attribute_Declaration;
+            begin
+               Res := Create_Iir (Iir_Kind_Attribute_Declaration);
+               Set_Location (Res, Loc);
+               Set_Identifier (Res, Ident);
+               Scan;
+               Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True));
+               Expect (Tok_Semi_Colon);
+               return Res;
+            end;
+         when Tok_Of =>
+            declare
+               Res : Iir_Attribute_Specification;
+               Designator : Iir_Simple_Name;
+            begin
+               Res := Create_Iir (Iir_Kind_Attribute_Specification);
+               Set_Location (Res, Loc);
+               Designator := Create_Iir (Iir_Kind_Simple_Name);
+               Set_Location (Designator, Loc);
+               Set_Identifier (Designator, Ident);
+               Set_Attribute_Designator (Res, Designator);
+               Scan;
+               Parse_Entity_Name_List (Res);
+               Expect (Tok_Is);
+               Scan;
+               Set_Expression (Res, Parse_Expression);
+               Expect (Tok_Semi_Colon);
+               return Res;
+            end;
+         when others =>
+            Error_Msg_Parse ("':' or 'of' expected after identifier");
+            return Null_Iir;
+      end case;
+   end Parse_Attribute;
+
+   --  precond : GROUP
+   --  postcond: ';'
+   --
+   --  [ §4.6 ]
+   --  group_template_declaration ::=
+   --     GROUP identifier IS (entity_class_entry_list) ;
+   --
+   --  entity_class_entry_list ::= entity_class_entry { , entity_class_entry }
+   --
+   --  entity_class_entry ::= entity_class [ <> ]
+   function Parse_Group return Iir is
+      Loc : Location_Type;
+      Ident : Name_Id;
+   begin
+      Expect (Tok_Group);
+      Scan_Expect (Tok_Identifier);
+      Loc := Get_Token_Location;
+      Ident := Current_Identifier;
+      Scan;
+      case Current_Token is
+         when Tok_Is =>
+            declare
+               use Iir_Chains.Entity_Class_Entry_Chain_Handling;
+               Res : Iir_Group_Template_Declaration;
+               El : Iir_Entity_Class;
+               Last : Iir_Entity_Class;
+            begin
+               Res := Create_Iir (Iir_Kind_Group_Template_Declaration);
+               Set_Location (Res, Loc);
+               Set_Identifier (Res, Ident);
+               Scan_Expect (Tok_Left_Paren);
+               Scan;
+               Build_Init (Last);
+               loop
+                  Append (Last, Res, Parse_Entity_Class_Entry);
+                  if Current_Token = Tok_Box then
+                     El := Create_Iir (Iir_Kind_Entity_Class);
+                     Set_Location (El);
+                     Set_Entity_Class (El, Tok_Box);
+                     Append (Last, Res, El);
+                     Scan;
+                     if Current_Token = Tok_Comma then
+                        Error_Msg_Parse
+                          ("'<>' is allowed only for the last "
+                            & "entity class entry");
+                     end if;
+                  end if;
+                  exit when Current_Token = Tok_Right_Paren;
+                  Expect (Tok_Comma);
+                  Scan;
+               end loop;
+               Scan_Expect (Tok_Semi_Colon);
+               return Res;
+            end;
+         when Tok_Colon =>
+            declare
+               Res : Iir_Group_Declaration;
+               List : Iir_Group_Constituent_List;
+            begin
+               Res := Create_Iir (Iir_Kind_Group_Declaration);
+               Set_Location (Res, Loc);
+               Set_Identifier (Res, Ident);
+               Scan;
+               Set_Group_Template_Name
+                 (Res, Parse_Name (Allow_Indexes => False));
+               Expect (Tok_Left_Paren);
+               Scan;
+               List := Create_Iir_List;
+               Set_Group_Constituent_List (Res, List);
+               loop
+                  Append_Element (List, Parse_Name (Allow_Indexes => False));
+                  exit when Current_Token = Tok_Right_Paren;
+                  Expect (Tok_Comma);
+                  Scan;
+               end loop;
+               Scan_Expect (Tok_Semi_Colon);
+               return Res;
+            end;
+         when others =>
+            Error_Msg_Parse ("':' or 'is' expected here");
+            return Null_Iir;
+      end case;
+   end Parse_Group;
+
+   --  precond : next token
+   --  postcond: ':'
+   --
+   --  [ §5.4 ]
+   --  signal_list ::= signal_name { , signal_name }
+   --                | OTHERS
+   --                | ALL
+   function Parse_Signal_List return Iir_List
+   is
+      Res : Iir_List;
+   begin
+      case Current_Token is
+         when Tok_Others =>
+            Scan;
+            return Iir_List_Others;
+         when Tok_All =>
+            Scan;
+            return Iir_List_All;
+         when others =>
+            Res := Create_Iir_List;
+            loop
+               Append_Element (Res, Parse_Name);
+               exit when Current_Token = Tok_Colon;
+               Expect (Tok_Comma);
+               Scan;
+            end loop;
+            return Res;
+      end case;
+   end Parse_Signal_List;
+
+   --  precond : DISCONNECT
+   --  postcond: ';'
+   --
+   --  [ §5.4 ]
+   --  disconnection_specification ::=
+   --      DISCONNECT guarded_signal_specification AFTER time_expression ;
+   function Parse_Disconnection_Specification
+     return Iir_Disconnection_Specification
+   is
+      Res : Iir_Disconnection_Specification;
+   begin
+      Res := Create_Iir (Iir_Kind_Disconnection_Specification);
+      Set_Location (Res);
+
+      --  Skip 'disconnect'
+      Expect (Tok_Disconnect);
+      Scan;
+
+      Set_Signal_List (Res, Parse_Signal_List);
+
+      --  Skip ':'
+      Expect (Tok_Colon);
+      Scan;
+
+      Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True));
+
+      --  Skip 'after'
+      Expect (Tok_After);
+      Scan;
+
+      Set_Expression (Res, Parse_Expression);
+      return Res;
+   end Parse_Disconnection_Specification;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ LRM93 4 ]
+   --  declaration ::= type_declaration
+   --                | subtype_declaration
+   --                | object_declaration
+   --                | interface_declaration
+   --                | alias_declaration
+   --                | attribute_declaration
+   --                | component_declaration
+   --                | group_template_declaration
+   --                | group_declaration
+   --                | entity_declaration
+   --                | configuration_declaration
+   --                | subprogram_declaration
+   --                | package_declaration
+   procedure Parse_Declarative_Part (Parent : Iir)
+   is
+      use Declaration_Chain_Handling;
+      Last_Decl : Iir;
+      Decl : Iir;
+   begin
+      Build_Init (Last_Decl);
+      loop
+         Decl := Null_Iir;
+         case Current_Token is
+            when Tok_Invalid =>
+               raise Internal_Error;
+            when Tok_Type =>
+               Decl := Parse_Type_Declaration (Parent);
+
+               --  LRM 2.5  Package declarations
+               --  If a package declarative item is a type declaration that is
+               --  a full type declaration whose type definition is a
+               --  protected_type definition, then that protected type
+               --  definition must not be a protected type body.
+               if Decl /= Null_Iir
+                 and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Body
+               then
+                  case Get_Kind (Parent) is
+                     when Iir_Kind_Package_Declaration =>
+                        Error_Msg_Parse ("protected type body not allowed "
+                                         & "in package declaration", Decl);
+                     when others =>
+                        null;
+                  end case;
+               end if;
+            when Tok_Subtype =>
+               Decl := Parse_Subtype_Declaration;
+            when Tok_Nature =>
+               Decl := Parse_Nature_Declaration;
+            when Tok_Terminal =>
+               Decl := Parse_Terminal_Declaration (Parent);
+            when Tok_Quantity =>
+               Decl := Parse_Quantity_Declaration (Parent);
+            when Tok_Signal =>
+               case Get_Kind (Parent) is
+                  when Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body =>
+                     Error_Msg_Parse
+                       ("signal declaration not allowed in subprogram body");
+                  when Iir_Kinds_Process_Statement =>
+                     Error_Msg_Parse
+                       ("signal declaration not allowed in process");
+                  when others =>
+                     null;
+               end case;
+               Decl := Parse_Object_Declaration (Parent);
+            when Tok_Constant =>
+               Decl := Parse_Object_Declaration (Parent);
+            when Tok_Variable =>
+               --  FIXME: remove this message (already checked during sem).
+               case Get_Kind (Parent) is
+                  when Iir_Kind_Entity_Declaration
+                    | Iir_Kind_Architecture_Body
+                    | Iir_Kind_Block_Statement
+                    | Iir_Kind_Package_Declaration
+                    | Iir_Kind_Package_Body =>
+                     --  FIXME: replace HERE with the kind of declaration
+                     --  ie: "not allowed in a package" rather than "here".
+                     Error_Msg_Parse ("variable declaration not allowed here");
+                  when others =>
+                     null;
+               end case;
+               Decl := Parse_Object_Declaration (Parent);
+            when Tok_Shared =>
+               if Flags.Vhdl_Std <= Vhdl_87 then
+                  Error_Msg_Parse ("shared variable not allowed in vhdl 87");
+               end if;
+               Decl := Parse_Object_Declaration (Parent);
+            when Tok_File =>
+               Decl := Parse_Object_Declaration (Parent);
+            when Tok_Function
+              | Tok_Procedure
+              | Tok_Pure
+              | Tok_Impure =>
+               Decl := Parse_Subprogram_Declaration (Parent);
+            when Tok_Alias =>
+               Decl := Parse_Alias_Declaration;
+            when Tok_Component =>
+               case Get_Kind (Parent) is
+                  when Iir_Kind_Entity_Declaration
+                    | Iir_Kind_Procedure_Body
+                    | Iir_Kind_Function_Body
+                    | Iir_Kinds_Process_Statement =>
+                     Error_Msg_Parse
+                       ("component declaration are not allowed here");
+                  when others =>
+                     null;
+               end case;
+               Decl := Parse_Component_Declaration;
+            when Tok_For =>
+               case Get_Kind (Parent) is
+                  when Iir_Kind_Entity_Declaration
+                    | Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body
+                    | Iir_Kinds_Process_Statement =>
+                     Error_Msg_Parse
+                       ("configuration specification not allowed here");
+                  when others =>
+                     null;
+               end case;
+               Decl := Parse_Configuration_Specification;
+            when Tok_Attribute =>
+               Decl := Parse_Attribute;
+            when Tok_Disconnect =>
+               case Get_Kind (Parent) is
+                  when Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body
+                    | Iir_Kinds_Process_Statement =>
+                     Error_Msg_Parse
+                       ("disconnect specification not allowed here");
+                  when others =>
+                     null;
+               end case;
+               Decl := Parse_Disconnection_Specification;
+            when Tok_Use =>
+               Decl := Parse_Use_Clause;
+            when Tok_Group =>
+               Decl := Parse_Group;
+
+            when Tok_Identifier =>
+               Error_Msg_Parse
+                 ("object class keyword such as 'variable' is expected");
+               Eat_Tokens_Until_Semi_Colon;
+            when Tok_Semi_Colon =>
+               Error_Msg_Parse ("';' (semi colon) not allowed alone");
+               Scan;
+            when others =>
+               exit;
+         end case;
+         if Decl /= Null_Iir then
+            Append_Subchain (Last_Decl, Parent, Decl);
+         end if;
+
+         if Current_Token = Tok_Semi_Colon or Current_Token = Tok_Invalid then
+            Scan;
+         end if;
+      end loop;
+   end Parse_Declarative_Part;
+
+   --  precond : ENTITY
+   --  postcond: ';'
+   --
+   --  [ §1.1 ]
+   --  entity_declaration ::=
+   --      ENTITY identifier IS
+   --          entiy_header
+   --          entity_declarative_part
+   --      [ BEGIN
+   --          entity_statement_part ]
+   --      END [ ENTITY ] [ ENTITY_simple_name ]
+   --
+   --  [ §1.1.1 ]
+   --  entity_header ::=
+   --      [ FORMAL_generic_clause ]
+   --      [ FORMAL_port_clause ]
+   procedure Parse_Entity_Declaration (Unit : Iir_Design_Unit)
+   is
+      Res: Iir_Entity_Declaration;
+   begin
+      Expect (Tok_Entity);
+      Res := Create_Iir (Iir_Kind_Entity_Declaration);
+
+      --  Get identifier.
+      Scan_Expect (Tok_Identifier,
+                   "an identifier is expected after ""entity""");
+      Set_Identifier (Res, Current_Identifier);
+      Set_Location (Res);
+
+      Scan_Expect (Tok_Is, "missing ""is"" after identifier");
+      Scan;
+
+      Parse_Generic_Port_Clauses (Res);
+
+      Parse_Declarative_Part (Res);
+
+      if Current_Token = Tok_Begin then
+         Set_Has_Begin (Res, True);
+         Scan;
+         Parse_Concurrent_Statements (Res);
+      end if;
+
+      --   end keyword is expected to finish an entity declaration
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+
+      Scan;
+      if Current_Token = Tok_Entity then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("""entity"" keyword not allowed here by vhdl 87");
+         end if;
+         Set_End_Has_Reserved_Id (Res, True);
+         Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Invalidate_Current_Token;
+      Set_Library_Unit (Unit, Res);
+   end Parse_Entity_Declaration;
+
+   --  [ LRM93 7.3.2 ]
+   --  choice ::= simple_expression
+   --           | discrete_range
+   --           | ELEMENT_simple_name
+   --           | OTHERS
+   function Parse_A_Choice (Expr: Iir) return Iir
+   is
+      A_Choice: Iir;
+      Expr1: Iir;
+   begin
+      if Expr = Null_Iir then
+         if Current_Token = Tok_Others then
+            A_Choice := Create_Iir (Iir_Kind_Choice_By_Others);
+            Set_Location (A_Choice);
+
+            --  Skip 'others'
+            Scan;
+
+            return A_Choice;
+         else
+            Expr1 := Parse_Expression;
+
+            if Expr1 = Null_Iir then
+               --  Handle parse error now.
+               --  FIXME: skip until '=>'.
+               A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
+               Set_Location (A_Choice);
+               return A_Choice;
+            end if;
+         end if;
+      else
+         Expr1 := Expr;
+      end if;
+      if Is_Range_Attribute_Name (Expr1) then
+         A_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+         Location_Copy (A_Choice, Expr1);
+         Set_Choice_Range (A_Choice, Expr1);
+         return A_Choice;
+      elsif Current_Token = Tok_To or else Current_Token = Tok_Downto then
+         A_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+         Location_Copy (A_Choice, Expr1);
+         Set_Choice_Range (A_Choice, Parse_Range_Right (Expr1));
+         return A_Choice;
+      else
+         A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
+         Location_Copy (A_Choice, Expr1);
+         Set_Choice_Expression (A_Choice, Expr1);
+         return A_Choice;
+      end if;
+   end Parse_A_Choice;
+
+   --  [ LRM93 7.3.2 ]
+   --  choices ::= choice { | choice }
+   --
+   -- Leave tok_double_arrow as current token.
+   function Parse_Choices (Expr: Iir) return Iir
+   is
+      First, Last : Iir;
+      A_Choice: Iir;
+      Expr1 : Iir;
+   begin
+      Sub_Chain_Init (First, Last);
+      Expr1 := Expr;
+      loop
+         A_Choice := Parse_A_Choice (Expr1);
+         if First /= Null_Iir then
+            Set_Same_Alternative_Flag (A_Choice, True);
+            if Get_Kind (A_Choice) = Iir_Kind_Choice_By_Others then
+               Error_Msg_Parse ("'others' choice must be alone");
+            end if;
+         end if;
+         Sub_Chain_Append (First, Last, A_Choice);
+         if Current_Token /= Tok_Bar then
+            return First;
+         end if;
+         Scan;
+         Expr1 := Null_Iir;
+      end loop;
+   end Parse_Choices;
+
+   --  precond : '('
+   --  postcond: next token
+   --
+   --  This can be an expression or an aggregate.
+   --
+   --  [ LRM93 7.3.2 ]
+   --  aggregate ::= ( element_association { , element_association } )
+   --
+   --  [ LRM93 7.3.2 ]
+   --  element_association ::= [ choices => ] expression
+   function Parse_Aggregate return Iir
+   is
+      use Iir_Chains.Association_Choices_Chain_Handling;
+      Expr: Iir;
+      Res: Iir;
+      Last : Iir;
+      Assoc: Iir;
+      Loc : Location_Type;
+   begin
+      Loc := Get_Token_Location;
+
+      --  Skip '('
+      Scan;
+
+      if Current_Token /= Tok_Others then
+         Expr := Parse_Expression;
+         case Current_Token is
+            when Tok_Comma
+              | Tok_Double_Arrow
+              | Tok_Bar =>
+               --  This is really an aggregate
+               null;
+            when Tok_Right_Paren =>
+               -- This was just a braced expression.
+
+               -- Eat ')'.
+               Scan;
+
+               if Get_Kind (Expr) = Iir_Kind_Aggregate then
+                  --  Parenthesis around aggregate is useless and change the
+                  --  context for array aggregate.
+                  Warning_Msg_Sem
+                    ("suspicious parenthesis around aggregate", Expr);
+               elsif not Flag_Parse_Parenthesis then
+                  return Expr;
+               end if;
+
+               --  Create a node for the parenthesis.
+               Res := Create_Iir (Iir_Kind_Parenthesis_Expression);
+               Set_Location (Res, Loc);
+               Set_Expression (Res, Expr);
+               return Res;
+
+            when Tok_Semi_Colon =>
+               --  Surely a missing parenthesis.
+               --  FIXME: in case of multiple missing parenthesises, several
+               --    messages will be displayed
+               Error_Msg_Parse ("missing ')' for opening parenthesis at "
+                                & Get_Location_Str (Loc, Filename => False));
+               return Expr;
+            when others =>
+               --  Surely a parse error...
+               null;
+         end case;
+      else
+         Expr := Null_Iir;
+      end if;
+      Res := Create_Iir (Iir_Kind_Aggregate);
+      Set_Location (Res, Loc);
+      Build_Init (Last);
+      loop
+         if Current_Token = Tok_Others then
+            Assoc := Parse_A_Choice (Null_Iir);
+            Expect (Tok_Double_Arrow);
+            Scan;
+            Expr := Parse_Expression;
+         else
+            if Expr = Null_Iir then
+               Expr := Parse_Expression;
+            end if;
+            if Expr = Null_Iir then
+               return Null_Iir;
+            end if;
+            case Current_Token is
+               when Tok_Comma
+                 | Tok_Right_Paren =>
+                  Assoc := Create_Iir (Iir_Kind_Choice_By_None);
+                  Location_Copy (Assoc, Expr);
+               when others =>
+                  Assoc := Parse_Choices (Expr);
+                  Expect (Tok_Double_Arrow);
+                  Scan;
+                  Expr := Parse_Expression;
+            end case;
+         end if;
+         Set_Associated_Expr (Assoc, Expr);
+         Append_Subchain (Last, Res, Assoc);
+         exit when Current_Token = Tok_Right_Paren;
+         Expect (Tok_Comma);
+         Scan;
+         Expr := Null_Iir;
+      end loop;
+      Scan;
+      return Res;
+   end Parse_Aggregate;
+
+   --  precond : NEW
+   --  postcond: next token
+   --
+   --  [LRM93 7.3.6]
+   --  allocator ::= NEW subtype_indication
+   --              | NEW qualified_expression
+   function Parse_Allocator return Iir
+   is
+      Loc: Location_Type;
+      Res : Iir;
+      Expr: Iir;
+   begin
+      Loc := Get_Token_Location;
+
+      -- Accept 'new'.
+      Scan;
+      Expr := Parse_Name (Allow_Indexes => False);
+      if Get_Kind (Expr) /= Iir_Kind_Qualified_Expression then
+         -- This is a subtype_indication.
+         Res := Create_Iir (Iir_Kind_Allocator_By_Subtype);
+         Expr := Parse_Subtype_Indication (Expr);
+         Set_Subtype_Indication (Res, Expr);
+      else
+         Res := Create_Iir (Iir_Kind_Allocator_By_Expression);
+         Set_Expression (Res, Expr);
+      end if;
+
+      Set_Location (Res, Loc);
+      return Res;
+   end Parse_Allocator;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  primary ::= name
+   --            | literal
+   --            | aggregate
+   --            | function_call
+   --            | qualified_expression
+   --            | type_conversion
+   --            | allocator
+   --            | ( expression )
+   --
+   --  [ §7.3.1 ]
+   --  literal ::= numeric_literal
+   --            | enumeration_literal
+   --            | string_literal
+   --            | bit_string_literal
+   --            | NULL
+   --
+   --  [ §7.3.1 ]
+   --  numeric_literal ::= abstract_literal
+   --                    | physical_literal
+   --
+   --  [ §13.4 ]
+   --  abstract_literal ::= decimal_literal | based_literal
+   --
+   --  [ §3.1.3 ]
+   --  physical_literal ::= [ abstract_literal ] UNIT_name
+   function Parse_Primary return Iir_Expression
+   is
+      Res: Iir_Expression;
+      Int: Iir_Int64;
+      Fp: Iir_Fp64;
+      Loc: Location_Type;
+   begin
+      case Current_Token is
+         when Tok_Integer =>
+            Int := Current_Iir_Int64;
+            Loc := Get_Token_Location;
+
+            --  Skip integer
+            Scan;
+
+            if Current_Token = Tok_Identifier then
+               -- physical literal
+               Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+               Set_Unit_Name (Res, Parse_Name (Allow_Indexes => False));
+            else
+               -- integer literal
+               Res := Create_Iir (Iir_Kind_Integer_Literal);
+            end if;
+            Set_Location (Res, Loc);
+            Set_Value (Res, Int);
+            return Res;
+
+         when Tok_Real =>
+            Fp := Current_Iir_Fp64;
+            Loc := Get_Token_Location;
+
+            --  Skip real
+            Scan;
+
+            if Current_Token = Tok_Identifier then
+               -- physical literal
+               Res := Create_Iir (Iir_Kind_Physical_Fp_Literal);
+               Set_Unit_Name (Res, Parse_Name (Allow_Indexes => False));
+            else
+               -- real literal
+               Res := Create_Iir (Iir_Kind_Floating_Point_Literal);
+            end if;
+            Set_Location (Res, Loc);
+            Set_Fp_Value (Res, Fp);
+            return Res;
+
+         when Tok_Identifier =>
+            return Parse_Name (Allow_Indexes => True);
+         when Tok_Character =>
+            Res := Current_Text;
+            Scan;
+            if Current_Token = Tok_Tick then
+               Error_Msg_Parse
+                 ("prefix of an attribute can't be a character literal");
+               --  skip tick.
+               Scan;
+               --  skip attribute designator
+               Scan;
+            end if;
+            return Res;
+         when Tok_Left_Paren =>
+            return Parse_Aggregate;
+         when Tok_String =>
+            return Parse_Name;
+         when Tok_Null =>
+            Res := Create_Iir (Iir_Kind_Null_Literal);
+            Set_Location (Res);
+            Scan;
+            return Res;
+         when Tok_New =>
+            return Parse_Allocator;
+         when Tok_Bit_String =>
+            Res := Create_Iir (Iir_Kind_Bit_String_Literal);
+            Set_Location (Res);
+            Set_String_Id (Res, Current_String_Id);
+            Set_String_Length (Res, Current_String_Length);
+            case Current_Iir_Int64 is
+               when 1 =>
+                  Set_Bit_String_Base (Res, Base_2);
+               when 3 =>
+                  Set_Bit_String_Base (Res, Base_8);
+               when 4 =>
+                  Set_Bit_String_Base (Res, Base_16);
+               when others =>
+                  raise Internal_Error;
+            end case;
+            Scan;
+            return Res;
+         when Tok_Minus
+           | Tok_Plus =>
+            Error_Msg_Parse
+              ("'-' and '+' are not allowed in primary, use parenthesis");
+            return Parse_Simple_Expression;
+         when Tok_Comma
+           | Tok_Semi_Colon
+           | Tok_Eof
+           | Tok_End =>
+            --  Token not to be skipped
+            Unexpected ("primary");
+            return Null_Iir;
+         when others =>
+            Unexpected ("primary");
+            Scan;
+            return Null_Iir;
+      end case;
+   end Parse_Primary;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  factor ::= primary [ ** primary ]
+   --           | ABS primary
+   --           | NOT primary
+   --           | logical_operator primary  [ VHDL08 9.1 ]
+   function Build_Unary_Factor (Primary : Iir; Op : Iir_Kind) return Iir is
+      Res : Iir;
+   begin
+      if Primary /= Null_Iir then
+         return Primary;
+      end if;
+      Res := Create_Iir (Op);
+      Set_Location (Res);
+      Scan;
+      Set_Operand (Res, Parse_Primary);
+      return Res;
+   end Build_Unary_Factor;
+
+   function Build_Unary_Factor_08 (Primary : Iir; Op : Iir_Kind) return Iir is
+   begin
+      if Primary /= Null_Iir then
+         return Primary;
+      end if;
+      if Flags.Vhdl_Std < Vhdl_08 then
+         Error_Msg_Parse ("missing left operand of logical expression");
+         --  Skip operator
+         Scan;
+         return Parse_Primary;
+      else
+         return Build_Unary_Factor (Primary, Op);
+      end if;
+   end Build_Unary_Factor_08;
+
+   function Parse_Factor (Primary : Iir := Null_Iir) return Iir_Expression is
+      Res, Left: Iir_Expression;
+   begin
+      case Current_Token is
+         when Tok_Abs =>
+            return Build_Unary_Factor (Primary, Iir_Kind_Absolute_Operator);
+         when Tok_Not =>
+            return Build_Unary_Factor (Primary, Iir_Kind_Not_Operator);
+
+         when Tok_And =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_And_Operator);
+         when Tok_Or =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_Or_Operator);
+         when Tok_Nand =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_Nand_Operator);
+         when Tok_Nor =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_Nor_Operator);
+         when Tok_Xor =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_Xor_Operator);
+         when Tok_Xnor =>
+            return Build_Unary_Factor_08
+              (Primary, Iir_Kind_Reduction_Xnor_Operator);
+
+         when others =>
+            if Primary /= Null_Iir then
+               Left := Primary;
+            else
+               Left := Parse_Primary;
+            end if;
+            if Current_Token = Tok_Double_Star then
+               Res := Create_Iir (Iir_Kind_Exponentiation_Operator);
+               Set_Location (Res);
+               Scan;
+               Set_Left (Res, Left);
+               Set_Right (Res, Parse_Primary);
+               return Res;
+            else
+               return Left;
+            end if;
+      end case;
+   end Parse_Factor;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  term ::= factor { multiplying_operator factor }
+   --
+   --  [ §7.2 ]
+   --  multiplying_operator ::= * | / | MOD | REM
+   function Parse_Term (Primary : Iir) return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      Res := Parse_Factor (Primary);
+      while Current_Token in Token_Multiplying_Operator_Type loop
+         case Current_Token is
+            when Tok_Star =>
+               Tmp := Create_Iir (Iir_Kind_Multiplication_Operator);
+            when Tok_Slash =>
+               Tmp := Create_Iir (Iir_Kind_Division_Operator);
+            when Tok_Mod =>
+               Tmp := Create_Iir (Iir_Kind_Modulus_Operator);
+            when Tok_Rem =>
+               Tmp := Create_Iir (Iir_Kind_Remainder_Operator);
+            when others =>
+               raise Program_Error;
+         end case;
+         Set_Location (Tmp);
+         Set_Left (Tmp, Res);
+         Scan;
+         Set_Right (Tmp, Parse_Factor);
+         Res := Tmp;
+      end loop;
+      return Res;
+   end Parse_Term;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  simple_expression ::= [ sign ] term { adding_operator term }
+   --
+   --  [ §7.2 ]
+   --  sign ::= + | -
+   --
+   --  [ §7.2 ]
+   --  adding_operator ::= + | - | &
+   function Parse_Simple_Expression (Primary : Iir := Null_Iir)
+                                    return Iir_Expression
+   is
+      Res, Tmp: Iir_Expression;
+   begin
+      if Current_Token in Token_Sign_Type
+        and then Primary = Null_Iir
+      then
+         case Current_Token is
+            when Tok_Plus =>
+               Res := Create_Iir (Iir_Kind_Identity_Operator);
+            when Tok_Minus =>
+               Res := Create_Iir (Iir_Kind_Negation_Operator);
+            when others =>
+               raise Program_Error;
+         end case;
+         Set_Location (Res);
+         Scan;
+         Set_Operand (Res, Parse_Term (Null_Iir));
+      else
+         Res := Parse_Term (Primary);
+      end if;
+      while Current_Token in Token_Adding_Operator_Type loop
+         case Current_Token is
+            when Tok_Plus =>
+               Tmp := Create_Iir (Iir_Kind_Addition_Operator);
+            when Tok_Minus =>
+               Tmp := Create_Iir (Iir_Kind_Substraction_Operator);
+            when Tok_Ampersand =>
+               Tmp := Create_Iir (Iir_Kind_Concatenation_Operator);
+            when others =>
+               raise Program_Error;
+         end case;
+         Set_Location (Tmp);
+         Scan;
+         Set_Left (Tmp, Res);
+         Set_Right (Tmp, Parse_Term (Null_Iir));
+         Res := Tmp;
+      end loop;
+      return Res;
+   end Parse_Simple_Expression;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  shift_expression ::=
+   --      simple_expression [ shift_operator simple_expression ]
+   --
+   --  [ §7.2 ]
+   --  shift_operator ::= SLL | SRL | SLA | SRA | ROL | ROR
+   function Parse_Shift_Expression return Iir_Expression is
+      Res, Tmp: Iir_Expression;
+   begin
+      Tmp := Parse_Simple_Expression;
+      if Current_Token not in Token_Shift_Operator_Type then
+         return Tmp;
+      elsif Flags.Vhdl_Std = Vhdl_87 then
+         Error_Msg_Parse ("shift operators not allowed in vhdl 87");
+      end if;
+      case Current_Token is
+         when Tok_Sll =>
+            Res := Create_Iir (Iir_Kind_Sll_Operator);
+         when Tok_Sla =>
+            Res := Create_Iir (Iir_Kind_Sla_Operator);
+         when Tok_Srl =>
+            Res := Create_Iir (Iir_Kind_Srl_Operator);
+         when Tok_Sra =>
+            Res := Create_Iir (Iir_Kind_Sra_Operator);
+         when Tok_Rol =>
+            Res := Create_Iir (Iir_Kind_Rol_Operator);
+         when Tok_Ror =>
+            Res := Create_Iir (Iir_Kind_Ror_Operator);
+         when others =>
+            raise Program_Error;
+      end case;
+      Set_Location (Res);
+      Scan;
+      Set_Left (Res, Tmp);
+      Set_Right (Res, Parse_Simple_Expression);
+      return Res;
+   end Parse_Shift_Expression;
+
+   --  precond : next token (relational_operator)
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --     relational_operator shift_expression
+   function Parse_Relation_Rhs (Left : Iir) return Iir
+   is
+      Res, Tmp: Iir_Expression;
+   begin
+      Tmp := Left;
+
+      --  This loop is just to handle errors such as a = b = c.
+      loop
+         case Current_Token is
+            when Tok_Equal =>
+               Res := Create_Iir (Iir_Kind_Equality_Operator);
+            when Tok_Not_Equal =>
+               Res := Create_Iir (Iir_Kind_Inequality_Operator);
+            when Tok_Less =>
+               Res := Create_Iir (Iir_Kind_Less_Than_Operator);
+            when Tok_Less_Equal =>
+               Res := Create_Iir (Iir_Kind_Less_Than_Or_Equal_Operator);
+            when Tok_Greater =>
+               Res := Create_Iir (Iir_Kind_Greater_Than_Operator);
+            when Tok_Greater_Equal =>
+               Res := Create_Iir (Iir_Kind_Greater_Than_Or_Equal_Operator);
+            when Tok_Match_Equal =>
+               Res := Create_Iir (Iir_Kind_Match_Equality_Operator);
+            when Tok_Match_Not_Equal =>
+               Res := Create_Iir (Iir_Kind_Match_Inequality_Operator);
+            when Tok_Match_Less =>
+               Res := Create_Iir (Iir_Kind_Match_Less_Than_Operator);
+            when Tok_Match_Less_Equal =>
+               Res := Create_Iir (Iir_Kind_Match_Less_Than_Or_Equal_Operator);
+            when Tok_Match_Greater =>
+               Res := Create_Iir (Iir_Kind_Match_Greater_Than_Operator);
+            when Tok_Match_Greater_Equal =>
+               Res := Create_Iir
+                 (Iir_Kind_Match_Greater_Than_Or_Equal_Operator);
+            when others =>
+               raise Program_Error;
+         end case;
+         Set_Location (Res);
+         Scan;
+         Set_Left (Res, Tmp);
+         Set_Right (Res, Parse_Shift_Expression);
+         exit when Current_Token not in Token_Relational_Operator_Type;
+         Error_Msg_Parse
+           ("use parenthesis for consecutive relational expressions");
+         Tmp := Res;
+      end loop;
+      return Res;
+   end Parse_Relation_Rhs;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  relation ::= shift_expression [ relational_operator shift_expression ]
+   --
+   --  [ §7.2 ]
+   --  relational_operator ::= = | /= | < | <= | > | >=
+   --                        | ?= | ?/= | ?< | ?<= | ?> | ?>=
+   function Parse_Relation return Iir
+   is
+      Tmp: Iir;
+   begin
+      Tmp := Parse_Shift_Expression;
+      if Current_Token not in Token_Relational_Operator_Type then
+         return Tmp;
+      end if;
+
+      return Parse_Relation_Rhs (Tmp);
+   end Parse_Relation;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §7.1 ]
+   --  expression ::= relation { AND relation }
+   --               | relation { OR relation }
+   --               | relation { XOR relation }
+   --               | relation [ NAND relation }
+   --               | relation [ NOR relation }
+   --               | relation { XNOR relation }
+   function Parse_Expression_Rhs (Left : Iir) return Iir
+   is
+      Res, Tmp: Iir;
+
+      --  OP_TOKEN contains the operator combinaison.
+      Op_Token: Token_Type;
+   begin
+      Tmp := Left;
+      Op_Token := Tok_Invalid;
+      loop
+         case Current_Token is
+            when Tok_And =>
+               Res := Create_Iir (Iir_Kind_And_Operator);
+            when Tok_Or =>
+               Res := Create_Iir (Iir_Kind_Or_Operator);
+            when Tok_Xor =>
+               Res := Create_Iir (Iir_Kind_Xor_Operator);
+            when Tok_Nand =>
+               Res := Create_Iir (Iir_Kind_Nand_Operator);
+            when Tok_Nor =>
+               Res := Create_Iir (Iir_Kind_Nor_Operator);
+            when Tok_Xnor =>
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Parse ("'xnor' keyword not allowed in vhdl 87");
+               end if;
+               Res := Create_Iir (Iir_Kind_Xnor_Operator);
+            when others =>
+               return Tmp;
+         end case;
+
+         if Op_Token = Tok_Invalid then
+            Op_Token := Current_Token;
+         else
+            --  Check after the case, since current_token may not be an
+            --  operator...
+            --  TODO: avoid repetition of this message ?
+            if Op_Token = Tok_Nand or Op_Token = Tok_Nor then
+               Error_Msg_Parse ("sequence of 'nor' or 'nand' not allowed");
+               Error_Msg_Parse ("('nor' and 'nand' are not associative)");
+            end if;
+            if Op_Token /= Current_Token then
+               --  Expression is a sequence of relations, with the same
+               --  operator.
+               Error_Msg_Parse ("only one type of logical operators may be "
+                                & "used to combine relation");
+            end if;
+         end if;
+
+         Set_Location (Res);
+         Scan;
+
+         --  Catch errors for Ada programmers.
+         if Current_Token = Tok_Then or Current_Token = Tok_Else then
+            Error_Msg_Parse ("""or else"" and ""and then"" sequences "
+                             & "are not allowed in vhdl");
+            Error_Msg_Parse ("""and"" and ""or"" are short-circuit "
+                             & "operators for BIT and BOOLEAN types");
+            Scan;
+         end if;
+
+         Set_Left (Res, Tmp);
+         Set_Right (Res, Parse_Relation);
+         Tmp := Res;
+      end loop;
+   end Parse_Expression_Rhs;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  LRM08 9.1 General
+   --  expression ::= condition_operator primary
+   --              |  logical_expression
+   function Parse_Expression return Iir_Expression
+   is
+      Res : Iir;
+   begin
+      if Current_Token = Tok_Condition then
+         Res := Create_Iir (Iir_Kind_Condition_Operator);
+         Set_Location (Res);
+
+         --  Skip '??'
+         Scan;
+
+         Set_Operand (Res, Parse_Primary);
+      else
+         Res := Parse_Expression_Rhs (Parse_Relation);
+      end if;
+
+      return Res;
+   end Parse_Expression;
+
+   --  precond : next token
+   --  postcond: next token.
+   --
+   --  [ §8.4 ]
+   --  waveform ::= waveform_element { , waveform_element }
+   --             | UNAFFECTED
+   --
+   --  [ §8.4.1 ]
+   --  waveform_element ::= VALUE_expression [ AFTER TIME_expression ]
+   --                     | NULL [ AFTER TIME_expression ]
+   function Parse_Waveform return Iir_Waveform_Element
+   is
+      Res: Iir_Waveform_Element;
+      We, Last_We : Iir_Waveform_Element;
+   begin
+      if Current_Token = Tok_Unaffected then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("'unaffected' is not allowed in vhdl87");
+         end if;
+         Scan;
+         return Null_Iir;
+      else
+         Sub_Chain_Init (Res, Last_We);
+         loop
+            We := Create_Iir (Iir_Kind_Waveform_Element);
+            Sub_Chain_Append (Res, Last_We, We);
+            Set_Location (We);
+            --  Note: NULL is handled as a null_literal.
+            Set_We_Value (We, Parse_Expression);
+            if Current_Token = Tok_After then
+               Scan;
+               Set_Time (We, Parse_Expression);
+            end if;
+            exit when Current_Token /= Tok_Comma;
+            Scan;
+         end loop;
+         return Res;
+      end if;
+   end Parse_Waveform;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §8.4 ]
+   --  delay_mechanism ::= TRANSPORT
+   --                    | [ REJECT TIME_expression ] INERTIAL
+   procedure Parse_Delay_Mechanism (Assign: Iir) is
+   begin
+      if Current_Token = Tok_Transport then
+         Set_Delay_Mechanism (Assign, Iir_Transport_Delay);
+         Scan;
+      else
+         Set_Delay_Mechanism (Assign, Iir_Inertial_Delay);
+         if Current_Token = Tok_Reject then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse
+                 ("'reject' delay mechanism not allowed in vhdl 87");
+            end if;
+            Scan;
+            Set_Reject_Time_Expression (Assign, Parse_Expression);
+            Expect (Tok_Inertial);
+            Scan;
+         elsif Current_Token = Tok_Inertial then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse
+                 ("'inertial' keyword not allowed in vhdl 87");
+            end if;
+            Scan;
+         end if;
+      end if;
+   end Parse_Delay_Mechanism;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §9.5 ]
+   --  options ::= [ GUARDED ] [ delay_mechanism ]
+   procedure Parse_Options (Stmt : Iir) is
+   begin
+      if Current_Token = Tok_Guarded then
+         Set_Guard (Stmt, Stmt);
+         Scan;
+      end if;
+      Parse_Delay_Mechanism (Stmt);
+   end Parse_Options;
+
+   --  precond : next tkoen
+   --  postcond: ';'
+   --
+   --  [ §9.5.1 ]
+   --  conditional_signal_assignment ::=
+   --      target <= options conditional_waveforms ;
+   --
+   --  [ §9.5.1 ]
+   --  conditional_waveforms ::=
+   --      { waveform WHEN condition ELSE }
+   --      waveform [ WHEN condition ]
+   function Parse_Conditional_Signal_Assignment (Target: Iir) return Iir
+   is
+      use Iir_Chains.Conditional_Waveform_Chain_Handling;
+      Res: Iir;
+      Cond_Wf, Last_Cond_Wf : Iir_Conditional_Waveform;
+   begin
+      Res := Create_Iir (Iir_Kind_Concurrent_Conditional_Signal_Assignment);
+      Set_Target (Res, Target);
+      Location_Copy (Res, Get_Target (Res));
+
+      case Current_Token is
+         when Tok_Less_Equal =>
+            null;
+         when Tok_Assign =>
+            Error_Msg_Parse ("':=' not allowed in concurrent statement, "
+                             & "replaced by '<='");
+         when others =>
+            Expect (Tok_Less_Equal);
+      end case;
+      Scan;
+
+      Parse_Options (Res);
+
+      Build_Init (Last_Cond_Wf);
+      loop
+         Cond_Wf := Create_Iir (Iir_Kind_Conditional_Waveform);
+         Append (Last_Cond_Wf, Res, Cond_Wf);
+         Set_Location (Cond_Wf);
+         Set_Waveform_Chain (Cond_Wf, Parse_Waveform);
+         exit when Current_Token /= Tok_When;
+         Scan;
+         Set_Condition (Cond_Wf, Parse_Expression);
+         if Current_Token /= Tok_Else then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("else missing in vhdl 87");
+            end if;
+            exit;
+         end if;
+         Scan;
+      end loop;
+      Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Conditional_Signal_Assignment;
+
+   --  precond : WITH
+   --  postcond: ';'
+   --
+   --  [ §9.5.2 ]
+   --  selected_signal_assignment ::=
+   --      WITH expresion SELECT
+   --          target <= options selected_waveforms ;
+   --
+   --  [ §9.5.2 ]
+   --  selected_waveforms ::=
+   --      { waveform WHEN choices , }
+   --      waveform WHEN choices
+   function Parse_Selected_Signal_Assignment return Iir
+   is
+      use Iir_Chains.Selected_Waveform_Chain_Handling;
+      Res: Iir;
+      Assoc: Iir;
+      Wf_Chain : Iir_Waveform_Element;
+      Target : Iir;
+      Last : Iir;
+   begin
+      Scan;  -- accept 'with' token.
+      Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment);
+      Set_Location (Res);
+      Set_Expression (Res, Parse_Expression);
+
+      Expect (Tok_Select, "'select' expected after expression");
+      Scan;
+      if Current_Token = Tok_Left_Paren then
+         Target := Parse_Aggregate;
+      else
+         Target := Parse_Name (Allow_Indexes => True);
+      end if;
+      Set_Target (Res, Target);
+      Expect (Tok_Less_Equal);
+      Scan;
+
+      Parse_Options (Res);
+
+      Build_Init (Last);
+      loop
+         Wf_Chain := Parse_Waveform;
+         Expect (Tok_When, "'when' expected after waveform");
+         Scan;
+         Assoc := Parse_Choices (Null_Iir);
+         Set_Associated_Chain (Assoc, Wf_Chain);
+         Append_Subchain (Last, Res, Assoc);
+         exit when Current_Token = Tok_Semi_Colon;
+         Expect (Tok_Comma, "',' (comma) expected after choice");
+         Scan;
+      end loop;
+      return Res;
+   end Parse_Selected_Signal_Assignment;
+
+   --  precond : next token
+   --  postcond: next token.
+   --
+   --  [ §8.1 ]
+   --  sensitivity_list ::= SIGNAL_name { , SIGNAL_name }
+   procedure Parse_Sensitivity_List (List: Iir_Designator_List)
+   is
+      El : Iir;
+   begin
+      loop
+         El := Parse_Name (Allow_Indexes => True);
+         case Get_Kind (El) is
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Parenthesis_Name
+              | Iir_Kind_Selected_Name
+              | Iir_Kind_Slice_Name
+              | Iir_Kind_Attribute_Name
+              | Iir_Kind_Selected_By_All_Name
+              | Iir_Kind_Indexed_Name =>
+               null;
+            when others =>
+               Error_Msg_Parse
+                 ("only names are allowed in a sensitivity list");
+         end case;
+         Append_Element (List, El);
+         exit when Current_Token /= Tok_Comma;
+         Scan;
+      end loop;
+   end Parse_Sensitivity_List;
+
+   --  precond : ASSERT
+   --  postcond: next token
+   --  Note: this fill an sequential or a concurrent statement.
+   --
+   --  [ §8.2 ]
+   --  assertion ::= ASSERT condition
+   --      [ REPORT expression ] [ SEVERITY expression ]
+   procedure Parse_Assertion (Stmt: Iir) is
+   begin
+      Set_Location (Stmt);
+      Scan;
+      Set_Assertion_Condition (Stmt, Parse_Expression);
+      if Current_Token = Tok_Report then
+         Scan;
+         Set_Report_Expression (Stmt, Parse_Expression);
+      end if;
+      if Current_Token = Tok_Severity then
+         Scan;
+         Set_Severity_Expression (Stmt, Parse_Expression);
+         if Current_Token = Tok_Report then
+            --  Nice message in case of inversion.
+            Error_Msg_Parse
+              ("report expression must precede severity expression");
+            Scan;
+            Set_Report_Expression (Stmt, Parse_Expression);
+         end if;
+      end if;
+   end Parse_Assertion;
+
+   --  precond : REPORT
+   --  postcond: next token
+   --
+   --  [ 8.3 ]
+   --  report_statement ::= REPORT expression [ SEVERITY expression ]
+   function Parse_Report_Statement return Iir_Report_Statement
+   is
+      Res : Iir_Report_Statement;
+   begin
+      Res := Create_Iir (Iir_Kind_Report_Statement);
+      Set_Location (Res);
+      if Flags.Vhdl_Std = Vhdl_87 then
+         Error_Msg_Parse ("report statement not allowed in vhdl87");
+      end if;
+      Scan;
+      Set_Report_Expression (Res, Parse_Expression);
+      if Current_Token = Tok_Severity then
+         Scan;
+         Set_Severity_Expression (Res, Parse_Expression);
+      end if;
+      return Res;
+   end Parse_Report_Statement;
+
+   -- precond : WAIT
+   -- postcond: ';'
+   --
+   --  [ §8.1 ]
+   --  wait_statement ::=
+   --      [ label : ] WAIT [ sensitivity_clause ] [ condition_clause ]
+   --          [ timeout_clause ] ;
+   --
+   --  [ §8.1 ]
+   --  sensitivity_clause ::= ON sensitivity_list
+   --
+   --  [ §8.1 ]
+   --  condition_clause ::= UNTIL conditiion
+   --
+   --  [ §8.1 ]
+   --  timeout_clause ::= FOR TIME_expression
+   function Parse_Wait_Statement return Iir_Wait_Statement
+   is
+      Res: Iir_Wait_Statement;
+      List: Iir_List;
+   begin
+      Res := Create_Iir (Iir_Kind_Wait_Statement);
+      Set_Location (Res);
+      Scan;
+      case Current_Token is
+         when Tok_On =>
+            List := Create_Iir_List;
+            Set_Sensitivity_List (Res, List);
+            Scan;
+            Parse_Sensitivity_List (List);
+         when Tok_Until =>
+            null;
+         when Tok_For =>
+            null;
+         when Tok_Semi_Colon =>
+            return Res;
+         when others =>
+            Error_Msg_Parse ("'on', 'until', 'for' or ';' expected");
+            Eat_Tokens_Until_Semi_Colon;
+            return Res;
+      end case;
+      case Current_Token is
+         when Tok_On =>
+            Error_Msg_Parse ("only one sensitivity is allowed");
+            -- FIXME: sync
+            return Res;
+         when Tok_Until =>
+            Scan;
+            Set_Condition_Clause (Res, Parse_Expression);
+         when Tok_For =>
+            null;
+         when Tok_Semi_Colon =>
+            return Res;
+         when others =>
+            Error_Msg_Parse ("'until', 'for' or ';' expected");
+            Eat_Tokens_Until_Semi_Colon;
+            return Res;
+      end case;
+      case Current_Token is
+         when Tok_On =>
+            Error_Msg_Parse ("only one sensitivity clause is allowed");
+            -- FIXME: sync
+            return Res;
+         when Tok_Until =>
+            Error_Msg_Parse ("only one condition clause is allowed");
+            -- FIXME: sync
+            return Res;
+         when Tok_For =>
+            Scan;
+            Set_Timeout_Clause (Res, Parse_Expression);
+            return Res;
+         when Tok_Semi_Colon =>
+            return Res;
+         when others =>
+            Error_Msg_Parse ("'for' or ';' expected");
+            Eat_Tokens_Until_Semi_Colon;
+            return Res;
+      end case;
+   end Parse_Wait_Statement;
+
+   --  precond : IF
+   --  postcond: next token.
+   --
+   --  [ §8.7 ]
+   --  if_statement ::=
+   --    [ IF_label : ]
+   --        IF condition THEN
+   --            sequence_of_statements
+   --        { ELSIF condition THEN
+   --            sequence_of_statements }
+   --        [ ELSE
+   --            sequence_of_statements ]
+   --        END IF [ IF_label ] ;
+   --
+   -- FIXME: end label.
+   function Parse_If_Statement (Parent : Iir) return Iir_If_Statement
+   is
+      Res: Iir_If_Statement;
+      Clause: Iir;
+      N_Clause: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_If_Statement);
+      Set_Location (Res);
+      Set_Parent (Res, Parent);
+      Scan;
+      Clause := Res;
+      loop
+         Set_Condition (Clause, Parse_Expression);
+         Expect (Tok_Then, "'then' is expected here");
+         Scan;
+         Set_Sequential_Statement_Chain
+           (Clause, Parse_Sequential_Statements (Res));
+         exit when Current_Token = Tok_End;
+         N_Clause := Create_Iir (Iir_Kind_Elsif);
+         Set_Location (N_Clause);
+         Set_Else_Clause (Clause, N_Clause);
+         Clause := N_Clause;
+         if Current_Token = Tok_Else then
+            Scan;
+            Set_Sequential_Statement_Chain
+              (Clause, Parse_Sequential_Statements (Res));
+            exit;
+         elsif Current_Token = Tok_Elsif then
+            Scan;
+         else
+            Error_Msg_Parse ("'else' or 'elsif' expected");
+         end if;
+      end loop;
+      Expect (Tok_End);
+      Scan_Expect (Tok_If);
+      Scan;
+      return Res;
+   end Parse_If_Statement;
+
+   function Parenthesis_Name_To_Procedure_Call (Name: Iir; Kind : Iir_Kind)
+                                               return Iir
+   is
+      Res: Iir;
+      Call : Iir_Procedure_Call;
+   begin
+      Res := Create_Iir (Kind);
+      Location_Copy (Res, Name);
+      Call := Create_Iir (Iir_Kind_Procedure_Call);
+      Location_Copy (Call, Name);
+      Set_Procedure_Call (Res, Call);
+      case Get_Kind (Name) is
+         when Iir_Kind_Parenthesis_Name =>
+            Set_Prefix (Call, Get_Prefix (Name));
+            Set_Parameter_Association_Chain
+              (Call, Get_Association_Chain (Name));
+            Free_Iir (Name);
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Set_Prefix (Call, Name);
+         when Iir_Kind_Attribute_Name =>
+            Error_Msg_Parse ("attribute cannot be used as procedure call");
+         when others =>
+            Error_Kind ("parenthesis_name_to_procedure_call", Name);
+      end case;
+      return Res;
+   end Parenthesis_Name_To_Procedure_Call;
+
+   --  precond : identifier
+   --  postcond: next token
+   --
+   --  [ LRM93 8.9 ]
+   --  parameter_specification ::= identifier IN discrete_range
+   function Parse_Parameter_Specification (Parent : Iir)
+                                          return Iir_Iterator_Declaration
+   is
+      Decl : Iir_Iterator_Declaration;
+   begin
+      Decl := Create_Iir (Iir_Kind_Iterator_Declaration);
+      Set_Location (Decl);
+      Set_Parent (Decl, Parent);
+
+      Expect (Tok_Identifier);
+      Set_Identifier (Decl, Current_Identifier);
+
+      --  Skip identifier
+      Scan_Expect (Tok_In);
+
+      --  Skip 'in'
+      Scan;
+
+      Set_Discrete_Range (Decl, Parse_Discrete_Range);
+      return Decl;
+   end Parse_Parameter_Specification;
+
+   --  precond:  '<='
+   --  postcond: next token
+   --
+   --  [ §8.4 ]
+   --  signal_assignment_statement ::=
+   --      [ label : ] target <= [ delay_mechanism ] waveform ;
+   function Parse_Signal_Assignment_Statement (Target : Iir) return Iir
+   is
+      Stmt : Iir;
+      Wave_Chain : Iir_Waveform_Element;
+   begin
+      Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement);
+      Location_Copy (Stmt, Target);
+      Set_Target (Stmt, Target);
+      Scan;
+      Parse_Delay_Mechanism (Stmt);
+      Wave_Chain := Parse_Waveform;
+      --  LRM 8.4 Signal assignment statement
+      --  It is an error is the reserved word UNAFFECTED appears as a
+      --  waveform in a (sequential) signa assignment statement.
+      if Wave_Chain = Null_Iir then
+         Error_Msg_Parse
+           ("'unaffected' is not allowed in a sequential statement");
+      end if;
+      Set_Waveform_Chain (Stmt, Wave_Chain);
+      return Stmt;
+   end Parse_Signal_Assignment_Statement;
+
+   --  precond:  ':='
+   --  postcond: next token
+   --
+   --  [ §8.5 ]
+   --  variable_assignment_statement ::=
+   --      [ label : ] target := expression ;
+   function Parse_Variable_Assignment_Statement (Target : Iir) return Iir
+   is
+      Stmt : Iir;
+   begin
+      Stmt := Create_Iir (Iir_Kind_Variable_Assignment_Statement);
+      Location_Copy (Stmt, Target);
+      Set_Target (Stmt, Target);
+      Scan;
+      Set_Expression (Stmt, Parse_Expression);
+      return Stmt;
+   end Parse_Variable_Assignment_Statement;
+
+   --  precond:  next token
+   --  postcond: next token
+   --
+   --  [ 8 ]
+   --  sequence_of_statement ::= { sequential_statement }
+   --
+   --  [ 8 ]
+   --  sequential_statement ::= wait_statement
+   --                         | assertion_statement
+   --                         | report_statement
+   --                         | signal_assignment_statement
+   --                         | variable_assignment_statement
+   --                         | procedure_call_statement
+   --                         | if_statement
+   --                         | case_statement
+   --                         | loop_statement
+   --                         | next_statement
+   --                         | exit_statement
+   --                         | return_statement
+   --                         | null_statement
+   --
+   --  [ 8.13 ]
+   --  null_statement ::= [ label : ] NULL ;
+   --
+   --  [ 8.12 ]
+   --  return_statement ::= [ label : ] RETURN [ expression ]
+   --
+   --  [ 8.10 ]
+   --  next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ;
+   --
+   --  [ 8.11 ]
+   --  exit_statement ::= [ label : ] EXIT [ LOOP_label ] [ WHEN condition ] ;
+   --
+   --  [ 8.9 ]
+   --  loop_statement ::=
+   --      [ LOOP_label : ]
+   --          [ iteration_scheme ] LOOP
+   --              sequence_of_statements
+   --          END LOOP [ LOOP_label ] ;
+   --
+   --  [ 8.9 ]
+   --  iteration_scheme ::= WHILE condition
+   --                     | FOR LOOP_parameter_specification
+   --
+   --  [ 8.8 ]
+   --  case_statement ::=
+   --      [ CASE_label : ]
+   --          CASE expression IS
+   --              case_statement_alternative
+   --              { case_statement_alternative }
+   --          END CASE [ CASE_label ] ;
+   --
+   --  [ 8.8 ]
+   --  case_statement_alternative ::= WHEN choices => sequence_of_statements
+   --
+   --  [ 8.2 ]
+   --  assertion_statement ::= [ label : ] assertion ;
+   --
+   --  [ 8.3 ]
+   --  report_statement ::= [ label : ] REPORT expression SEVERITY expression ;
+   function Parse_Sequential_Assignment_Statement (Target : Iir) return Iir
+   is
+      Stmt : Iir;
+      Call : Iir;
+   begin
+      if Current_Token = Tok_Less_Equal then
+         return Parse_Signal_Assignment_Statement (Target);
+      elsif Current_Token = Tok_Assign then
+         return Parse_Variable_Assignment_Statement (Target);
+      elsif Current_Token = Tok_Semi_Colon then
+         return Parenthesis_Name_To_Procedure_Call
+           (Target, Iir_Kind_Procedure_Call_Statement);
+      else
+         Error_Msg_Parse ("""<="" or "":="" expected instead of "
+                          & Image (Current_Token));
+         Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement);
+         Call := Create_Iir (Iir_Kind_Procedure_Call);
+         Set_Prefix (Call, Target);
+         Set_Procedure_Call (Stmt, Call);
+         Set_Location (Call);
+         Eat_Tokens_Until_Semi_Colon;
+         return Stmt;
+      end if;
+   end Parse_Sequential_Assignment_Statement;
+
+   function Parse_Sequential_Statements (Parent : Iir)
+     return Iir
+   is
+      First_Stmt : Iir;
+      Last_Stmt : Iir;
+      Stmt: Iir;
+      Label: Name_Id;
+      Loc : Location_Type;
+      Target : Iir;
+   begin
+      First_Stmt := Null_Iir;
+      Last_Stmt := Null_Iir;
+      -- Expect a current_token.
+      loop
+         Loc := Get_Token_Location;
+         if Current_Token = Tok_Identifier then
+            Label := Current_Identifier;
+            Scan;
+            if Current_Token = Tok_Colon then
+               Scan;
+            else
+               Target := Create_Iir (Iir_Kind_Simple_Name);
+               Set_Identifier (Target, Label);
+               Set_Location (Target, Loc);
+               Label := Null_Identifier;
+               Target := Parse_Name_Suffix (Target, True);
+               Stmt := Parse_Sequential_Assignment_Statement (Target);
+               goto Has_Stmt;
+            end if;
+         else
+            Label := Null_Identifier;
+         end if;
+
+         case Current_Token is
+            when Tok_Null =>
+               Stmt := Create_Iir (Iir_Kind_Null_Statement);
+               Scan;
+            when Tok_Assert =>
+               Stmt := Create_Iir (Iir_Kind_Assertion_Statement);
+               Parse_Assertion (Stmt);
+            when Tok_Report =>
+               Stmt := Parse_Report_Statement;
+            when Tok_If =>
+               Stmt := Parse_If_Statement (Parent);
+               Set_Label (Stmt, Label);
+               Set_Location (Stmt, Loc);
+               if Flags.Vhdl_Std >= Vhdl_93c then
+                  Check_End_Name (Stmt);
+               end if;
+            when Tok_Identifier
+              | Tok_String =>
+               --  String for an expanded name with operator_symbol prefix.
+               Stmt := Parse_Sequential_Assignment_Statement (Parse_Name);
+            when Tok_Left_Paren =>
+               declare
+                  Target : Iir;
+               begin
+                  Target := Parse_Aggregate;
+                  if Current_Token = Tok_Less_Equal then
+                     Stmt := Parse_Signal_Assignment_Statement (Target);
+                  elsif Current_Token = Tok_Assign then
+                     Stmt := Parse_Variable_Assignment_Statement (Target);
+                  else
+                     Error_Msg_Parse ("'<=' or ':=' expected");
+                     return First_Stmt;
+                  end if;
+               end;
+
+            when Tok_Return =>
+               Stmt := Create_Iir (Iir_Kind_Return_Statement);
+               Scan;
+               if Current_Token /= Tok_Semi_Colon then
+                  Set_Expression (Stmt, Parse_Expression);
+               end if;
+
+            when Tok_For =>
+               Stmt := Create_Iir (Iir_Kind_For_Loop_Statement);
+               Set_Location (Stmt, Loc);
+               Set_Label (Stmt, Label);
+
+               --  Skip 'for'
+               Scan;
+
+               Set_Parameter_Specification
+                 (Stmt, Parse_Parameter_Specification (Stmt));
+
+               --  Skip 'loop'
+               Expect (Tok_Loop);
+               Scan;
+
+               Set_Sequential_Statement_Chain
+                 (Stmt, Parse_Sequential_Statements (Stmt));
+
+               --  Skip 'end'
+               Expect (Tok_End);
+               Scan_Expect (Tok_Loop);
+
+               --  Skip 'loop'
+               Scan;
+
+               Check_End_Name (Stmt);
+               --  A loop statement can have a label, even in vhdl87.
+               Label := Null_Identifier;
+
+            when Tok_While
+              | Tok_Loop =>
+               Stmt := Create_Iir (Iir_Kind_While_Loop_Statement);
+               Set_Location (Stmt);
+               Set_Label (Stmt, Label);
+               if Current_Token = Tok_While then
+                  Scan;
+                  Set_Condition (Stmt, Parse_Expression);
+                  Expect (Tok_Loop);
+               end if;
+               Scan;
+               Set_Sequential_Statement_Chain
+                 (Stmt, Parse_Sequential_Statements (Stmt));
+               Expect (Tok_End);
+               Scan_Expect (Tok_Loop);
+               Scan;
+               Check_End_Name (Stmt);
+               --  A loop statement can have a label, even in vhdl87.
+               Label := Null_Identifier;
+
+            when Tok_Next
+              | Tok_Exit =>
+               if Current_Token = Tok_Next then
+                  Stmt := Create_Iir (Iir_Kind_Next_Statement);
+               else
+                  Stmt := Create_Iir (Iir_Kind_Exit_Statement);
+               end if;
+
+               --  Skip 'next' or 'exit'.
+               Scan;
+
+               if Current_Token = Tok_Identifier then
+                  Set_Loop_Label (Stmt, Parse_Name (Allow_Indexes => False));
+               end if;
+
+               if Current_Token = Tok_When then
+                  --  Skip 'when'.
+                  Scan;
+
+                  Set_Condition (Stmt, Parse_Expression);
+               end if;
+
+            when Tok_Case =>
+               declare
+                  use Iir_Chains.Case_Statement_Alternative_Chain_Handling;
+                  Assoc: Iir;
+                  Last_Assoc : Iir;
+               begin
+                  Stmt := Create_Iir (Iir_Kind_Case_Statement);
+                  Set_Location (Stmt);
+                  Set_Label (Stmt, Label);
+                  Scan;
+                  Set_Expression (Stmt, Parse_Expression);
+                  Expect (Tok_Is);
+                  Scan;
+                  if Current_Token = Tok_End then
+                     Error_Msg_Parse ("missing alternative in case statement");
+                  end if;
+                  Build_Init (Last_Assoc);
+                  while Current_Token /= Tok_End loop
+                     --  Eat 'when'
+                     Expect (Tok_When);
+                     Scan;
+
+                     if Current_Token = Tok_Double_Arrow then
+                        Error_Msg_Parse ("missing expression in alternative");
+                        Assoc := Create_Iir (Iir_Kind_Choice_By_Expression);
+                        Set_Location (Assoc);
+                     else
+                        Assoc := Parse_Choices (Null_Iir);
+                     end if;
+
+                     --  Eat '=>'
+                     Expect (Tok_Double_Arrow);
+                     Scan;
+
+                     Set_Associated_Chain
+                       (Assoc, Parse_Sequential_Statements (Stmt));
+                     Append_Subchain (Last_Assoc, Stmt, Assoc);
+                  end loop;
+
+                  --  Eat 'end', 'case'
+                  Scan_Expect (Tok_Case);
+                  Scan;
+
+                  if Flags.Vhdl_Std >= Vhdl_93c then
+                     Check_End_Name (Stmt);
+                  end if;
+               end;
+            when Tok_Wait =>
+               Stmt := Parse_Wait_Statement;
+            when others =>
+               return First_Stmt;
+         end case;
+         << Has_Stmt >> null;
+         Set_Parent (Stmt, Parent);
+         Set_Location (Stmt, Loc);
+         if Label /= Null_Identifier then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Sem
+                 ("this statement can't have a label in vhdl 87", Stmt);
+            else
+               Set_Label (Stmt, Label);
+            end if;
+         end if;
+         Scan_Semi_Colon ("statement");
+
+         --  Append it to the chain.
+         if First_Stmt = Null_Iir then
+            First_Stmt := Stmt;
+         else
+            Set_Chain (Last_Stmt, Stmt);
+         end if;
+         Last_Stmt := Stmt;
+      end loop;
+   end Parse_Sequential_Statements;
+
+   --  precond : PROCEDURE, FUNCTION, PURE or IMPURE.
+   --  postcond: ';'
+   --
+   --  [ §2.1 ]
+   --  subprogram_declaration ::= subprogram_specification ;
+   --
+   --  [ §2.1 ]
+   --  subprogram_specification ::=
+   --      PROCEDURE designator [ ( formal_parameter_list ) ]
+   --    | [ PURE | IMPURE ] FUNCTION designator [ ( formal_parameter_list ) ]
+   --          RETURN type_mark
+   --
+   --  [ §2.2 ]
+   --  subprogram_body ::=
+   --      subprogram_specification IS
+   --          subprogram_declarative_part
+   --      BEGIN
+   --          subprogram_statement_part
+   --      END [ subprogram_kind ] [ designator ] ;
+   --
+   --  [ §2.1 ]
+   --  designator ::= identifier | operator_symbol
+   --
+   --  [ §2.1 ]
+   --  operator_symbol ::= string_literal
+   function Parse_Subprogram_Declaration (Parent : Iir) return Iir
+   is
+      Kind : Iir_Kind;
+      Inters : Iir;
+      Subprg: Iir;
+      Subprg_Body : Iir;
+      Old : Iir;
+      pragma Unreferenced (Old);
+   begin
+      -- Create the node.
+      case Current_Token is
+         when Tok_Procedure =>
+            Kind := Iir_Kind_Procedure_Declaration;
+         when Tok_Function
+           | Tok_Pure
+           | Tok_Impure =>
+            Kind := Iir_Kind_Function_Declaration;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Subprg := Create_Iir (Kind);
+      Set_Location (Subprg);
+
+      case Current_Token is
+         when Tok_Procedure =>
+            null;
+         when Tok_Function =>
+            --  LRM93 2.1
+            --  A function is impure if its specification contains the
+            --  reserved word IMPURE; otherwise it is said to be pure.
+            Set_Pure_Flag (Subprg, True);
+         when Tok_Pure
+           | Tok_Impure =>
+            Set_Pure_Flag (Subprg, Current_Token = Tok_Pure);
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse
+                 ("'pure' and 'impure' are not allowed in vhdl 87");
+            end if;
+            Set_Has_Pure (Subprg, True);
+            --  FIXME: what to do in case of error ??
+            --  Eat PURE or IMPURE.
+            Scan;
+            Expect (Tok_Function, "'function' must follow 'pure' or 'impure'");
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  Eat PROCEDURE or FUNCTION.
+      Scan;
+
+      if Current_Token = Tok_Identifier then
+         Set_Identifier (Subprg, Current_Identifier);
+         Set_Location (Subprg);
+      elsif Current_Token = Tok_String then
+         if Kind = Iir_Kind_Procedure_Declaration then
+            --  LRM93 2.1
+            --  A procedure designator is always an identifier.
+            Error_Msg_Parse ("a procedure name must be an identifier");
+         end if;
+         --  LRM93 2.1
+         --  A function designator is either an identifier or an operator
+         --  symbol.
+         Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location));
+         Set_Location (Subprg);
+      else
+         --  Just to display a parse error.
+         Expect (Tok_Identifier);
+      end if;
+
+      Scan;
+      if Current_Token = Tok_Left_Paren then
+         --  Parse the interface declaration.
+         if Kind = Iir_Kind_Function_Declaration then
+            Inters := Parse_Interface_List
+              (Function_Parameter_Interface_List, Subprg);
+         else
+            Inters := Parse_Interface_List
+              (Procedure_Parameter_Interface_List, Subprg);
+         end if;
+         Set_Interface_Declaration_Chain (Subprg, Inters);
+      end if;
+
+      if Current_Token = Tok_Return then
+         if Kind = Iir_Kind_Procedure_Declaration then
+            Error_Msg_Parse ("'return' not allowed for a procedure");
+            Error_Msg_Parse ("(remove return part or define a function)");
+
+            --  Skip 'return'
+            Scan;
+
+            Old := Parse_Type_Mark;
+         else
+            --  Skip 'return'
+            Scan;
+
+            Set_Return_Type_Mark
+              (Subprg, Parse_Type_Mark (Check_Paren => True));
+         end if;
+      else
+         if Kind = Iir_Kind_Function_Declaration then
+            Error_Msg_Parse ("'return' expected");
+         end if;
+      end if;
+
+      if Current_Token = Tok_Semi_Colon then
+         return Subprg;
+      end if;
+
+      --  The body.
+      Set_Has_Body (Subprg, True);
+      if Kind = Iir_Kind_Function_Declaration then
+         Subprg_Body := Create_Iir (Iir_Kind_Function_Body);
+      else
+         Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body);
+      end if;
+      Location_Copy (Subprg_Body, Subprg);
+
+      Set_Subprogram_Body (Subprg, Subprg_Body);
+      Set_Subprogram_Specification (Subprg_Body, Subprg);
+      Set_Chain (Subprg, Subprg_Body);
+
+      if Get_Kind (Parent) = Iir_Kind_Package_Declaration then
+         Error_Msg_Parse ("subprogram body not allowed in package spec");
+      end if;
+      Expect (Tok_Is);
+      Scan;
+      Parse_Declarative_Part (Subprg_Body);
+      Expect (Tok_Begin);
+      Scan;
+      Set_Sequential_Statement_Chain
+        (Subprg_Body, Parse_Sequential_Statements (Subprg_Body));
+      Expect (Tok_End);
+      Scan;
+
+      case Current_Token is
+         when Tok_Function =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'function' not allowed here by vhdl 87");
+            end if;
+            if Kind = Iir_Kind_Procedure_Declaration then
+               Error_Msg_Parse ("'procedure' expected instead of 'function'");
+            end if;
+            Set_End_Has_Reserved_Id (Subprg_Body, True);
+            Scan;
+         when Tok_Procedure =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'procedure' not allowed here by vhdl 87");
+            end if;
+            if Kind = Iir_Kind_Function_Declaration then
+               Error_Msg_Parse ("'function' expected instead of 'procedure'");
+            end if;
+            Set_End_Has_Reserved_Id (Subprg_Body, True);
+            Scan;
+         when others =>
+            null;
+      end case;
+      case Current_Token is
+         when Tok_Identifier =>
+            Check_End_Name (Get_Identifier (Subprg), Subprg_Body);
+         when Tok_String =>
+            if Scan_To_Operator_Name (Get_Token_Location)
+              /= Get_Identifier (Subprg)
+            then
+               Error_Msg_Parse
+                 ("mispelling, 'end """ & Image_Identifier (Subprg)
+                  & """;' expected");
+            end if;
+            Set_End_Has_Identifier (Subprg_Body, True);
+            Scan;
+         when others =>
+            null;
+      end case;
+      Expect (Tok_Semi_Colon);
+      return Subprg;
+   end Parse_Subprogram_Declaration;
+
+   --  precond:  PROCESS
+   --  postcond: null
+   --
+   --  [ LRM87 9.2 / LRM08 11.3 ]
+   --  process_statement ::=
+   --    [ PROCESS_label : ]
+   --       [ POSTPONED ] PROCESS [ ( process_sensitivity_list ) ] [ IS ]
+   --           process_declarative_part
+   --       BEGIN
+   --           process_statement_part
+   --       END [ POSTPONED ] PROCESS [ PROCESS_label ] ;
+   --
+   --  process_sensitivity_list ::= ALL | sensitivity_list
+   function Parse_Process_Statement
+     (Label: Name_Id; Loc : Location_Type; Is_Postponed : Boolean)
+     return Iir
+   is
+      Res: Iir;
+      Sensitivity_List : Iir_List;
+   begin
+      -- The PROCESS keyword was just scaned.
+      Scan;
+
+      if Current_Token = Tok_Left_Paren then
+         Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement);
+         Scan;
+         if Current_Token = Tok_All then
+            if Vhdl_Std < Vhdl_08 then
+               Error_Msg_Parse
+                 ("all sensitized process allowed only in vhdl 08");
+            end if;
+            Sensitivity_List := Iir_List_All;
+            Scan;
+         else
+            Sensitivity_List := Create_Iir_List;
+            Parse_Sensitivity_List (Sensitivity_List);
+         end if;
+         Set_Sensitivity_List (Res, Sensitivity_List);
+         Expect (Tok_Right_Paren);
+         Scan;
+      else
+         Res := Create_Iir (Iir_Kind_Process_Statement);
+      end if;
+
+      Set_Location (Res, Loc);
+      Set_Label (Res, Label);
+
+      if Current_Token = Tok_Is then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("""is"" not allowed here by vhdl 87");
+         end if;
+         Set_Has_Is (Res, True);
+         Scan;
+      end if;
+
+      -- declarative part.
+      Parse_Declarative_Part (Res);
+
+      --  Skip 'begin'.
+      Expect (Tok_Begin);
+      Scan;
+
+      Set_Sequential_Statement_Chain (Res, Parse_Sequential_Statements (Res));
+
+      --  Skip 'end'.
+      Expect (Tok_End);
+      Scan;
+
+      if Current_Token = Tok_Postponed then
+         if not Is_Postponed then
+            --  LRM93 9.2
+            --  If the reserved word POSTPONED appears at the end of a process
+            --  statement, the process must be a postponed process.
+            Error_Msg_Parse ("process is not a postponed process");
+         end if;
+
+         Set_End_Has_Postponed (Res, True);
+
+         --  Skip 'postponed',
+         Scan;
+      end if;
+
+      if Current_Token = Tok_Semi_Colon then
+         Error_Msg_Parse ("""end"" must be followed by ""process""");
+      else
+         Expect (Tok_Process);
+         Scan;
+         Set_End_Has_Reserved_Id (Res, True);
+         Check_End_Name (Res);
+         Expect (Tok_Semi_Colon);
+      end if;
+      return Res;
+   end Parse_Process_Statement;
+
+   -- precond : NEXT_TOKEN
+   -- postcond: NEXT_TOKEN
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  association_list ::= association_element { , association_element }
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  association_element ::= [ formal_part => ] actual_part
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  actual_part ::= actual_designator
+   --                | FUNCTION_name ( actual_designator )
+   --                | type_mark ( actual_designator )
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  actual_designator ::= expression
+   --                      | SIGNAL_name
+   --                      | VARIABLE_name
+   --                      | FILE_name
+   --                      | OPEN
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  formal_part ::= formal_designator
+   --                | FUNCTION_name ( formal_designator )
+   --                | type_mark ( formal_designator )
+   --
+   --  [ LRM93 4.3.2.2 ]
+   --  formal_designator ::= GENERIC_name
+   --                      | PORT_name
+   --                      | PARAMETER_name
+   --
+   --  Note: an actual part is parsed as an expression.
+   function Parse_Association_List return Iir
+   is
+      Res, Last: Iir;
+      El: Iir;
+      Formal: Iir;
+      Actual: Iir;
+      Nbr_Assocs : Natural;
+      Loc : Location_Type;
+   begin
+      Sub_Chain_Init (Res, Last);
+
+      if Current_Token = Tok_Right_Paren then
+         Error_Msg_Parse ("empty association list is not allowed");
+         return Res;
+      end if;
+
+      Nbr_Assocs := 1;
+      loop
+         --  Parse formal and actual.
+         Loc := Get_Token_Location;
+         Formal := Null_Iir;
+
+         if Current_Token /= Tok_Open then
+            Actual := Parse_Expression;
+            case Current_Token is
+               when Tok_To
+                 | Tok_Downto =>
+                  --  To/downto can appear in slice name (which are parsed as
+                  --  function call).
+
+                  if Actual = Null_Iir then
+                     --  Left expression is missing ie: (downto x).
+                     Scan;
+                     Actual := Parse_Expression;
+                  else
+                     Actual := Parse_Range_Expression (Actual);
+                  end if;
+                  if Nbr_Assocs /= 1 then
+                     Error_Msg_Parse ("multi-dimensional slice is forbidden");
+                  end if;
+
+               when Tok_Double_Arrow =>
+                  Formal := Actual;
+
+                  --  Skip '=>'
+                  Scan;
+                  Loc := Get_Token_Location;
+
+                  if Current_Token /= Tok_Open then
+                     Actual := Parse_Expression;
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+         end if;
+
+         if Current_Token = Tok_Open then
+            El := Create_Iir (Iir_Kind_Association_Element_Open);
+            Set_Location (El);
+
+            --  Skip 'open'
+            Scan;
+         else
+            El := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+            Set_Location (El, Loc);
+            Set_Actual (El, Actual);
+         end if;
+         Set_Formal (El, Formal);
+
+         Sub_Chain_Append (Res, Last, El);
+         exit when Current_Token = Tok_Right_Paren;
+         Expect (Tok_Comma);
+         Scan;
+         Nbr_Assocs := Nbr_Assocs + 1;
+      end loop;
+
+      return Res;
+   end Parse_Association_List;
+
+   -- precond : NEXT_TOKEN
+   -- postcond: NEXT_TOKEN
+   --
+   -- Parse: '(' association_list ')'
+   function Parse_Association_List_In_Parenthesis return Iir
+   is
+      Res : Iir;
+   begin
+      --  Skip '('
+      Expect (Tok_Left_Paren);
+      Scan;
+
+      Res := Parse_Association_List;
+
+      --  Skip ')'
+      Scan;
+
+      return Res;
+   end Parse_Association_List_In_Parenthesis;
+
+   --  precond : GENERIC
+   --  postcond: next token
+   --
+   --  [ LRM93 5.2.1.2, LRM08 6.5.7.2 ]
+   --  generic_map_aspect ::= GENERIC MAP ( GENERIC_association_list )
+   function Parse_Generic_Map_Aspect return Iir is
+   begin
+      Expect (Tok_Generic);
+      Scan_Expect (Tok_Map);
+      Scan;
+      return Parse_Association_List_In_Parenthesis;
+   end Parse_Generic_Map_Aspect;
+
+   --  precond : PORT
+   --  postcond: next token
+   --
+   --  [ §5.2.1.2 ]
+   --  port_map_aspect ::= PORT MAP ( PORT_association_list )
+   function Parse_Port_Map_Aspect return Iir is
+   begin
+      Expect (Tok_Port);
+      Scan_Expect (Tok_Map);
+      Scan;
+      return Parse_Association_List_In_Parenthesis;
+   end Parse_Port_Map_Aspect;
+
+   --  precond : COMPONENT | ENTIY | CONFIGURATION
+   --  postcond : next_token
+   --
+   --  instantiated_unit ::=
+   --      [ COMPONENT ] component_name
+   --      ENTITY entity_name [ ( architecture_identifier ) ]
+   --      CONFIGURATION configuration_name
+   function Parse_Instantiated_Unit return Iir
+   is
+      Res : Iir;
+   begin
+      if Flags.Vhdl_Std = Vhdl_87 then
+         Error_Msg_Parse
+           ("component instantiation using keyword 'component', 'entity',");
+         Error_Msg_Parse (" or 'configuration' is not allowed in vhdl87");
+      end if;
+
+      case Current_Token is
+         when Tok_Component =>
+            Scan;
+            return Parse_Name (False);
+         when Tok_Entity =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity);
+            Set_Location (Res);
+            Scan;
+            Set_Entity_Name (Res, Parse_Name (False));
+            if Current_Token = Tok_Left_Paren then
+               Scan_Expect (Tok_Identifier);
+               Set_Architecture (Res, Current_Text);
+               Scan_Expect (Tok_Right_Paren);
+               Scan;
+            end if;
+            return Res;
+         when Tok_Configuration =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration);
+            Set_Location (Res);
+            Scan_Expect (Tok_Identifier);
+            Set_Configuration_Name (Res, Parse_Name (False));
+            return Res;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Parse_Instantiated_Unit;
+
+   --  precond : next token
+   --  postcond: ';'
+   --
+   --  component_instantiation_statement ::=
+   --      INSTANTIATION_label :
+   --          instantiated_unit [ generic_map_aspect ] [ port_map_aspect ] ;
+   function Parse_Component_Instantiation (Name: Iir)
+      return Iir_Component_Instantiation_Statement is
+      Res: Iir_Component_Instantiation_Statement;
+   begin
+      Res := Create_Iir (Iir_Kind_Component_Instantiation_Statement);
+      Set_Location (Res);
+
+      Set_Instantiated_Unit (Res, Name);
+
+      if Current_Token = Tok_Generic then
+         Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+      end if;
+      if Current_Token = Tok_Port then
+         Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect);
+      end if;
+      Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Component_Instantiation;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §9.1 ]
+   --  block_header ::= [ generic_clause [ generic_map_aspect ; ] ]
+   --                   [ port_clause [ port_map_aspect ; ] ]
+   function Parse_Block_Header return Iir_Block_Header is
+      Res : Iir_Block_Header;
+   begin
+      Res := Create_Iir (Iir_Kind_Block_Header);
+      Set_Location (Res);
+      if Current_Token = Tok_Generic then
+         Parse_Generic_Clause (Res);
+         if Current_Token = Tok_Generic then
+            Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+            Scan_Semi_Colon ("generic map aspect");
+         end if;
+      end if;
+      if Current_Token = Tok_Port then
+         Parse_Port_Clause (Res);
+         if Current_Token = Tok_Port then
+            Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect);
+            Scan_Semi_Colon ("port map aspect");
+         end if;
+      end if;
+      return Res;
+   end Parse_Block_Header;
+
+   --  precond : BLOCK
+   --  postcond: ';'
+   --
+   --  [ §9.1 ]
+   --  block_statement ::=
+   --      BLOCK_label :
+   --          BLOCK [ ( GUARD_expression ) ] [ IS ]
+   --              block_header
+   --              block_declarative_part
+   --          BEGIN
+   --              block_statement_part
+   --          END BLOCK [ BLOCK_label ] ;
+   --
+   --  [ §9.1 ]
+   --  block_declarative_part ::= { block_declarative_item }
+   --
+   --  [ §9.1 ]
+   --  block_statement_part ::= { concurrent_statement }
+   function Parse_Block_Statement (Label: Name_Id; Loc : Location_Type)
+     return Iir_Block_Statement
+   is
+      Res : Iir_Block_Statement;
+      Guard : Iir_Guard_Signal_Declaration;
+   begin
+      if Label = Null_Identifier then
+         Error_Msg_Parse ("a block statement must have a label");
+      end if;
+
+      -- block was just parsed.
+      Res := Create_Iir (Iir_Kind_Block_Statement);
+      Set_Location (Res, Loc);
+      Set_Label (Res, Label);
+      Scan;
+      if Current_Token = Tok_Left_Paren then
+         Guard := Create_Iir (Iir_Kind_Guard_Signal_Declaration);
+         Set_Location (Guard);
+         Set_Guard_Decl (Res, Guard);
+         Scan;
+         Set_Guard_Expression (Guard, Parse_Expression);
+         Expect (Tok_Right_Paren, "a ')' is expected after guard expression");
+         Scan;
+      end if;
+      if Current_Token = Tok_Is then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("'is' not allowed here in vhdl87");
+         end if;
+         Scan;
+      end if;
+      if Current_Token = Tok_Generic or Current_Token = Tok_Port then
+         Set_Block_Header (Res, Parse_Block_Header);
+      end if;
+      if Current_Token /= Tok_Begin then
+         Parse_Declarative_Part (Res);
+      end if;
+      Expect (Tok_Begin);
+      Scan;
+      Parse_Concurrent_Statements (Res);
+      Check_End_Name (Tok_Block, Res);
+      return Res;
+   end Parse_Block_Statement;
+
+   --  precond : IF or FOR
+   --  postcond: ';'
+   --
+   --  [ LRM93 9.7 ]
+   --  generate_statement ::=
+   --      GENERATE_label : generation_scheme GENERATE
+   --          [ { block_declarative_item }
+   --      BEGIN ]
+   --          { concurrent_statement }
+   --      END GENERATE [ GENERATE_label ] ;
+   --
+   --  [ LRM93 9.7 ]
+   --  generation_scheme ::=
+   --      FOR GENERATE_parameter_specification
+   --      | IF condition
+   --
+   --  FIXME: block_declarative item.
+   function Parse_Generate_Statement (Label : Name_Id; Loc : Location_Type)
+     return Iir_Generate_Statement
+   is
+      Res : Iir_Generate_Statement;
+   begin
+      if Label = Null_Identifier then
+         Error_Msg_Parse ("a generate statement must have a label");
+      end if;
+      Res := Create_Iir (Iir_Kind_Generate_Statement);
+      Set_Location (Res, Loc);
+      Set_Label (Res, Label);
+      case Current_Token is
+         when Tok_For =>
+            Scan;
+            Set_Generation_Scheme (Res, Parse_Parameter_Specification (Res));
+         when Tok_If =>
+            Scan;
+            Set_Generation_Scheme (Res, Parse_Expression);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Expect (Tok_Generate);
+
+      Scan;
+      --  Check for a block declarative item.
+      case Current_Token is
+         when
+         --  subprogram_declaration
+         --  subprogram_body
+           Tok_Procedure
+           | Tok_Function
+           | Tok_Pure
+           | Tok_Impure
+         --  type_declaration
+           | Tok_Type
+         --  subtype_declaration
+           | Tok_Subtype
+         --  constant_declaration
+           | Tok_Constant
+         --  signal_declaration
+           | Tok_Signal
+         --  shared_variable_declaration
+           | Tok_Shared
+           | Tok_Variable
+         --  file_declaration
+           | Tok_File
+         --  alias_declaration
+           | Tok_Alias
+         --  component_declaration
+           | Tok_Component
+         --  attribute_declaration
+         --  attribute_specification
+           | Tok_Attribute
+         --  configuration_specification
+           | Tok_For
+         --  disconnection_specification
+           | Tok_Disconnect
+         --  use_clause
+           | Tok_Use
+         --  group_template_declaration
+         --  group_declaration
+           | Tok_Group
+           | Tok_Begin =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse
+                 ("declarations not allowed in a generate in vhdl87");
+            end if;
+            Parse_Declarative_Part (Res);
+            Expect (Tok_Begin);
+            Set_Has_Begin (Res, True);
+            Scan;
+         when others =>
+            null;
+      end case;
+
+      Parse_Concurrent_Statements (Res);
+
+      Expect (Tok_End);
+
+      --  Skip 'end'
+      Scan_Expect (Tok_Generate);
+      Set_End_Has_Reserved_Id (Res, True);
+
+      --  Skip 'generate'
+      Scan;
+
+      --  LRM93 9.7
+      --  If a label appears at the end of a generate statement, it must repeat
+      --  the generate label.
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Generate_Statement;
+
+   --  precond : first token
+   --  postcond: END
+   --
+   --  [ §9 ]
+   --  concurrent_statement ::= block_statement
+   --                         | process_statement
+   --                         | concurrent_procedure_call_statement
+   --                         | concurrent_assertion_statement
+   --                         | concurrent_signal_assignment_statement
+   --                         | component_instantiation_statement
+   --                         | generate_statement
+   --
+   --  [ §9.4 ]
+   --  concurrent_assertion_statement ::=
+   --      [ label : ] [ POSTPONED ] assertion ;
+   --
+   --  [ §9.3 ]
+   --  concurrent_procedure_call_statement ::=
+   --      [ label : ] [ POSTPONED ] procedure_call ;
+   --
+   --  [ §9.5 ]
+   --  concurrent_signal_assignment_statement ::=
+   --      [ label : ] [ POSTPONED ] conditional_signal_assignment
+   --    | [ label : ] [ POSTPONED ] selected_signal_assignment
+   function Parse_Concurrent_Assignment (Target : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      case Current_Token is
+         when Tok_Less_Equal
+           | Tok_Assign =>
+            -- This is a conditional signal assignment.
+            -- Error for ':=' is handled by the subprogram.
+            return Parse_Conditional_Signal_Assignment (Target);
+         when Tok_Semi_Colon =>
+            -- a procedure call or a component instantiation.
+            -- Parse it as a procedure call, may be revert to a
+            -- component instantiation during sem.
+            Expect (Tok_Semi_Colon);
+            return Parenthesis_Name_To_Procedure_Call
+              (Target, Iir_Kind_Concurrent_Procedure_Call_Statement);
+         when Tok_Generic | Tok_Port =>
+            -- or a component instantiation.
+            return Parse_Component_Instantiation (Target);
+         when others =>
+            -- or a simple simultaneous statement
+            if AMS_Vhdl then
+               Res := Create_Iir (Iir_Kind_Simple_Simultaneous_Statement);
+               Set_Simultaneous_Left (Res, Parse_Simple_Expression (Target));
+               if Current_Token /= Tok_Equal_Equal then
+                  Error_Msg_Parse ("'==' expected after expression");
+               else
+                  Set_Location (Res);
+                  Scan;
+               end if;
+               Set_Simultaneous_Right (Res, Parse_Simple_Expression);
+               Set_Tolerance (Res, Parse_Tolerance_Aspect_Opt);
+               Expect (Tok_Semi_Colon);
+               return Res;
+            else
+               return Parse_Conditional_Signal_Assignment
+                 (Parse_Simple_Expression (Target));
+            end if;
+      end case;
+   end Parse_Concurrent_Assignment;
+
+   function Parse_Psl_Default_Clock return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Psl_Default_Clock);
+      Scanner.Flag_Psl := True;
+      Scan_Expect (Tok_Psl_Clock);
+      Scan_Expect (Tok_Is);
+      Scan;
+      Set_Psl_Boolean (Res, Parse_Psl.Parse_Psl_Boolean);
+      Expect (Tok_Semi_Colon);
+      Scanner.Flag_Scan_In_Comment := False;
+      Scanner.Flag_Psl := False;
+      return Res;
+   end Parse_Psl_Default_Clock;
+
+   function Parse_Psl_Declaration return Iir
+   is
+      Tok : constant Token_Type := Current_Token;
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Psl_Declaration);
+      Scan;
+      if Current_Token /= Tok_Identifier then
+         Error_Msg_Parse ("property name expected here");
+      else
+         Set_Identifier (Res, Current_Identifier);
+      end if;
+      Scanner.Flag_Psl := True;
+      Set_Psl_Declaration (Res, Parse_Psl.Parse_Psl_Declaration (Tok));
+      Expect (Tok_Semi_Colon);
+      Scanner.Flag_Scan_In_Comment := False;
+      Scanner.Flag_Psl := False;
+      return Res;
+   end Parse_Psl_Declaration;
+
+   function Parse_Psl_Assert_Statement return Iir
+   is
+      Res : Iir;
+   begin
+      case Current_Token is
+         when Tok_Psl_Assert =>
+            Res := Create_Iir (Iir_Kind_Psl_Assert_Statement);
+         when Tok_Psl_Cover =>
+            Res := Create_Iir (Iir_Kind_Psl_Cover_Statement);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  Scan extended PSL tokens.
+      Scanner.Flag_Psl := True;
+
+      --  Skip 'assert'
+      Scan;
+
+      Set_Psl_Property (Res, Parse_Psl.Parse_Psl_Property);
+
+      --  No more PSL tokens after the property.
+      Scanner.Flag_Psl := False;
+
+      if Current_Token = Tok_Report then
+         --  Skip 'report'
+         Scan;
+
+         Set_Report_Expression (Res, Parse_Expression);
+      end if;
+
+      if Current_Token = Tok_Severity then
+         --  Skip 'severity'
+         Scan;
+
+         Set_Severity_Expression (Res, Parse_Expression);
+      end if;
+
+      Expect (Tok_Semi_Colon);
+      Scanner.Flag_Scan_In_Comment := False;
+      return Res;
+   end Parse_Psl_Assert_Statement;
+
+   procedure Parse_Concurrent_Statements (Parent : Iir)
+   is
+      Last_Stmt : Iir;
+      Stmt: Iir;
+      Label: Name_Id;
+      Id: Iir;
+      Postponed : Boolean;
+      Loc : Location_Type;
+      Target : Iir;
+
+      procedure Postponed_Not_Allowed is
+      begin
+         if Postponed then
+            Error_Msg_Parse ("'postponed' not allowed here");
+            Postponed := False;
+         end if;
+      end Postponed_Not_Allowed;
+   begin
+      -- begin was just parsed.
+      Last_Stmt := Null_Iir;
+      loop
+         Stmt := Null_Iir;
+         Label := Null_Identifier;
+         Postponed := False;
+         Loc := Get_Token_Location;
+
+         -- Try to find a label.
+         if Current_Token = Tok_Identifier then
+            Label := Current_Identifier;
+            Scan;
+            if Current_Token = Tok_Colon then
+               -- The identifier is really a label.
+               Scan;
+            else
+               -- This is not a label.
+               Target := Create_Iir (Iir_Kind_Simple_Name);
+               Set_Location (Target, Loc);
+               Set_Identifier (Target, Label);
+               Label := Null_Identifier;
+               Target := Parse_Name_Suffix (Target);
+               Stmt := Parse_Concurrent_Assignment (Target);
+               goto Has_Stmt;
+            end if;
+         end if;
+
+         if Current_Token = Tok_Postponed then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'postponed' is not allowed in vhdl 87");
+            else
+               Postponed := True;
+            end if;
+            Scan;
+         end if;
+
+         case Current_Token is
+            when Tok_End =>
+               Postponed_Not_Allowed;
+               if Label /= Null_Identifier then
+                  Error_Msg_Parse
+                    ("no label is allowed before the 'end' keyword");
+               end if;
+               return;
+            when Tok_Identifier =>
+               Target := Parse_Name (Allow_Indexes => True);
+               Stmt := Parse_Concurrent_Assignment (Target);
+               if Get_Kind (Stmt) = Iir_Kind_Component_Instantiation_Statement
+                 and then Postponed
+               then
+                  Error_Msg_Parse ("'postponed' not allowed for " &
+                                   "an instantiation statement");
+                  Postponed := False;
+               end if;
+            when Tok_Left_Paren =>
+               Id := Parse_Aggregate;
+               if Current_Token = Tok_Less_Equal then
+                  -- This is a conditional signal assignment.
+                  Stmt := Parse_Conditional_Signal_Assignment (Id);
+               else
+                  Error_Msg_Parse ("'<=' expected after aggregate");
+                  Eat_Tokens_Until_Semi_Colon;
+               end if;
+            when Tok_Process =>
+               Stmt := Parse_Process_Statement (Label, Loc, Postponed);
+            when Tok_Assert =>
+               Stmt := Create_Iir (Iir_Kind_Concurrent_Assertion_Statement);
+               Parse_Assertion (Stmt);
+               Expect (Tok_Semi_Colon);
+            when Tok_With =>
+               Stmt := Parse_Selected_Signal_Assignment;
+            when Tok_Block =>
+               Postponed_Not_Allowed;
+               Stmt := Parse_Block_Statement (Label, Loc);
+            when Tok_If
+              | Tok_For =>
+               if Postponed then
+                  Error_Msg_Parse
+                    ("'postponed' not allowed before a generate statement");
+                  Postponed := False;
+               end if;
+               Stmt := Parse_Generate_Statement (Label, Loc);
+            when Tok_Eof =>
+               Error_Msg_Parse ("unexpected end of file, 'END;' expected");
+               return;
+            when Tok_Component
+              | Tok_Entity
+              | Tok_Configuration =>
+               Postponed_Not_Allowed;
+               declare
+                  Unit : Iir;
+               begin
+                  Unit := Parse_Instantiated_Unit;
+                  Stmt := Parse_Component_Instantiation (Unit);
+               end;
+            when Tok_Psl_Default =>
+               Postponed_Not_Allowed;
+               Stmt := Parse_Psl_Default_Clock;
+            when Tok_Psl_Property
+              | Tok_Psl_Sequence
+              | Tok_Psl_Endpoint =>
+               Postponed_Not_Allowed;
+               Stmt := Parse_Psl_Declaration;
+            when Tok_Psl_Assert
+              | Tok_Psl_Cover =>
+               Postponed_Not_Allowed;
+               Stmt := Parse_Psl_Assert_Statement;
+            when others =>
+               --  FIXME: improve message:
+               --  instead of 'unexpected token 'signal' in conc stmt list'
+               --  report: 'signal declarations are not allowed in conc stmt'
+               Unexpected ("concurrent statement list");
+               Eat_Tokens_Until_Semi_Colon;
+         end case;
+
+         << Has_Stmt >> null;
+
+         -- stmt can be null in case of error.
+         if Stmt /= Null_Iir then
+            Set_Location (Stmt, Loc);
+            if Label /= Null_Identifier then
+               Set_Label (Stmt, Label);
+            end if;
+            Set_Parent (Stmt, Parent);
+            if Postponed then
+               Set_Postponed_Flag (Stmt, True);
+            end if;
+            --  Append it to the chain.
+            if Last_Stmt = Null_Iir then
+               Set_Concurrent_Statement_Chain (Parent, Stmt);
+            else
+               Set_Chain (Last_Stmt, Stmt);
+            end if;
+            Last_Stmt := Stmt;
+         end if;
+
+         Scan;
+      end loop;
+   end Parse_Concurrent_Statements;
+
+   --  precond : LIBRARY
+   --  postcond: ;
+   --
+   --  [ LRM93 11.2 ]
+   --  library_clause ::= LIBRARY logical_name_list
+   function Parse_Library_Clause return Iir
+   is
+      First, Last : Iir;
+      Library: Iir_Library_Clause;
+   begin
+      Sub_Chain_Init (First, Last);
+      Expect (Tok_Library);
+      loop
+         Library := Create_Iir (Iir_Kind_Library_Clause);
+
+         --  Skip 'library' or ','.
+         Scan_Expect (Tok_Identifier);
+
+         Set_Identifier (Library, Current_Identifier);
+         Set_Location (Library);
+         Sub_Chain_Append (First, Last, Library);
+
+         --  Skip identifier.
+         Scan;
+
+         exit when Current_Token = Tok_Semi_Colon;
+         Expect (Tok_Comma);
+
+         Set_Has_Identifier_List (Library, True);
+      end loop;
+
+      --  Skip ';'.
+      Scan;
+      return First;
+   end Parse_Library_Clause;
+
+   --  precond : USE
+   --  postcond: ;
+   --
+   --  [ §10.4 ]
+   --  use_clause ::= USE selected_name { , selected_name }
+   --
+   --  FIXME: should be a list.
+   function Parse_Use_Clause return Iir_Use_Clause
+   is
+      Use_Clause: Iir_Use_Clause;
+      First, Last : Iir;
+   begin
+      First := Null_Iir;
+      Last := Null_Iir;
+      Scan;
+      loop
+         Use_Clause := Create_Iir (Iir_Kind_Use_Clause);
+         Set_Location (Use_Clause);
+         Expect (Tok_Identifier);
+         Set_Selected_Name (Use_Clause, Parse_Name);
+
+         --  Chain use clauses.
+         if First = Null_Iir then
+            First := Use_Clause;
+         else
+            Set_Use_Clause_Chain (Last, Use_Clause);
+         end if;
+         Last := Use_Clause;
+
+         exit when Current_Token = Tok_Semi_Colon;
+         Expect (Tok_Comma);
+         Scan;
+      end loop;
+      return First;
+   end Parse_Use_Clause;
+
+   --  precond : ARCHITECTURE
+   --  postcond: ';'
+   --
+   --  [ §1.2 ]
+   --  architecture_body ::=
+   --      ARCHITECTURE identifier OF ENTITY_name IS
+   --          architecture_declarative_part
+   --      BEGIN
+   --          architecture_statement_part
+   --      END [ ARCHITECTURE ] [ ARCHITECTURE_simple_name ] ;
+   procedure Parse_Architecture_Body (Unit : Iir_Design_Unit)
+   is
+      Res: Iir_Architecture_Body;
+   begin
+      Expect (Tok_Architecture);
+      Res := Create_Iir (Iir_Kind_Architecture_Body);
+
+      -- Get identifier.
+      Scan_Expect (Tok_Identifier);
+      Set_Identifier (Res, Current_Identifier);
+      Set_Location (Res);
+      Scan;
+      if Current_Token = Tok_Is then
+         Error_Msg_Parse ("architecture identifier is missing");
+      else
+         Expect (Tok_Of);
+         Scan;
+         Set_Entity_Name (Res, Parse_Name (False));
+         Expect (Tok_Is);
+      end if;
+
+      Scan;
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_Begin);
+      Scan;
+      Parse_Concurrent_Statements (Res);
+      -- end was scanned.
+      Set_End_Location (Unit);
+      Scan;
+      if Current_Token = Tok_Architecture then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse
+              ("'architecture' keyword not allowed here by vhdl 87");
+         end if;
+         Set_End_Has_Reserved_Id (Res, True);
+         Scan;
+      end if;
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Architecture_Body;
+
+   --  precond : next token
+   --  postcond: a token
+   --
+   --  [ §5.2 ]
+   --  instantiation_list ::= INSTANTIATION_label { , INSTANTIATION_label }
+   --                       | OTHERS
+   --                       | ALL
+   function Parse_Instantiation_List return Iir_List
+   is
+      Res : Iir_List;
+   begin
+      case Current_Token is
+         when Tok_All =>
+            Scan;
+            return Iir_List_All;
+         when Tok_Others =>
+            Scan;
+            return Iir_List_Others;
+         when Tok_Identifier =>
+            Res := Create_Iir_List;
+            loop
+               Append_Element (Res, Current_Text);
+               Scan;
+               exit when Current_Token /= Tok_Comma;
+               Expect (Tok_Comma);
+               Scan;
+            end loop;
+            return Res;
+         when others =>
+            Error_Msg_Parse ("instantiation list expected");
+            return Null_Iir_List;
+      end case;
+   end Parse_Instantiation_List;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §5.2 ]
+   --  component_specification ::= instantiation_list : COMPONENT_name
+   procedure Parse_Component_Specification (Res : Iir)
+   is
+      List : Iir_List;
+   begin
+      List := Parse_Instantiation_List;
+      Set_Instantiation_List (Res, List);
+      Expect (Tok_Colon);
+      Scan_Expect (Tok_Identifier);
+      Set_Component_Name (Res, Parse_Name);
+   end Parse_Component_Specification;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §5.2.1.1 ]
+   --  entity_aspect ::= ENTITY ENTITY_name [ ( ARCHITECTURE_identifier ) ]
+   --                  | CONFIGURATION CONFIGURATION_name
+   --                  | OPEN
+   function Parse_Entity_Aspect return Iir
+   is
+      Res : Iir;
+   begin
+      case Current_Token is
+         when Tok_Entity =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity);
+            Set_Location (Res);
+            Scan_Expect (Tok_Identifier);
+            Set_Entity_Name (Res, Parse_Name (False));
+            if Current_Token = Tok_Left_Paren then
+               Scan_Expect (Tok_Identifier);
+               Set_Architecture (Res, Current_Text);
+               Scan_Expect (Tok_Right_Paren);
+               Scan;
+            end if;
+         when Tok_Configuration =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration);
+            Set_Location (Res);
+            Scan_Expect (Tok_Identifier);
+            Set_Configuration_Name (Res, Parse_Name (False));
+         when Tok_Open =>
+            Res := Create_Iir (Iir_Kind_Entity_Aspect_Open);
+            Set_Location (Res);
+            Scan;
+         when others =>
+            --  FIXME: if the token is an identifier, try as if the 'entity'
+            --  keyword is missing.
+            Error_Msg_Parse
+              ("'entity', 'configuration' or 'open' keyword expected");
+      end case;
+      return Res;
+   end Parse_Entity_Aspect;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [ §5.2.1 ]
+   --  binding_indication ::=
+   --      [ USE entity_aspect ]
+   --      [ generic_map_aspect ]
+   --      [ port_map_aspect ]
+   function Parse_Binding_Indication return Iir_Binding_Indication
+   is
+      Res : Iir_Binding_Indication;
+   begin
+      case Current_Token is
+         when Tok_Use
+           | Tok_Generic
+           | Tok_Port =>
+            null;
+         when others =>
+            return Null_Iir;
+      end case;
+      Res := Create_Iir (Iir_Kind_Binding_Indication);
+      Set_Location (Res);
+      if Current_Token = Tok_Use then
+         Scan;
+         Set_Entity_Aspect (Res, Parse_Entity_Aspect);
+      end if;
+      if Current_Token = Tok_Generic then
+         Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+      end if;
+      if Current_Token = Tok_Port then
+         Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect);
+      end if;
+      return Res;
+   end Parse_Binding_Indication;
+
+   --  precond : ':' after instantiation_list.
+   --  postcond: ';'
+   --
+   --  [ §1.3.2 ]
+   --  component_configuration ::=
+   --      FOR component_specification
+   --          [ binding_indication ; ]
+   --          [ block_configuration ]
+   --      END FOR ;
+   function Parse_Component_Configuration (Loc : Location_Type;
+                                           Inst_List : Iir_List)
+     return Iir_Component_Configuration
+   is
+      Res : Iir_Component_Configuration;
+   begin
+      Res := Create_Iir (Iir_Kind_Component_Configuration);
+      Set_Location (Res, Loc);
+
+      --  Component specification.
+      Set_Instantiation_List (Res, Inst_List);
+      Expect (Tok_Colon);
+      Scan_Expect (Tok_Identifier);
+      Set_Component_Name (Res, Parse_Name);
+
+      case Current_Token is
+         when Tok_Use
+           | Tok_Generic
+           | Tok_Port =>
+            Set_Binding_Indication (Res, Parse_Binding_Indication);
+            Scan_Semi_Colon ("binding indication");
+         when others =>
+            null;
+      end case;
+      if Current_Token = Tok_For then
+         Set_Block_Configuration (Res, Parse_Block_Configuration);
+         --  Eat ';'.
+         Scan;
+      end if;
+      Expect (Tok_End);
+      Scan_Expect (Tok_For);
+      Scan_Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Component_Configuration;
+
+   --  precond : FOR
+   --  postcond: ';'
+   --
+   --  [ §1.3.1 ]
+   --  block_configuration ::=
+   --      FOR block_specification
+   --          { use_clause }
+   --          { configuration_item }
+   --      END FOR ;
+   --
+   --  [ §1.3.1 ]
+   --  block_specification ::=
+   --      ARCHITECTURE_name
+   --    | BLOCK_STATEMENT_label
+   --    | GENERATE_STATEMENT_label [ ( index_specification ) ]
+   function Parse_Block_Configuration_Suffix (Loc : Location_Type;
+                                              Block_Spec : Iir)
+     return Iir
+   is
+      Res : Iir_Block_Configuration;
+   begin
+      Res := Create_Iir (Iir_Kind_Block_Configuration);
+      Set_Location (Res, Loc);
+
+      Set_Block_Specification (Res, Block_Spec);
+
+      --  Parse use clauses.
+      if Current_Token = Tok_Use then
+         declare
+            Last : Iir;
+            use Declaration_Chain_Handling;
+         begin
+            Build_Init (Last);
+
+            while Current_Token = Tok_Use loop
+               Append_Subchain (Last, Res, Parse_Use_Clause);
+               --  Eat ';'.
+               Scan;
+            end loop;
+         end;
+      end if;
+
+      --  Parse configuration item list
+      declare
+         use Iir_Chains.Configuration_Item_Chain_Handling;
+         Last : Iir;
+      begin
+         Build_Init (Last);
+         while Current_Token /= Tok_End loop
+            Append (Last, Res, Parse_Configuration_Item);
+            --  Eat ';'.
+            Scan;
+         end loop;
+      end;
+      Scan_Expect (Tok_For);
+      Scan_Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Block_Configuration_Suffix;
+
+   function Parse_Block_Configuration return Iir_Block_Configuration
+   is
+      Loc : Location_Type;
+   begin
+      Loc := Get_Token_Location;
+      Expect (Tok_For);
+
+      --  Parse label.
+      Scan;
+      return Parse_Block_Configuration_Suffix (Loc, Parse_Name);
+   end Parse_Block_Configuration;
+
+   --  precond : FOR
+   --  postcond: ';'
+   --
+   --  [ §1.3.1 ]
+   --  configuration_item ::= block_configuration
+   --                       | component_configuration
+   function Parse_Configuration_Item return Iir
+   is
+      Loc : Location_Type;
+      List : Iir_List;
+      El : Iir;
+   begin
+      Loc := Get_Token_Location;
+      Expect (Tok_For);
+      Scan;
+
+      --  ALL and OTHERS are tokens from an instantiation list.
+      --  Thus, the rule is a component_configuration.
+      case Current_Token is
+         when Tok_All =>
+            Scan;
+            return Parse_Component_Configuration (Loc, Iir_List_All);
+         when Tok_Others =>
+            Scan;
+            return Parse_Component_Configuration (Loc, Iir_List_Others);
+         when Tok_Identifier =>
+            El := Current_Text;
+            Scan;
+            case Current_Token is
+               when Tok_Colon =>
+                  --  The identifier was a label from an instantiation list.
+                  List := Create_Iir_List;
+                  Append_Element (List, El);
+                  return Parse_Component_Configuration (Loc, List);
+               when Tok_Comma =>
+                  --  The identifier was a label from an instantiation list.
+                  List := Create_Iir_List;
+                  Append_Element (List, El);
+                  loop
+                     Scan_Expect (Tok_Identifier);
+                     Append_Element (List, Current_Text);
+                     Scan;
+                     exit when Current_Token /= Tok_Comma;
+                  end loop;
+                  return Parse_Component_Configuration (Loc, List);
+               when Tok_Left_Paren =>
+                  El := Parse_Name_Suffix (El);
+                  return Parse_Block_Configuration_Suffix (Loc, El);
+               when Tok_Use | Tok_For | Tok_End =>
+                  --  Possibilities for a block_configuration.
+                  --  FIXME: should use 'when others' ?
+                  return Parse_Block_Configuration_Suffix (Loc, El);
+               when others =>
+                  Error_Msg_Parse
+                    ("block_configuration or component_configuration "
+                     & "expected");
+                  raise Parse_Error;
+            end case;
+         when others =>
+            Error_Msg_Parse ("configuration item expected");
+            raise Parse_Error;
+      end case;
+   end Parse_Configuration_Item;
+
+   --  precond : next token
+   --  postcond: next token
+   --
+   --  [§ 1.3]
+   --  configuration_declarative_part ::= { configuration_declarative_item }
+   --
+   --  [§ 1.3]
+   --  configuration_declarative_item ::= use_clause
+   --                                   | attribute_specification
+   --                                   | group_declaration
+   --  FIXME: attribute_specification, group_declaration
+   procedure Parse_Configuration_Declarative_Part (Parent : Iir)
+   is
+      use Declaration_Chain_Handling;
+      Last : Iir;
+      El : Iir;
+   begin
+      Build_Init (Last);
+      loop
+         case Current_Token is
+            when Tok_Invalid =>
+               raise Internal_Error;
+            when Tok_Use =>
+               Append_Subchain (Last, Parent, Parse_Use_Clause);
+            when Tok_Attribute =>
+               El := Parse_Attribute;
+               if El /= Null_Iir then
+                  if Get_Kind (El) /= Iir_Kind_Attribute_Specification then
+                     Error_Msg_Parse
+                       ("attribute declaration not allowed here");
+                  end if;
+                  Append (Last, Parent, El);
+               end if;
+            when Tok_Group =>
+               El := Parse_Group;
+               if El /= Null_Iir then
+                  if Get_Kind (El) /= Iir_Kind_Group_Declaration then
+                     Error_Msg_Parse
+                       ("group template declaration not allowed here");
+                  end if;
+                  Append (Last, Parent, El);
+               end if;
+            when others =>
+               exit;
+         end case;
+         Scan;
+      end loop;
+   end Parse_Configuration_Declarative_Part;
+
+   --  precond : CONFIGURATION
+   --  postcond: ';'
+   --
+   --  [ LRM93 1.3 ]
+   --  configuration_declaration ::=
+   --      CONFIGURATION identifier OF ENTITY_name IS
+   --          configuration_declarative_part
+   --          block_configuration
+   --      END [ CONFIGURATION ] [ CONFIGURATION_simple_name ] ;
+   --
+   --  [ LRM93 1.3 ]
+   --  configuration_declarative_part ::= { configuration_declarative_item }
+   procedure Parse_Configuration_Declaration (Unit : Iir_Design_Unit)
+   is
+      Res : Iir_Configuration_Declaration;
+   begin
+      if Current_Token /= Tok_Configuration then
+         raise Program_Error;
+      end if;
+      Res := Create_Iir (Iir_Kind_Configuration_Declaration);
+
+      -- Get identifier.
+      Scan_Expect (Tok_Identifier);
+      Set_Identifier (Res, Current_Identifier);
+      Set_Location (Res);
+
+      --  Skip identifier.
+      Scan_Expect (Tok_Of);
+
+      --  Skip 'of'.
+      Scan;
+
+      Set_Entity_Name (Res, Parse_Name (False));
+
+      --  Skip 'is'.
+      Expect (Tok_Is);
+      Scan;
+
+      Parse_Configuration_Declarative_Part (Res);
+
+      Set_Block_Configuration (Res, Parse_Block_Configuration);
+
+      Scan_Expect (Tok_End);
+      Set_End_Location (Unit);
+
+      --  Skip 'end'.
+      Scan;
+
+      if Current_Token = Tok_Configuration then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse
+              ("'configuration' keyword not allowed here by vhdl 87");
+         end if;
+         Set_End_Has_Reserved_Id (Res, True);
+
+         --  Skip 'configuration'.
+         Scan;
+      end if;
+
+      -- LRM93 1.3
+      -- If a simple name appears at the end of a configuration declaration, it
+      -- must repeat the identifier of the configuration declaration.
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Configuration_Declaration;
+
+   --  precond : generic
+   --  postcond: next token
+   --
+   --  LRM08 4.7
+   --  package_header ::=
+   --      [ generic_clause               -- LRM08 6.5.6.2
+   --      [ generic_map aspect ; ] ]
+   function Parse_Package_Header return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Package_Header);
+      Parse_Generic_Clause (Res);
+
+      if Current_Token = Tok_Generic then
+         Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+         Scan_Semi_Colon ("generic map aspect");
+      end if;
+      return Res;
+   end Parse_Package_Header;
+
+   --  precond : token (after 'IS')
+   --  postcond: ';'
+   --
+   --  [ LRM93 2.5, LRM08 4.7 ]
+   --  package_declaration ::=
+   --      PACKAGE identifier IS
+   --          package_header           -- LRM08
+   --          package_declarative_part
+   --      END [ PACKAGE ] [ PACKAGE_simple_name ] ;
+   procedure Parse_Package_Declaration
+     (Unit : Iir_Design_Unit; Id : Name_Id; Loc : Location_Type)
+   is
+      Res: Iir_Package_Declaration;
+   begin
+      Res := Create_Iir (Iir_Kind_Package_Declaration);
+      Set_Location (Res, Loc);
+      Set_Identifier (Res, Id);
+
+      if Current_Token = Tok_Generic then
+         if Vhdl_Std < Vhdl_08 then
+            Error_Msg_Parse ("generic packages not allowed before vhdl 2008");
+         end if;
+         Set_Package_Header (Res, Parse_Package_Header);
+      end if;
+
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+
+      --  Skip 'end'
+      Scan;
+
+      if Current_Token = Tok_Package then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87");
+         end if;
+         Set_End_Has_Reserved_Id (Res, True);
+
+         --  Skip 'package'.
+         Scan;
+      end if;
+
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Package_Declaration;
+
+   --  precond : BODY
+   --  postcond: ';'
+   --
+   --  [ LRM93 2.6, LRM08 4.8 ]
+   --  package_body ::=
+   --      PACKAGE BODY PACKAGE_simple_name IS
+   --          package_body_declarative_part
+   --      END [ PACKAGE BODY ] [ PACKAGE_simple_name ] ;
+   procedure Parse_Package_Body (Unit : Iir_Design_Unit)
+   is
+      Res: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Package_Body);
+      Set_Location (Res);
+
+      -- Get identifier.
+      Expect (Tok_Identifier);
+      Set_Identifier (Res, Current_Identifier);
+      Scan_Expect (Tok_Is);
+      Scan;
+
+      Parse_Declarative_Part (Res);
+
+      Expect (Tok_End);
+      Set_End_Location (Unit);
+
+      --  Skip 'end'
+      Scan;
+
+      if Current_Token = Tok_Package then
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87");
+         end if;
+         Set_End_Has_Reserved_Id (Res, True);
+
+         --  Skip 'package'
+         Scan;
+
+         if Current_Token /= Tok_Body then
+            Error_Msg_Parse ("missing 'body' after 'package'");
+         else
+            --  Skip 'body'
+            Scan;
+         end if;
+      end if;
+
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      Set_Library_Unit (Unit, Res);
+   end Parse_Package_Body;
+
+   --  precond : NEW
+   --  postcond: ';'
+   --
+   --  [ LRM08 4.9 ]
+   --  package_instantiation_declaration ::=
+   --      PACKAGE identifier IS NEW uninstantiated_package_name
+   --         [ generic_map_aspect ] ;
+   function Parse_Package_Instantiation_Declaration
+     (Id : Name_Id; Loc : Location_Type)
+     return Iir
+   is
+      Res: Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Package_Instantiation_Declaration);
+      Set_Location (Res, Loc);
+      Set_Identifier (Res, Id);
+
+      --  Skip 'new'
+      Scan;
+
+      Set_Uninstantiated_Package_Name (Res, Parse_Name (False));
+
+      if Current_Token = Tok_Generic then
+         Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+      end if;
+
+      Expect (Tok_Semi_Colon);
+
+      return Res;
+   end Parse_Package_Instantiation_Declaration;
+
+   --  precond : PACKAGE
+   --  postcond: ';'
+   --
+   --    package_declaration
+   --  | package_body
+   --  | package_instantiation_declaration
+   procedure Parse_Package (Unit : Iir_Design_Unit)
+   is
+      Loc : Location_Type;
+      Id : Name_Id;
+   begin
+      --  Skip 'package'
+      Scan;
+
+      if Current_Token = Tok_Body then
+         --  Skip 'body'
+         Scan;
+
+         Parse_Package_Body (Unit);
+      else
+         Expect (Tok_Identifier);
+         Id := Current_Identifier;
+         Loc := Get_Token_Location;
+
+         --  Skip identifier.
+         Scan;
+
+         --  Skip 'is'.
+         Expect (Tok_Is);
+         Scan;
+
+         if Current_Token = Tok_New then
+            Set_Library_Unit
+              (Unit,
+               Parse_Package_Instantiation_Declaration (Id, Loc));
+            --  Note: there is no 'end' in instantiation.
+            Set_End_Location (Unit, Get_Token_Location);
+         else
+            Parse_Package_Declaration (Unit, Id, Loc);
+         end if;
+      end if;
+   end Parse_Package;
+
+   -- Parse a design_unit.
+   -- The lexical scanner must have been initialized, but without a
+   -- current_token.
+   --
+   --  [ §11.1 ]
+   --  design_unit ::= context_clause library_unit
+   --
+   --  [ §11.3 ]
+   --  context_clause ::= { context_item }
+   --
+   --  [ §11.3 ]
+   --  context_item ::= library_clause | use_clause
+   function Parse_Design_Unit return Iir_Design_Unit
+   is
+      Res: Iir_Design_Unit;
+      Unit: Iir;
+   begin
+      -- Internal check: there must be no current_token.
+      if Current_Token /= Tok_Invalid then
+         raise Internal_Error;
+      end if;
+      Scan;
+      if Current_Token = Tok_Eof then
+         return Null_Iir;
+      end if;
+
+      -- Create the design unit node.
+      Res := Create_Iir (Iir_Kind_Design_Unit);
+      Set_Location (Res);
+      Set_Date_State (Res, Date_Extern);
+
+      -- Parse context clauses
+      declare
+         use Context_Items_Chain_Handling;
+         Last : Iir;
+         Els : Iir;
+      begin
+         Build_Init (Last);
+
+         loop
+            case Current_Token is
+               when Tok_Library =>
+                  Els := Parse_Library_Clause;
+               when Tok_Use =>
+                  Els := Parse_Use_Clause;
+                  Scan;
+               when Tok_With =>
+                  --  Be Ada friendly.
+                  Error_Msg_Parse ("'with' not allowed in context clause "
+                                   & "(try 'use' or 'library')");
+                  Els := Parse_Use_Clause;
+                  Scan;
+               when others =>
+                  exit;
+            end case;
+            Append_Subchain (Last, Res, Els);
+         end loop;
+      end;
+
+      -- Parse library unit
+      case Current_Token is
+         when Tok_Entity =>
+            Parse_Entity_Declaration (Res);
+         when Tok_Architecture =>
+            Parse_Architecture_Body (Res);
+         when Tok_Package =>
+            Parse_Package (Res);
+         when Tok_Configuration =>
+            Parse_Configuration_Declaration (Res);
+         when others =>
+            Error_Msg_Parse ("entity, architecture, package or configuration "
+                             & "keyword expected");
+            return Null_Iir;
+      end case;
+      Unit := Get_Library_Unit (Res);
+      Set_Design_Unit (Unit, Res);
+      Set_Identifier (Res, Get_Identifier (Unit));
+      Set_Date (Res, Date_Parsed);
+      Invalidate_Current_Token;
+      return Res;
+   exception
+      when Expect_Error =>
+         raise Compilation_Error;
+   end Parse_Design_Unit;
+
+   --  [ §11.1 ]
+   --  design_file ::= design_unit { design_unit }
+   function Parse_Design_File return Iir_Design_File
+   is
+      Res : Iir_Design_File;
+      Design, Last_Design : Iir_Design_Unit;
+   begin
+      Res := Create_Iir (Iir_Kind_Design_File);
+      Set_Location (Res);
+
+      Last_Design := Null_Iir;
+      loop
+         Design := Parse.Parse_Design_Unit;
+         exit when Design = Null_Iir;
+         Set_Design_File (Design, Res);
+         if Last_Design = Null_Iir then
+            Set_First_Design_Unit (Res, Design);
+         else
+            Set_Chain (Last_Design, Design);
+         end if;
+         Last_Design := Design;
+         Set_Last_Design_Unit (Res, Last_Design);
+      end loop;
+      if Last_Design = Null_Iir then
+         Error_Msg_Parse ("design file is empty (no design unit found)");
+      end if;
+      return Res;
+   exception
+      when Parse_Error =>
+         return Null_Iir;
+   end Parse_Design_File;
+end Parse;
diff --git a/src/parse.ads b/src/parse.ads
new file mode 100644
index 000000000..26bdef3ec
--- /dev/null
+++ b/src/parse.ads
@@ -0,0 +1,44 @@
+--  VHDL parser.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Parse is
+   --  If True, create nodes for parenthesis expressions.
+   Flag_Parse_Parenthesis : Boolean := False;
+
+   -- Parse an expression.
+   -- (Used by PSL).
+   function Parse_Expression return Iir;
+   function Parse_Expression_Rhs (Left : Iir) return Iir;
+
+   -- Parse an relationnal operator and its rhs.
+   function Parse_Relation_Rhs (Left : Iir) return Iir;
+
+   -- Parse a single design unit.
+   -- The scanner must have been initialized, however, the current_token
+   -- shouldn't have been set.
+   -- At return, the last token accepted is the semi_colon that terminates
+   -- the library unit.
+   -- Return Null_Iir when end of file.
+   function Parse_Design_Unit return Iir_Design_Unit;
+
+   --  Parse a file.
+   --  The scanner must habe been initialized as for parse_design_unit.
+   --  Return Null_Iir in case of error.
+   function Parse_Design_File return Iir_Design_File;
+end Parse;
diff --git a/src/parse_psl.adb b/src/parse_psl.adb
new file mode 100644
index 000000000..7cb20ca3b
--- /dev/null
+++ b/src/parse_psl.adb
@@ -0,0 +1,667 @@
+--  VHDL PSL parser.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with PSL.Nodes; use PSL.Nodes;
+with Iirs;
+with Scanner; use Scanner;
+with PSL.Errors; use PSL.Errors;
+with PSL.Priorities; use PSL.Priorities;
+with Parse;
+
+package body Parse_Psl is
+   function Create_Node_Loc (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := PSL.Nodes.Create_Node (K);
+      Set_Location (Res, Get_Token_Location);
+      return Res;
+   end Create_Node_Loc;
+
+   function Parse_Number return Node is
+      Res : Node;
+   begin
+      if Current_Token = Tok_Integer then
+         Res := Create_Node_Loc (N_Number);
+         --  FIXME: handle overflow.
+         Set_Value (Res, Uns32 (Current_Iir_Int64));
+         Scan;
+         return Res;
+      elsif Current_Token = Tok_Inf then
+         --  FIXME: create node
+         Scan;
+         return Null_Node;
+      else
+         Error_Msg_Parse ("number expected");
+         return Null_Node;
+      end if;
+   end Parse_Number;
+
+   procedure Parse_Count (N : Node) is
+   begin
+      Set_Low_Bound (N, Parse_Number);
+      if Current_Token = Tok_To then
+         Scan;
+         Set_High_Bound (N, Parse_Number);
+      end if;
+   end Parse_Count;
+
+   function Psl_To_Vhdl (N : Node) return Iirs.Iir
+   is
+      use Iirs;
+      Res : Iir;
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr =>
+            Res := Iirs.Iir (Get_HDL_Node (N));
+            Free_Node (N);
+            return Res;
+         when others =>
+            Error_Kind ("psl_to_vhdl", N);
+      end case;
+   end Psl_To_Vhdl;
+
+   function Vhdl_To_Psl (N : Iirs.Iir) return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (N_HDL_Expr);
+      Set_Location (Res, Iirs.Get_Location (N));
+      Set_HDL_Node (Res, Int32 (N));
+      return Res;
+   end Vhdl_To_Psl;
+
+   function Parse_FL_Property (Prio : Priority) return Node;
+   function Parse_Sequence return Node;
+
+   function Parse_Parenthesis_Boolean return Node;
+   function Parse_Boolean (Parent_Prio : Priority) return Node;
+
+   function Parse_Unary_Boolean return Node is
+   begin
+      return Vhdl_To_Psl (Parse.Parse_Expression);
+   end Parse_Unary_Boolean;
+
+   function Parse_Boolean_Rhs (Parent_Prio : Priority; Left : Node) return Node
+   is
+      Kind : Nkind;
+      Prio : Priority;
+      Res : Node;
+      Tmp : Node;
+   begin
+      Res := Left;
+      loop
+         case Current_Token is
+            when Tok_And =>
+               Kind := N_And_Bool;
+               Prio := Prio_Seq_And;
+            when Tok_Or =>
+               Kind := N_Or_Bool;
+               Prio := Prio_Seq_Or;
+            when others =>
+               return Res;
+         end case;
+         if Parent_Prio >= Prio then
+            return Res;
+         end if;
+         Tmp := Create_Node_Loc (Kind);
+         Scan;
+         Set_Left (Tmp, Res);
+         Res := Tmp;
+         Tmp := Parse_Boolean (Prio);
+         Set_Right (Res, Tmp);
+      end loop;
+   end Parse_Boolean_Rhs;
+
+   function Parse_Boolean (Parent_Prio : Priority) return Node
+   is
+   begin
+      return Parse_Boolean_Rhs (Parent_Prio, Parse_Unary_Boolean);
+   end Parse_Boolean;
+
+   function Parse_Psl_Boolean return PSL_Node is
+   begin
+      return Parse_Boolean (Prio_Lowest);
+   end Parse_Psl_Boolean;
+
+   function Parse_Parenthesis_Boolean return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Paren then
+         Error_Msg_Parse ("'(' expected before boolean expression");
+         return Null_Node;
+      else
+         Scan;
+         Res := Parse_Psl_Boolean;
+         if Current_Token = Tok_Right_Paren then
+            Scan;
+         else
+            Error_Msg_Parse ("missing matching ')' for boolean expression");
+         end if;
+         return Res;
+      end if;
+   end Parse_Parenthesis_Boolean;
+
+   function Parse_SERE (Prio : Priority) return Node is
+      Left, Res : Node;
+      Kind : Nkind;
+      Op_Prio : Priority;
+   begin
+      Left := Parse_Sequence; --  FIXME: allow boolean;
+      loop
+         case Current_Token is
+            when Tok_Semi_Colon =>
+               Kind := N_Concat_SERE;
+               Op_Prio := Prio_Seq_Concat;
+            when Tok_Colon =>
+               Kind := N_Fusion_SERE;
+               Op_Prio := Prio_Seq_Fusion;
+            when Tok_Within =>
+               Kind := N_Within_SERE;
+               Op_Prio := Prio_Seq_Within;
+            when Tok_Ampersand =>
+               -- For non-length matching and, the operator is '&'.
+               Kind := N_And_Seq;
+               Op_Prio := Prio_Seq_And;
+            when Tok_And_And =>
+               Kind := N_Match_And_Seq;
+               Op_Prio := Prio_Seq_And;
+            when Tok_Bar =>
+               Kind := N_Or_Seq;
+               Op_Prio := Prio_Seq_Or;
+--              when Tok_Bar_Bar =>
+--                 Res := Create_Node_Loc (N_Or_Bool);
+--                 Scan;
+--                 Set_Left (Res, Left);
+--                 Set_Right (Res, Parse_Boolean (Prio_Seq_Or));
+--                 return Res;
+            when others =>
+               return Left;
+         end case;
+         if Prio >= Op_Prio then
+            return Left;
+         end if;
+         Res := Create_Node_Loc (Kind);
+         Scan;
+         Set_Left (Res, Left);
+         Set_Right (Res, Parse_SERE (Op_Prio));
+         Left := Res;
+      end loop;
+   end Parse_SERE;
+
+   --  precond: '{'
+   function Parse_Braced_SERE return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Curly then
+         raise Program_Error;
+      end if;
+      Res := Create_Node_Loc (N_Braced_SERE);
+      Scan;
+      Set_SERE (Res, Parse_SERE (Prio_Lowest));
+      if Current_Token /= Tok_Right_Curly then
+         Error_Msg_Parse ("missing '}' after braced SERE");
+      else
+         Scan;
+      end if;
+      return Res;
+   end Parse_Braced_SERE;
+
+   --  Parse [ Count ] ']'
+   function Parse_Maybe_Count (Kind : Nkind; Seq : Node) return Node is
+      N : Node;
+   begin
+      N := Create_Node_Loc (Kind);
+      Set_Sequence (N, Seq);
+      Scan;
+      if Current_Token /= Tok_Right_Bracket then
+         Parse_Count (N);
+      end if;
+      if Current_Token /= Tok_Right_Bracket then
+         Error_Msg_Parse ("missing ']'");
+      else
+         Scan;
+      end if;
+      return N;
+   end Parse_Maybe_Count;
+
+   procedure Parse_Bracket_Range (N : Node) is
+   begin
+      if Current_Token /= Tok_Left_Bracket then
+         Error_Msg_Parse ("'[' expected");
+      else
+         Scan;
+         Set_Low_Bound (N, Parse_Number);
+         if Current_Token /= Tok_To then
+            Error_Msg_Parse ("'to' expected in range after left bound");
+         else
+            Scan;
+            Set_High_Bound (N, Parse_Number);
+         end if;
+         if Current_Token /= Tok_Right_Bracket then
+            Error_Msg_Parse ("']' expected after range");
+         else
+            Scan;
+         end if;
+      end if;
+   end Parse_Bracket_Range;
+
+   function Parse_Bracket_Number return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Bracket then
+         Error_Msg_Parse ("'[' expected");
+         return Null_Node;
+      else
+         Scan;
+         Res := Parse_Number;
+         if Current_Token /= Tok_Right_Bracket then
+            Error_Msg_Parse ("']' expected after range");
+         else
+            Scan;
+         end if;
+         return Res;
+      end if;
+   end Parse_Bracket_Number;
+
+   function Parse_Sequence return Node is
+      Res, N : Node;
+   begin
+      case Current_Token is
+         when Tok_Left_Curly =>
+            Res := Parse_Braced_SERE;
+         when Tok_Brack_Star =>
+            return Parse_Maybe_Count (N_Star_Repeat_Seq, Null_Node);
+         when Tok_Left_Paren =>
+            Res := Parse_Parenthesis_Boolean;
+            if Current_Token = Tok_Or
+              or else Current_Token = Tok_And
+            then
+               Res := Parse_Boolean_Rhs (Prio_Lowest, Res);
+            end if;
+         when Tok_Brack_Plus_Brack =>
+            Res := Create_Node_Loc (N_Plus_Repeat_Seq);
+            Scan;
+            return Res;
+         when others =>
+            --  Repeated_SERE
+            Res := Parse_Unary_Boolean;
+      end case;
+      loop
+         case Current_Token is
+            when Tok_Brack_Star =>
+               Res := Parse_Maybe_Count (N_Star_Repeat_Seq, Res);
+            when Tok_Brack_Plus_Brack =>
+               N := Create_Node_Loc (N_Plus_Repeat_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Res := N;
+            when Tok_Brack_Arrow =>
+               Res := Parse_Maybe_Count (N_Goto_Repeat_Seq, Res);
+            when Tok_Brack_Equal =>
+               N := Create_Node_Loc (N_Equal_Repeat_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Parse_Count (N);
+               if Current_Token /= Tok_Right_Bracket then
+                  Error_Msg_Parse ("missing ']'");
+               else
+                  Scan;
+               end if;
+               Res := N;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Parse_Sequence;
+
+   --  precond:  '('
+   --  postcond: next token
+   function Parse_Parenthesis_FL_Property return Node is
+      Res : Node;
+      Loc : Location_Type;
+   begin
+      Loc := Get_Token_Location;
+      if Current_Token /= Tok_Left_Paren then
+         Error_Msg_Parse ("'(' expected around property");
+         return Parse_FL_Property (Prio_Lowest);
+      else
+         Scan;
+         Res := Parse_FL_Property (Prio_Lowest);
+         if Current_Token /= Tok_Right_Paren then
+            Error_Msg_Parse ("missing matching ')' for '(' at line "
+                               & Get_Location_Str (Loc, False));
+         else
+            Scan;
+         end if;
+         return Res;
+      end if;
+   end Parse_Parenthesis_FL_Property;
+
+   --  Parse [ '!' ] '[' finite_Range ']' '(' FL_Property ')'
+   function Parse_Range_Property (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Scan;
+      Parse_Bracket_Range (Res);
+      Set_Property (Res, Parse_Parenthesis_FL_Property);
+      return Res;
+   end Parse_Range_Property;
+
+   --  Parse [ '!' ] '(' Boolean ')' '[' Range ']' '(' FL_Property ')'
+   function Parse_Boolean_Range_Property (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Scan;
+      Set_Boolean (Res, Parse_Parenthesis_Boolean);
+      Parse_Bracket_Range (Res);
+      Set_Property (Res, Parse_Parenthesis_FL_Property);
+      return Res;
+   end Parse_Boolean_Range_Property;
+
+   function Parse_FL_Property_1 return Node
+   is
+      Res : Node;
+      Tmp : Node;
+   begin
+      case Current_Token is
+         when Tok_Always =>
+            Res := Create_Node_Loc (N_Always);
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance));
+         when Tok_Never =>
+            Res := Create_Node_Loc (N_Never);
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance));
+         when Tok_Eventually =>
+            Res := Create_Node_Loc (N_Eventually);
+            if not Scan_Exclam_Mark then
+               Error_Msg_Parse ("'eventually' must be followed by '!'");
+            end if;
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
+         when Tok_Next =>
+            Res := Create_Node_Loc (N_Next);
+            Scan;
+            if Current_Token = Tok_Left_Bracket then
+               Set_Number (Res, Parse_Bracket_Number);
+               Set_Property (Res, Parse_Parenthesis_FL_Property);
+            else
+               Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
+            end if;
+         when Tok_Next_A =>
+            Res := Parse_Range_Property (N_Next_A);
+         when Tok_Next_E =>
+            Res := Parse_Range_Property (N_Next_E);
+         when Tok_Next_Event =>
+            Res := Create_Node_Loc (N_Next_Event);
+            Scan;
+            Set_Boolean (Res, Parse_Parenthesis_Boolean);
+            if Current_Token = Tok_Left_Bracket then
+               Set_Number (Res, Parse_Bracket_Number);
+            end if;
+            Set_Property (Res, Parse_Parenthesis_FL_Property);
+         when Tok_Next_Event_A =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_A);
+         when Tok_Next_Event_E =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_E);
+         when Tok_Left_Paren =>
+            return Parse_Parenthesis_FL_Property;
+         when Tok_Left_Curly =>
+            Res := Parse_Sequence;
+            if Get_Kind (Res) = N_Braced_SERE
+              and then Current_Token = Tok_Left_Paren
+            then
+               --  FIXME: must check that RES is really a sequence
+               --  (and not a SERE).
+               Tmp := Create_Node_Loc (N_Overlap_Imp_Seq);
+               Set_Sequence (Tmp, Res);
+               Set_Property (Tmp, Parse_Parenthesis_FL_Property);
+               Res := Tmp;
+            end if;
+         when others =>
+            Res := Parse_Sequence;
+      end case;
+      return Res;
+   end Parse_FL_Property_1;
+
+   function Parse_St_Binary_FL_Property (K : Nkind; Left : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Set_Inclusive_Flag (Res, Scan_Underscore);
+      Scan;
+      Set_Left (Res, Left);
+      Set_Right (Res, Parse_FL_Property (Prio_FL_Bounding));
+      return Res;
+   end Parse_St_Binary_FL_Property;
+
+   function Parse_Binary_FL_Property (K : Nkind; Left : Node; Prio : Priority)
+                                     return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Scan;
+      Set_Left (Res, Left);
+      Set_Right (Res, Parse_FL_Property (Prio));
+      return Res;
+   end Parse_Binary_FL_Property;
+
+   function Parse_FL_Property (Prio : Priority) return Node
+   is
+      Res : Node;
+      N : Node;
+   begin
+      Res := Parse_FL_Property_1;
+      loop
+         case Current_Token is
+            when Tok_Minus_Greater =>
+               if Prio > Prio_Bool_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Log_Imp_Prop);
+               Set_Left (N, Res);
+               Scan;
+               Set_Right (N, Parse_FL_Property (Prio_Bool_Imp));
+               Res := N;
+            when Tok_Bar_Arrow =>
+               if Prio > Prio_Seq_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Overlap_Imp_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
+               Res := N;
+            when Tok_Bar_Double_Arrow =>
+               if Prio > Prio_Seq_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Imp_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
+               Res := N;
+            when Tok_Abort =>
+               if Prio > Prio_FL_Abort then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Abort);
+               Set_Property (N, Res);
+               Scan;
+               Set_Boolean (N, Parse_Boolean (Prio_Lowest));
+               --  Left associative.
+               return N;
+            when Tok_Exclam_Mark =>
+               N := Create_Node_Loc (N_Strong);
+               Set_Property (N, Res);
+               Scan;
+               Res := N;
+            when Tok_Until =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Until, Res);
+            when Tok_Before =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Before, Res);
+            when Tok_Or =>
+               if Prio > Prio_Seq_Or then
+                  return Res;
+               end if;
+               Res := Parse_Binary_FL_Property (N_Or_Prop, Res, Prio_Seq_Or);
+            when Tok_And =>
+               if Prio > Prio_Seq_And then
+                  return Res;
+               end if;
+               Res := Parse_Binary_FL_Property (N_And_Prop, Res, Prio_Seq_And);
+            when Token_Relational_Operator_Type =>
+               return Vhdl_To_Psl
+                 (Parse.Parse_Relation_Rhs (Psl_To_Vhdl (Res)));
+            when Tok_Colon
+              | Tok_Bar
+              | Tok_Ampersand
+              | Tok_And_And =>
+               Error_Msg_Parse ("SERE operator '" & Image (Current_Token)
+                                  & "' is not allowed in property");
+               Scan;
+               N := Parse_FL_Property (Prio_Lowest);
+               return Res;
+            when Tok_Arobase =>
+               if Prio > Prio_Clock_Event then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Clock_Event);
+               Set_Property (N, Res);
+               Scan;
+               Set_Boolean (N, Parse_Boolean (Prio_Clock_Event));
+               Res := N;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Parse_FL_Property;
+
+   function Parse_Psl_Property return PSL_Node is
+   begin
+      return Parse_FL_Property (Prio_Lowest);
+   end Parse_Psl_Property;
+
+   --  precond:  identifier
+   --  postcond: ';'
+   --
+   --  6.2.4.1  Property declaration
+   --
+   --  Property_Declaration ::=
+   --     PROPERTY psl_identifier [ ( Formal_Parameter_List ) ] DEF_SYM
+   --        property ;
+   function Parse_Psl_Declaration (Tok : Token_Type) return PSL_Node
+   is
+      Res : Node;
+      Param : Node;
+      Last_Param : Node;
+      Pkind : Nkind;
+      Kind : Nkind;
+   begin
+      case Tok is
+         when Tok_Psl_Property =>
+            Kind := N_Property_Declaration;
+         when Tok_Psl_Sequence =>
+            Kind := N_Sequence_Declaration;
+         when Tok_Psl_Endpoint =>
+            Kind := N_Endpoint_Declaration;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Res := Create_Node_Loc (Kind);
+      if Current_Token = Tok_Identifier then
+         Set_Identifier (Res, Current_Identifier);
+         Scan;
+      end if;
+
+      --  Formal parameter list.
+      if Current_Token = Tok_Left_Paren then
+         Last_Param := Null_Node;
+         loop
+            --  precond: '(' or ';'.
+            Scan;
+            case Current_Token is
+               when Tok_Psl_Const =>
+                  Pkind := N_Const_Parameter;
+               when Tok_Psl_Boolean =>
+                  Pkind := N_Boolean_Parameter;
+               when Tok_Psl_Property =>
+                  Pkind := N_Property_Parameter;
+               when Tok_Psl_Sequence =>
+                  Pkind := N_Sequence_Parameter;
+               when others =>
+                  Error_Msg_Parse ("parameter type expected");
+            end case;
+
+            --  Formal parameters.
+            loop
+               --  precond: parameter_type or ','
+               Scan;
+               Param := Create_Node_Loc (Pkind);
+               if Current_Token /= Tok_Identifier then
+                  Error_Msg_Parse ("identifier for parameter expected");
+               else
+                  Set_Identifier (Param, Current_Identifier);
+               end if;
+               if Last_Param = Null_Node then
+                  Set_Parameter_List (Res, Param);
+               else
+                  Set_Chain (Last_Param, Param);
+               end if;
+               Last_Param := Param;
+               Scan;
+               exit when Current_Token /= Tok_Comma;
+            end loop;
+            exit when Current_Token = Tok_Right_Paren;
+            if Current_Token /= Tok_Semi_Colon then
+               Error_Msg_Parse ("';' expected between formal parameter");
+            end if;
+
+         end loop;
+         Scan;
+      end if;
+
+      if Current_Token /= Tok_Is then
+         Error_Msg_Parse ("'is' expected after identifier");
+      else
+         Scan;
+      end if;
+      case Kind is
+         when N_Property_Declaration =>
+            Set_Property (Res, Parse_Psl_Property);
+         when N_Sequence_Declaration
+           | N_Endpoint_Declaration =>
+            Set_Sequence (Res, Parse_Sequence);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Parse_Psl_Declaration;
+end Parse_Psl;
diff --git a/src/parse_psl.ads b/src/parse_psl.ads
new file mode 100644
index 000000000..62869feb8
--- /dev/null
+++ b/src/parse_psl.ads
@@ -0,0 +1,26 @@
+--  VHDL PSL parser.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Tokens; use Tokens;
+
+package Parse_Psl is
+   function Parse_Psl_Property return PSL_Node;
+   function Parse_Psl_Boolean return PSL_Node;
+   function Parse_Psl_Declaration (Tok : Token_Type) return PSL_Node;
+end Parse_Psl;
diff --git a/src/post_sems.adb b/src/post_sems.adb
new file mode 100644
index 000000000..78eda5015
--- /dev/null
+++ b/src/post_sems.adb
@@ -0,0 +1,71 @@
+--  Global checks after semantization pass.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Std_Names; use Std_Names;
+with Ieee.Std_Logic_1164;
+with Ieee.Vital_Timing;
+with Flags; use Flags;
+
+package body Post_Sems is
+   procedure Post_Sem_Checks (Unit : Iir_Design_Unit)
+   is
+      Lib_Unit : constant Iir := Get_Library_Unit (Unit);
+      Lib : Iir_Library_Declaration;
+      Id : Name_Id;
+
+      Value : Iir_Attribute_Value;
+      Spec : Iir_Attribute_Specification;
+      Attr_Decl : Iir_Attribute_Declaration;
+   begin
+      --  No checks on package bodies.
+      if Get_Kind (Lib_Unit) = Iir_Kind_Package_Body then
+         return;
+      end if;
+
+      Id := Get_Identifier (Lib_Unit);
+      Lib := Get_Library (Get_Design_File (Unit));
+
+      if Get_Identifier (Lib) = Name_Ieee then
+         --  This is a unit of IEEE.
+         if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then
+            if Id = Name_Std_Logic_1164 then
+               Ieee.Std_Logic_1164.Extract_Declarations (Lib_Unit);
+            elsif Id = Name_VITAL_Timing then
+               Ieee.Vital_Timing.Extract_Declarations (Lib_Unit);
+            end if;
+         end if;
+      end if;
+
+      --  Look for VITAL attributes.
+      if Flag_Vital_Checks then
+         Value := Get_Attribute_Value_Chain (Lib_Unit);
+         while Value /= Null_Iir loop
+            Spec := Get_Attribute_Specification (Value);
+            Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Spec));
+            if Attr_Decl = Ieee.Vital_Timing.Vital_Level0_Attribute then
+               Ieee.Vital_Timing.Check_Vital_Level0 (Unit);
+            elsif Attr_Decl = Ieee.Vital_Timing.Vital_Level1_Attribute then
+               Ieee.Vital_Timing.Check_Vital_Level1 (Unit);
+            end if;
+
+            Value := Get_Chain (Value);
+         end loop;
+      end if;
+   end Post_Sem_Checks;
+end Post_Sems;
+
diff --git a/src/post_sems.ads b/src/post_sems.ads
new file mode 100644
index 000000000..ed042264e
--- /dev/null
+++ b/src/post_sems.ads
@@ -0,0 +1,25 @@
+--  Global checks after semantization pass.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Post_Sems is
+   --  Do post semantization checks, such as VITAL checks.
+   --  This procedure is also used to extract declarations from ieee
+   --  packages.
+   procedure Post_Sem_Checks (Unit : Iir_Design_Unit);
+end Post_Sems;
diff --git a/src/psl-errors.ads b/src/psl-errors.ads
new file mode 100644
index 000000000..e99bb7de6
--- /dev/null
+++ b/src/psl-errors.ads
@@ -0,0 +1,3 @@
+with Errorout;
+
+package PSL.Errors renames Errorout;
diff --git a/src/psl/psl-build.adb b/src/psl/psl-build.adb
new file mode 100644
index 000000000..c3e47baa6
--- /dev/null
+++ b/src/psl/psl-build.adb
@@ -0,0 +1,1009 @@
+with GNAT.Table;
+with Ada.Text_IO; use Ada.Text_IO;
+with Types; use Types;
+with PSL.Errors; use PSL.Errors;
+with PSL.CSE; use PSL.CSE;
+with PSL.QM;
+with PSL.Disp_NFAs; use PSL.Disp_NFAs;
+with PSL.Optimize; use PSL.Optimize;
+with PSL.NFAs.Utils;
+with PSL.Prints;
+with PSL.NFAs; use PSL.NFAs;
+
+package body PSL.Build is
+   function Build_SERE_FA (N : Node) return NFA;
+
+
+   package Intersection is
+      function Build_Inter (L, R : NFA; Match_Len : Boolean) return NFA;
+   end Intersection;
+
+   package body Intersection is
+
+      type Stack_Entry_Id is new Natural;
+      No_Stack_Entry : constant Stack_Entry_Id := 0;
+      type Stack_Entry is record
+         L, R : NFA_State;
+         Res : NFA_State;
+         Next_Unhandled : Stack_Entry_Id;
+      end record;
+
+      package Stackt is new GNAT.Table
+        (Table_Component_Type => Stack_Entry,
+         Table_Index_Type => Stack_Entry_Id,
+         Table_Low_Bound => 1,
+         Table_Initial => 128,
+         Table_Increment => 100);
+
+      First_Unhandled : Stack_Entry_Id;
+
+      procedure Init_Stack is
+      begin
+         Stackt.Init;
+         First_Unhandled := No_Stack_Entry;
+      end Init_Stack;
+
+      function Not_Empty return Boolean is
+      begin
+         return First_Unhandled /= No_Stack_Entry;
+      end Not_Empty;
+
+      procedure Pop_State (L, R : out NFA_State) is
+      begin
+         L := Stackt.Table (First_Unhandled).L;
+         R := Stackt.Table (First_Unhandled).R;
+         First_Unhandled := Stackt.Table (First_Unhandled).Next_Unhandled;
+      end Pop_State;
+
+      function Get_State (N : NFA; L, R : NFA_State) return NFA_State
+      is
+         Res : NFA_State;
+      begin
+         for I in Stackt.First .. Stackt.Last loop
+            if Stackt.Table (I).L = L
+              and then Stackt.Table (I).R = R
+            then
+               return Stackt.Table (I).Res;
+            end if;
+         end loop;
+         Res := Add_State (N);
+         Stackt.Append ((L => L, R => R, Res => Res,
+                         Next_Unhandled => First_Unhandled));
+         First_Unhandled := Stackt.Last;
+         return Res;
+      end Get_State;
+
+      function Build_Inter (L, R : NFA; Match_Len : Boolean) return NFA
+      is
+         Start_L, Start_R : NFA_State;
+         Final_L, Final_R : NFA_State;
+         S_L, S_R : NFA_State;
+         E_L, E_R : NFA_Edge;
+         Res : NFA;
+         Start : NFA_State;
+         Extra_L, Extra_R : NFA_Edge;
+      begin
+         Start_L := Get_Start_State (L);
+         Start_R := Get_Start_State (R);
+         Final_R := Get_Final_State (R);
+         Final_L := Get_Final_State (L);
+
+         if False then
+            Disp_Body (L);
+            Disp_Body (R);
+            Put ("//start state: ");
+            Disp_State (Start_L);
+            Put (",");
+            Disp_State (Start_R);
+            New_Line;
+         end if;
+
+         if Match_Len then
+            Extra_L := No_Edge;
+            Extra_R := No_Edge;
+         else
+            Extra_L := Add_Edge (Final_L, Final_L, True_Node);
+            Extra_R := Add_Edge (Final_R, Final_R, True_Node);
+         end if;
+
+         Res := Create_NFA;
+         Init_Stack;
+         Start := Get_State (Res, Start_L, Start_R);
+         Set_Start_State (Res, Start);
+
+         while Not_Empty loop
+            Pop_State (S_L, S_R);
+
+            if False then
+               Put ("//poped state: ");
+               Disp_State (S_L);
+               Put (",");
+               Disp_State (S_R);
+               New_Line;
+            end if;
+
+            E_L := Get_First_Src_Edge (S_L);
+            while E_L /= No_Edge loop
+               E_R := Get_First_Src_Edge (S_R);
+               while E_R /= No_Edge loop
+                  if not (E_L = Extra_L and E_R = Extra_R) then
+                     Add_Edge (Get_State (Res, S_L, S_R),
+                               Get_State (Res,
+                                          Get_Edge_Dest (E_L),
+                                          Get_Edge_Dest (E_R)),
+                               Build_Bool_And (Get_Edge_Expr (E_L),
+                                               Get_Edge_Expr (E_R)));
+                  end if;
+                  E_R := Get_Next_Src_Edge (E_R);
+               end loop;
+               E_L := Get_Next_Src_Edge (E_L);
+            end loop;
+         end loop;
+         Set_Final_State (Res, Get_State (Res, Final_L, Final_R));
+         Remove_Unreachable_States (Res);
+
+         if not Match_Len then
+            Remove_Edge (Extra_L);
+            Remove_Edge (Extra_R);
+         end if;
+
+         --  FIXME: free L and R.
+         return Res;
+      end Build_Inter;
+   end Intersection;
+
+   --  All edges from A are duplicated using B as a source.
+   --  Handle epsilon-edges.
+   procedure Duplicate_Src_Edges (N : NFA; A, B : NFA_State)
+   is
+      pragma Unreferenced (N);
+      E : NFA_Edge;
+      Expr : Node;
+      Dest : NFA_State;
+   begin
+      pragma Assert (A /= B);
+      E := Get_First_Src_Edge (A);
+      while E /= No_Edge loop
+         Expr := Get_Edge_Expr (E);
+         Dest := Get_Edge_Dest (E);
+         if Expr /= Null_Node then
+            Add_Edge (B, Dest, Expr);
+         end if;
+         E := Get_Next_Src_Edge (E);
+      end loop;
+   end Duplicate_Src_Edges;
+
+   --  All edges to A are duplicated using B as a destination.
+   --  Handle epsilon-edges.
+   procedure Duplicate_Dest_Edges (N : NFA; A, B : NFA_State)
+   is
+      pragma Unreferenced (N);
+      E : NFA_Edge;
+      Expr : Node;
+      Src : NFA_State;
+   begin
+      pragma Assert (A /= B);
+      E := Get_First_Dest_Edge (A);
+      while E /= No_Edge loop
+         Expr := Get_Edge_Expr (E);
+         Src := Get_Edge_Src (E);
+         if Expr /= Null_Node then
+            Add_Edge (Src, B, Expr);
+         end if;
+         E := Get_Next_Dest_Edge (E);
+      end loop;
+   end Duplicate_Dest_Edges;
+
+   procedure Remove_Epsilon_Edge (N : NFA; S, D : NFA_State) is
+   begin
+      if Get_First_Src_Edge (S) = No_Edge then
+         --  No edge from S.
+         --  Move edges to S to D.
+         Redest_Edges (S, D);
+         Remove_Unconnected_State (N, S);
+         if Get_Start_State (N) = S then
+            Set_Start_State (N, D);
+         end if;
+      elsif Get_First_Dest_Edge (D) = No_Edge then
+         --  No edge to D.
+         --  Move edges from D to S.
+         Resource_Edges (D, S);
+         Remove_Unconnected_State (N, D);
+         if Get_Final_State (N) = D then
+            Set_Final_State (N, S);
+         end if;
+      else
+         Duplicate_Dest_Edges (N, S, D);
+         Duplicate_Src_Edges (N, D, S);
+         Remove_Identical_Src_Edges (S);
+      end if;
+   end Remove_Epsilon_Edge;
+
+   procedure Remove_Epsilon (N : NFA;
+                             E : NFA_Edge) is
+      S : constant NFA_State := Get_Edge_Src (E);
+      D : constant NFA_State := Get_Edge_Dest (E);
+   begin
+      Remove_Edge (E);
+
+      Remove_Epsilon_Edge (N, S, D);
+   end Remove_Epsilon;
+
+   function Build_Concat (L, R : NFA) return NFA
+   is
+      Start_L, Start_R : NFA_State;
+      Final_L, Final_R : NFA_State;
+      Eps_L, Eps_R : Boolean;
+      E_L, E_R : NFA_Edge;
+   begin
+      Start_L := Get_Start_State (L);
+      Start_R := Get_Start_State (R);
+      Final_R := Get_Final_State (R);
+      Final_L := Get_Final_State (L);
+      Eps_L := Get_Epsilon_NFA (L);
+      Eps_R := Get_Epsilon_NFA (R);
+
+      Merge_NFA (L, R);
+
+      Set_Start_State (L, Start_L);
+      Set_Final_State (L, Final_R);
+      Set_Epsilon_NFA (L, False);
+
+      if Eps_L then
+         E_L := Add_Edge (Start_L, Final_L, Null_Node);
+      end if;
+
+      if Eps_R then
+         E_R := Add_Edge (Start_R, Final_R, Null_Node);
+      end if;
+
+      Remove_Epsilon_Edge (L, Final_L, Start_R);
+
+      if Eps_L then
+         Remove_Epsilon (L, E_L);
+      end if;
+      if Eps_R then
+         Remove_Epsilon (L, E_R);
+      end if;
+
+      if (Start_L = Final_L or else Eps_L)
+        and then (Start_R = Final_R or else Eps_R)
+      then
+         Set_Epsilon_NFA (L, True);
+      end if;
+
+      Remove_Identical_Src_Edges (Final_L);
+      Remove_Identical_Dest_Edges (Start_R);
+
+      return L;
+   end Build_Concat;
+
+   function Build_Or (L, R : NFA) return NFA
+   is
+      Start_L, Start_R : NFA_State;
+      Final_L, Final_R : NFA_State;
+      Eps : Boolean;
+      Start, Final : NFA_State;
+      E_S_L, E_S_R, E_L_F, E_R_F : NFA_Edge;
+   begin
+      Start_L := Get_Start_State (L);
+      Start_R := Get_Start_State (R);
+      Final_R := Get_Final_State (R);
+      Final_L := Get_Final_State (L);
+      Eps := Get_Epsilon_NFA (L) or Get_Epsilon_NFA (R);
+
+      --  Optimize [*0] | R.
+      if Start_L = Final_L
+        and then Get_First_Src_Edge (Start_L) = No_Edge
+      then
+         if Start_R /= Final_R then
+            Set_Epsilon_NFA (R, True);
+         end if;
+         --  FIXME
+         --  delete_NFA (L);
+         return R;
+      end if;
+
+      Merge_NFA (L, R);
+
+      --  Use Thompson construction.
+      Start := Add_State (L);
+      Set_Start_State (L, Start);
+      E_S_L := Add_Edge (Start, Start_L, Null_Node);
+      E_S_R := Add_Edge (Start, Start_R, Null_Node);
+
+      Final := Add_State (L);
+      Set_Final_State (L, Final);
+      E_L_F := Add_Edge (Final_L, Final, Null_Node);
+      E_R_F := Add_Edge (Final_R, Final, Null_Node);
+
+      Set_Epsilon_NFA (L, Eps);
+
+      Remove_Epsilon (L, E_S_L);
+      Remove_Epsilon (L, E_S_R);
+      Remove_Epsilon (L, E_L_F);
+      Remove_Epsilon (L, E_R_F);
+
+      return L;
+   end Build_Or;
+
+   function Build_Fusion (L, R : NFA) return NFA
+   is
+      Start_R : NFA_State;
+      Final_L, Final_R, S_L : NFA_State;
+      E_L : NFA_Edge;
+      E_R : NFA_Edge;
+      N_L, Expr : Node;
+   begin
+      Start_R := Get_Start_State (R);
+      Final_R := Get_Final_State (R);
+      Final_L := Get_Final_State (L);
+
+      Merge_NFA (L, R);
+
+      E_L := Get_First_Dest_Edge (Final_L);
+      while E_L /= No_Edge loop
+         S_L := Get_Edge_Src (E_L);
+         N_L := Get_Edge_Expr (E_L);
+
+         E_R := Get_First_Src_Edge (Start_R);
+         while E_R /= No_Edge loop
+            Expr := Build_Bool_And (N_L, Get_Edge_Expr (E_R));
+            Expr := PSL.QM.Reduce (Expr);
+            if Expr /= False_Node then
+               Add_Edge (S_L, Get_Edge_Dest (E_R), Expr);
+            end if;
+            E_R := Get_Next_Src_Edge (E_R);
+         end loop;
+         Remove_Identical_Src_Edges (S_L);
+         E_L := Get_Next_Dest_Edge (E_L);
+      end loop;
+
+      Set_Final_State (L, Final_R);
+
+      Set_Epsilon_NFA (L, False);
+
+      if Get_First_Src_Edge (Final_L) = No_Edge then
+         Remove_State (L, Final_L);
+      end if;
+      if Get_First_Dest_Edge (Start_R) = No_Edge then
+         Remove_State (L, Start_R);
+      end if;
+
+      return L;
+   end Build_Fusion;
+
+   function Build_Star_Repeat (N : Node) return NFA is
+      Res : NFA;
+      Start, Final, S : NFA_State;
+      Seq : Node;
+   begin
+      Seq := Get_Sequence (N);
+      if Seq = Null_Node then
+         --  Epsilon.
+         Res := Create_NFA;
+         S := Add_State (Res);
+         Set_Start_State (Res, S);
+         Set_Final_State (Res, S);
+         return Res;
+      end if;
+      Res := Build_SERE_FA (Seq);
+      Start := Get_Start_State (Res);
+      Final := Get_Final_State (Res);
+      Redest_Edges (Final, Start);
+      Set_Final_State (Res, Start);
+      Remove_Unconnected_State (Res, Final);
+      Set_Epsilon_NFA (Res, False);
+      return Res;
+   end Build_Star_Repeat;
+
+   function Build_Plus_Repeat (N : Node) return NFA is
+      Res : NFA;
+      Start, Final : NFA_State;
+      T : NFA_Edge;
+   begin
+      Res := Build_SERE_FA (Get_Sequence (N));
+      Start := Get_Start_State (Res);
+      Final := Get_Final_State (Res);
+      T := Get_First_Dest_Edge (Final);
+      while T /= No_Edge loop
+         Add_Edge (Get_Edge_Src (T), Start, Get_Edge_Expr (T));
+         T := Get_Next_Src_Edge (T);
+      end loop;
+      return Res;
+   end Build_Plus_Repeat;
+
+   --  Association actual to formals, so that when a formal is referenced, the
+   --  actual can be used instead.
+   procedure Assoc_Instance (Decl : Node; Instance : Node)
+   is
+      Formal : Node;
+      Actual : Node;
+   begin
+      --  Temporary associates actuals to formals.
+      Formal := Get_Parameter_List (Decl);
+      Actual := Get_Association_Chain (Instance);
+      while Formal /= Null_Node loop
+         if Actual = Null_Node then
+            --  Not enough actual.
+            raise Internal_Error;
+         end if;
+         if Get_Actual (Formal) /= Null_Node then
+            --  Recursion
+            raise Internal_Error;
+         end if;
+         Set_Actual (Formal, Get_Actual (Actual));
+         Formal := Get_Chain (Formal);
+         Actual := Get_Chain (Actual);
+      end loop;
+      if Actual /= Null_Node then
+         --  Too many actual.
+         raise Internal_Error;
+      end if;
+   end Assoc_Instance;
+
+   procedure Unassoc_Instance (Decl : Node)
+   is
+      Formal : Node;
+   begin
+      --  Remove temporary association.
+      Formal := Get_Parameter_List (Decl);
+      while Formal /= Null_Node loop
+         Set_Actual (Formal, Null_Node);
+         Formal := Get_Chain (Formal);
+      end loop;
+   end Unassoc_Instance;
+
+   function Build_SERE_FA (N : Node) return NFA
+   is
+      Res : NFA;
+      S1, S2 : NFA_State;
+   begin
+      case Get_Kind (N) is
+         when N_Booleans =>
+            Res := Create_NFA;
+            S1 := Add_State (Res);
+            S2 := Add_State (Res);
+            Set_Start_State (Res, S1);
+            Set_Final_State (Res, S2);
+            if N /= False_Node then
+               Add_Edge (S1, S2, N);
+            end if;
+            return Res;
+         when N_Braced_SERE =>
+            return Build_SERE_FA (Get_SERE (N));
+         when N_Concat_SERE =>
+            return Build_Concat (Build_SERE_FA (Get_Left (N)),
+                                 Build_SERE_FA (Get_Right (N)));
+         when N_Fusion_SERE =>
+            return Build_Fusion (Build_SERE_FA (Get_Left (N)),
+                                 Build_SERE_FA (Get_Right (N)));
+         when N_Match_And_Seq =>
+            return Intersection.Build_Inter (Build_SERE_FA (Get_Left (N)),
+                                             Build_SERE_FA (Get_Right (N)),
+                                             True);
+         when N_And_Seq =>
+            return Intersection.Build_Inter (Build_SERE_FA (Get_Left (N)),
+                                             Build_SERE_FA (Get_Right (N)),
+                                             False);
+         when N_Or_Prop
+           | N_Or_Seq =>
+            return Build_Or (Build_SERE_FA (Get_Left (N)),
+                             Build_SERE_FA (Get_Right (N)));
+         when N_Star_Repeat_Seq =>
+            return Build_Star_Repeat (N);
+         when N_Plus_Repeat_Seq =>
+            return Build_Plus_Repeat (N);
+         when N_Sequence_Instance
+           | N_Endpoint_Instance =>
+            declare
+               Decl : Node;
+            begin
+               Decl := Get_Declaration (N);
+               Assoc_Instance (Decl, N);
+               Res := Build_SERE_FA (Get_Sequence (Decl));
+               Unassoc_Instance (Decl);
+               return Res;
+            end;
+         when N_Boolean_Parameter
+           | N_Sequence_Parameter =>
+            declare
+               Actual : constant Node := Get_Actual (N);
+            begin
+               if Actual = Null_Node then
+                  raise Internal_Error;
+               end if;
+               return Build_SERE_FA (Actual);
+            end;
+         when others =>
+            Error_Kind ("build_sere_fa", N);
+      end case;
+   end Build_SERE_FA;
+
+   function Count_Edges (S : NFA_State) return Natural
+   is
+      Res : Natural;
+      E : NFA_Edge;
+   begin
+      Res := 0;
+      E := Get_First_Src_Edge (S);
+      while E /= No_Edge loop
+         Res := Res + 1;
+         E := Get_Next_Src_Edge (E);
+      end loop;
+      return Res;
+   end Count_Edges;
+
+   type Count_Vector is array (Natural range <>) of Natural;
+
+   procedure Count_All_Edges (N : NFA; Res : out Count_Vector)
+   is
+      S : NFA_State;
+   begin
+      S := Get_First_State (N);
+      while S /= No_State loop
+         Res (Natural (Get_State_Label (S))) := Count_Edges (S);
+         S := Get_Next_State (S);
+      end loop;
+   end Count_All_Edges;
+
+   pragma Unreferenced (Count_All_Edges);
+
+   package Determinize is
+      --  Create a new NFA that reaches its final state only when N fails
+      --  (ie when the final state is not reached).
+      function Determinize (N : NFA) return NFA;
+   end Determinize;
+
+   package body Determinize is
+      --  In all the comments N stands for the initial NFA (ie the NFA to
+      --  determinize).
+
+      use Prints;
+
+      Flag_Trace : constant Boolean := False;
+      Last_Label : Int32 := 0;
+
+      --  The tree associates a set of states in N to *an* uniq set in the
+      --  result NFA.
+      --
+      --  As the NFA is labelized, each node represent a state in N, and has
+      --  two branches: one for state is present and one for state is absent.
+      --
+      --  The leaves contain the state in the result NFA.
+      --
+      --  The leaves are chained to create a stack of state to handle.
+      --
+      --  The root of the tree is node Start_Tree_Id and represent the start
+      --  state of N.
+      type Deter_Tree_Id is new Natural;
+      No_Tree_Id : constant Deter_Tree_Id := 0;
+      Start_Tree_Id : constant Deter_Tree_Id := 1;
+
+      --  List of unhanded leaves.
+      Deter_Head : Deter_Tree_Id;
+
+      type Deter_Tree_Id_Bool_Array is array (Boolean) of Deter_Tree_Id;
+
+      --  Node in the tree.
+      type Deter_Tree_Entry is record
+         Parent : Deter_Tree_Id;
+
+         --  For non-leaf:
+         Child : Deter_Tree_Id_Bool_Array;
+
+         --  For leaf:
+         Link : Deter_Tree_Id;
+         State : NFA_State;
+         --  + value ?
+      end record;
+
+      package Detert is new GNAT.Table
+        (Table_Component_Type => Deter_Tree_Entry,
+         Table_Index_Type => Deter_Tree_Id,
+         Table_Low_Bound => 1,
+         Table_Initial => 128,
+         Table_Increment => 100);
+
+      type Bool_Vector is array (Natural range <>) of Boolean;
+      pragma Pack (Bool_Vector);
+
+      --  Convert a set of states in N to a state in the result NFA.
+      --  The set is represented by a vector of boolean.  An element of the
+      --  vector is true iff the corresponding state is present.
+      function Add_Vector (V : Bool_Vector; N : NFA) return NFA_State
+      is
+         E : Deter_Tree_Id;
+         Added : Boolean;
+         Res : NFA_State;
+      begin
+         E := Start_Tree_Id;
+         Added := False;
+         for I in V'Range loop
+            if Detert.Table (E).Child (V (I)) = No_Tree_Id then
+               Detert.Append ((Child => (No_Tree_Id, No_Tree_Id),
+                               Parent => E,
+                               Link => No_Tree_Id,
+                               State => No_State));
+               Detert.Table (E).Child (V (I)) := Detert.Last;
+               E := Detert.Last;
+               Added := True;
+            else
+               E := Detert.Table (E).Child (V (I));
+               Added := False;
+            end if;
+         end loop;
+         if Added then
+            --  Create the new state.
+            Res := Add_State (N);
+            Detert.Table (E).State := Res;
+
+            if Flag_Trace then
+               Set_State_Label (Res, Last_Label);
+               Put ("Result state" & Int32'Image (Last_Label) & " for");
+               for I in V'Range loop
+                  if V (I) then
+                     Put (Natural'Image (I));
+                  end if;
+               end loop;
+               New_Line;
+               Last_Label := Last_Label + 1;
+            end if;
+
+            --  Put it to the list of states to be handled.
+            Detert.Table (E).Link := Deter_Head;
+            Deter_Head := E;
+
+            return Res;
+         else
+            return Detert.Table (E).State;
+         end if;
+      end Add_Vector;
+
+      --  Return true iff the stack is empty (ie all the states have been
+      --  handled).
+      function Stack_Empty return Boolean is
+      begin
+         return Deter_Head = No_Tree_Id;
+      end Stack_Empty;
+
+      --  Get an element from the stack.
+      --  Extract the state in the result NFA.
+      --  Rebuild the set of states in N (ie rebuild the vector of states).
+      procedure Stack_Pop (V : out Bool_Vector; S : out NFA_State)
+      is
+         L, P : Deter_Tree_Id;
+      begin
+         L := Deter_Head;
+         pragma Assert (L /= No_Tree_Id);
+         S := Detert.Table (L).State;
+         Deter_Head := Detert.Table (L).Link;
+
+         for I in reverse V'Range loop
+            pragma Assert (L /= Start_Tree_Id);
+            P := Detert.Table (L).Parent;
+            if L = Detert.Table (P).Child (True) then
+               V (I) := True;
+            elsif L = Detert.Table (P).Child (False) then
+               V (I) := False;
+            else
+               raise Program_Error;
+            end if;
+            L := P;
+         end loop;
+         pragma Assert (L = Start_Tree_Id);
+      end Stack_Pop;
+
+      type State_Vector is array (Natural range <>) of Natural;
+      type Expr_Vector is array (Natural range <>) of Node;
+
+      procedure Build_Arcs (N : NFA;
+                            State : NFA_State;
+                            States : State_Vector;
+                            Exprs : Expr_Vector;
+                            Expr : Node;
+                            V : Bool_Vector)
+      is
+      begin
+         if Expr = False_Node then
+            return;
+         end if;
+
+         if States'Length = 0 then
+            declare
+               Reduced_Expr : constant Node := PSL.QM.Reduce (Expr);
+               --Reduced_Expr : constant Node := Expr;
+               S : NFA_State;
+            begin
+               if Reduced_Expr = False_Node then
+                  return;
+               end if;
+               S := Add_Vector (V, N);
+               Add_Edge (State, S, Reduced_Expr);
+               if Flag_Trace then
+                  Put (" Add edge");
+                  Put (Int32'Image (Get_State_Label (State)));
+                  Put (" to");
+                  Put (Int32'Image (Get_State_Label (S)));
+                  Put (", expr=");
+                  Dump_Expr (Expr);
+                  Put (", reduced=");
+                  Dump_Expr (Reduced_Expr);
+                  New_Line;
+               end if;
+            end;
+         else
+            declare
+               N_States : State_Vector renames
+                 States (States'First + 1 .. States'Last);
+               N_V : Bool_Vector (V'Range) := V;
+               S : constant Natural := States (States'First);
+               E : constant Node := Exprs (S);
+            begin
+               N_V (S) := True;
+               if Expr = Null_Node then
+                  Build_Arcs (N, State, N_States, Exprs, E, N_V);
+                  Build_Arcs (N, State, N_States, Exprs,
+                              Build_Bool_Not (E), V);
+               else
+                  Build_Arcs (N, State, N_States, Exprs,
+                              Build_Bool_And (E, Expr), N_V);
+                  Build_Arcs (N, State, N_States, Exprs,
+                              Build_Bool_And (Build_Bool_Not (E), Expr), V);
+               end if;
+            end;
+         end if;
+      end Build_Arcs;
+
+      function Determinize_1 (N : NFA; Nbr_States : Natural) return NFA
+      is
+         Final : Natural;
+         V : Bool_Vector (0 .. Nbr_States - 1);
+         Exprs : Expr_Vector (0 .. Nbr_States - 1);
+         S : NFA_State;
+         E : NFA_Edge;
+         D : Natural;
+         Edge_Expr : Node;
+         Expr : Node;
+         Nbr_Dest : Natural;
+         States : State_Vector (0 .. Nbr_States - 1);
+         Res : NFA;
+         State : NFA_State;
+      begin
+         Final := Natural (Get_State_Label (Get_Final_State (N)));
+
+         -- FIXME: handle epsilon or final = start -> create an empty NFA.
+
+         --  Initialize the tree.
+         Res := Create_NFA;
+         Detert.Init;
+         Detert.Append ((Child => (No_Tree_Id, No_Tree_Id),
+                         Parent => No_Tree_Id,
+                         Link => No_Tree_Id,
+                         State => No_State));
+         pragma Assert (Detert.Last = Start_Tree_Id);
+         Deter_Head := No_Tree_Id;
+
+         --  Put the initial state in the tree and in the stack.
+         --  FIXME: ok, we know that its label is 0.
+         V := (0 => True, others => False);
+         State := Add_Vector (V, Res);
+         Set_Start_State (Res, State);
+
+         --  The failure state.  As there is nothing to do with this
+         --  state, remove it from the stack.
+         V := (others => False);
+         State := Add_Vector (V, Res);
+         Set_Final_State (Res, State);
+         Stack_Pop (V, State);
+
+         --  Iterate on states in the result NFA that haven't yet been handled.
+         while not Stack_Empty loop
+            Stack_Pop (V, State);
+
+            if Flag_Trace then
+               Put_Line ("Handle result state"
+                           & Int32'Image (Get_State_Label (State)));
+            end if;
+
+            --  Build edges vector.
+            Exprs := (others => Null_Node);
+            Expr := Null_Node;
+
+            S := Get_First_State (N);
+            Nbr_Dest := 0;
+            while S /= No_State loop
+               if V (Natural (Get_State_Label (S))) then
+                  E := Get_First_Src_Edge (S);
+                  while E /= No_Edge loop
+                     D := Natural (Get_State_Label (Get_Edge_Dest (E)));
+                     Edge_Expr := Get_Edge_Expr (E);
+
+                     if False and Flag_Trace then
+                        Put_Line ("  edge" & Int32'Image (Get_State_Label (S))
+                                    & " to" & Natural'Image (D));
+                     end if;
+
+                     if D = Final then
+                        Edge_Expr := Build_Bool_Not (Edge_Expr);
+                        if Expr = Null_Node then
+                           Expr := Edge_Expr;
+                        else
+                           Expr := Build_Bool_And (Expr, Edge_Expr);
+                        end if;
+                     else
+                        if Exprs (D) = Null_Node then
+                           Exprs (D) := Edge_Expr;
+                           States (Nbr_Dest) := D;
+                           Nbr_Dest := Nbr_Dest + 1;
+                        else
+                           Exprs (D) := Build_Bool_Or (Exprs (D),
+                                                       Edge_Expr);
+                        end if;
+                     end if;
+                     E := Get_Next_Src_Edge (E);
+                  end loop;
+               end if;
+               S := Get_Next_State (S);
+            end loop;
+
+            if Flag_Trace then
+               Put (" Final: expr=");
+               Print_Expr (Expr);
+               New_Line;
+               for I in 0 .. Nbr_Dest - 1 loop
+                  Put ("   Dest");
+                  Put (Natural'Image (States (I)));
+                  Put (" expr=");
+                  Print_Expr (Exprs (States (I)));
+                  New_Line;
+               end loop;
+            end if;
+
+            --  Build arcs.
+            if not (Nbr_Dest = 0 and Expr = Null_Node) then
+               Build_Arcs (Res, State,
+                           States (0 .. Nbr_Dest - 1), Exprs, Expr,
+                           Bool_Vector'(0 .. Nbr_States - 1 => False));
+            end if;
+         end loop;
+
+         --Remove_Unreachable_States (Res);
+         return Res;
+      end Determinize_1;
+
+      function Determinize (N : NFA) return NFA
+      is
+         Nbr_States : Natural;
+      begin
+         Labelize_States (N, Nbr_States);
+
+         if Flag_Trace then
+            Put_Line ("NFA to determinize:");
+            Disp_NFA (N);
+            Last_Label := 0;
+         end if;
+
+         return Determinize_1 (N, Nbr_States);
+      end Determinize;
+   end Determinize;
+
+   function Build_Initial_Rep (N : NFA) return NFA
+   is
+      S : constant NFA_State := Get_Start_State (N);
+   begin
+      Add_Edge (S, S, True_Node);
+      return N;
+   end Build_Initial_Rep;
+
+   procedure Build_Strong (N : NFA)
+   is
+      S : NFA_State;
+      Final : constant NFA_State := Get_Final_State (N);
+   begin
+      S := Get_First_State (N);
+      while S /= No_State loop
+         --  FIXME.
+         if S /= Final then
+            Add_Edge (S, Final, EOS_Node);
+         end if;
+         S := Get_Next_State (S);
+      end loop;
+   end Build_Strong;
+
+   procedure Build_Abort (N : NFA; Expr : Node)
+   is
+      S : NFA_State;
+      E : NFA_Edge;
+      Not_Expr : Node;
+   begin
+      Not_Expr := Build_Bool_Not (Expr);
+      S := Get_First_State (N);
+      while S /= No_State loop
+         E := Get_First_Src_Edge (S);
+         while E /= No_Edge loop
+            Set_Edge_Expr (E, Build_Bool_And (Not_Expr, Get_Edge_Expr (E)));
+            E := Get_Next_Src_Edge (E);
+         end loop;
+         S := Get_Next_State (S);
+      end loop;
+   end Build_Abort;
+
+   function Build_Property_FA (N : Node) return NFA
+   is
+      L, R : NFA;
+   begin
+      case Get_Kind (N) is
+         when N_Sequences
+           | N_Booleans =>
+            --  Build A(S) or A(B)
+            R := Build_SERE_FA (N);
+            return Determinize.Determinize (R);
+         when N_Strong =>
+            R := Build_Property_FA (Get_Property (N));
+            Build_Strong (R);
+            return R;
+         when N_Imp_Seq =>
+            --  R |=> P  -->  {R; TRUE} |-> P
+            L := Build_SERE_FA (Get_Sequence (N));
+            R := Build_Property_FA (Get_Property (N));
+            return Build_Concat (L, R);
+         when N_Overlap_Imp_Seq =>
+            --  S |-> P  is defined as Ac(S) : A(P)
+            L := Build_SERE_FA (Get_Sequence (N));
+            R := Build_Property_FA (Get_Property (N));
+            return Build_Fusion (L, R);
+         when N_Log_Imp_Prop =>
+            --  B -> P  -->  {B} |-> P  -->  Ac(B) : A(P)
+            L := Build_SERE_FA (Get_Left (N));
+            R := Build_Property_FA (Get_Right (N));
+            return Build_Fusion (L, R);
+         when N_And_Prop =>
+            --  P1 && P2  -->  A(P1) | A(P2)
+            L := Build_Property_FA (Get_Left (N));
+            R := Build_Property_FA (Get_Right (N));
+            return Build_Or (L, R);
+         when N_Never =>
+            R := Build_SERE_FA (Get_Property (N));
+            return Build_Initial_Rep (R);
+         when N_Always =>
+            R := Build_Property_FA (Get_Property (N));
+            return Build_Initial_Rep (R);
+         when N_Abort =>
+            R := Build_Property_FA (Get_Property (N));
+            Build_Abort (R, Get_Boolean (N));
+            return R;
+         when N_Property_Instance =>
+            declare
+               Decl : Node;
+            begin
+               Decl := Get_Declaration (N);
+               Assoc_Instance (Decl, N);
+               R := Build_Property_FA (Get_Property (Decl));
+               Unassoc_Instance (Decl);
+               return R;
+            end;
+         when others =>
+            Error_Kind ("build_property_fa", N);
+      end case;
+   end Build_Property_FA;
+
+   function Build_FA (N : Node) return NFA
+   is
+      use PSL.NFAs.Utils;
+      Res : NFA;
+   begin
+      Res := Build_Property_FA (N);
+      if Optimize_Final then
+         pragma Debug (Check_NFA (Res));
+
+         Remove_Unreachable_States (Res);
+         Remove_Simple_Prefix (Res);
+         Merge_Identical_States (Res);
+         Merge_Edges (Res);
+      end if;
+      --  Clear the QM table.
+      PSL.QM.Reset;
+      return Res;
+   end Build_FA;
+end PSL.Build;
diff --git a/src/psl/psl-build.ads b/src/psl/psl-build.ads
new file mode 100644
index 000000000..d0ca26a39
--- /dev/null
+++ b/src/psl/psl-build.ads
@@ -0,0 +1,7 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Build is
+   Optimize_Final : Boolean := True;
+
+   function Build_FA (N : Node) return NFA;
+end PSL.Build;
diff --git a/src/psl/psl-cse.adb b/src/psl/psl-cse.adb
new file mode 100644
index 000000000..5d6f3df13
--- /dev/null
+++ b/src/psl/psl-cse.adb
@@ -0,0 +1,201 @@
+with Ada.Text_IO;
+with PSL.Prints;
+with Types; use Types;
+
+package body PSL.CSE is
+   function Is_X_And_Not_X (A, B : Node) return Boolean is
+   begin
+      return (Get_Kind (A) = N_Not_Bool
+                and then Get_Boolean (A) = B)
+        or else (Get_Kind (B) = N_Not_Bool
+                   and then Get_Boolean (B) = A);
+   end Is_X_And_Not_X;
+
+   type Hash_Table_Type is array (Uns32 range 0 .. 128) of Node;
+   Hash_Table : Hash_Table_Type := (others => Null_Node);
+
+   function Compute_Hash (L, R : Node; Op : Uns32) return Uns32
+   is
+   begin
+      return Shift_Left (Get_Hash (L), 12)
+        xor Shift_Left (Get_Hash (R), 2)
+        xor Op;
+   end Compute_Hash;
+
+   function Compute_Hash (L: Node; Op : Uns32) return Uns32
+   is
+   begin
+      return Shift_Left (Get_Hash (L), 2) xor Op;
+   end Compute_Hash;
+
+   procedure Dump_Hash_Table (Level : Natural := 0)
+   is
+      use Ada.Text_IO;
+      Cnt : Natural;
+      Total : Natural;
+      N : Node;
+   begin
+      Total := 0;
+      for I in Hash_Table_Type'Range loop
+         Cnt := 0;
+         N := Hash_Table (I);
+         while N /= Null_Node loop
+            Cnt := Cnt + 1;
+            N := Get_Hash_Link (N);
+         end loop;
+         Put_Line ("Hash_table(" & Uns32'Image (I)
+                     & "):" & Natural'Image (Cnt));
+         Total := Total + Cnt;
+         if Level > 0 then
+            Cnt := 0;
+            N := Hash_Table (I);
+            while N /= Null_Node loop
+               Put (Uns32'Image (Get_Hash (N)));
+               if Level > 1 then
+                  Put (": ");
+                  PSL.Prints.Dump_Expr (N);
+                  New_Line;
+               end if;
+               Cnt := Cnt + 1;
+               N := Get_Hash_Link (N);
+            end loop;
+            if Level = 1 and then Cnt > 0 then
+               New_Line;
+            end if;
+         end if;
+      end loop;
+      Put_Line ("Total:" & Natural'Image (Total));
+   end Dump_Hash_Table;
+
+   function Build_Bool_And (L, R : Node) return Node
+   is
+      R1 : Node;
+      Res : Node;
+      Hash : Uns32;
+      Head, H : Node;
+   begin
+      if L = True_Node then
+         return R;
+      elsif R = True_Node then
+         return L;
+      elsif L = False_Node or else R = False_Node then
+         return False_Node;
+      elsif L = R then
+         return L;
+      elsif Is_X_And_Not_X (L, R) then
+         return False_Node;
+      end if;
+
+      --  More simple optimizations.
+      if Get_Kind (R) = N_And_Bool then
+         R1 := Get_Left (R);
+         if L = R1 then
+            return R;
+         elsif Is_X_And_Not_X (L, R1) then
+            return False_Node;
+         end if;
+      end if;
+
+      Hash := Compute_Hash (L, R, 2);
+      Head := Hash_Table (Hash mod Hash_Table'Length);
+      H := Head;
+      while H /= Null_Node loop
+         if Get_Hash (H) = Hash
+           and then Get_Kind (H) = N_And_Bool
+           and then Get_Left (H) = L
+           and then Get_Right (H) = R
+         then
+            return H;
+         end if;
+         H := Get_Hash_Link (H);
+      end loop;
+
+      Res := Create_Node (N_And_Bool);
+      Set_Left (Res, L);
+      Set_Right (Res, R);
+      Set_Hash_Link (Res, Head);
+      Set_Hash (Res, Hash);
+      Hash_Table (Hash mod Hash_Table'Length) := Res;
+      return Res;
+   end Build_Bool_And;
+
+   function Build_Bool_Or (L, R : Node) return Node
+   is
+      Res : Node;
+      Hash : Uns32;
+      Head, H : Node;
+   begin
+      if L = True_Node then
+         return L;
+      elsif R = True_Node then
+         return R;
+      elsif L = False_Node then
+         return R;
+      elsif R = False_Node then
+         return L;
+      elsif L = R then
+         return L;
+      elsif Is_X_And_Not_X (L, R) then
+         return True_Node;
+      end if;
+
+      Hash := Compute_Hash (L, R, 3);
+      Head := Hash_Table (Hash mod Hash_Table'Length);
+      H := Head;
+      while H /= Null_Node loop
+         if Get_Hash (H) = Hash
+           and then Get_Kind (H) = N_Or_Bool
+           and then Get_Left (H) = L
+           and then Get_Right (H) = R
+         then
+            return H;
+         end if;
+         H := Get_Hash_Link (H);
+      end loop;
+
+      Res := Create_Node (N_Or_Bool);
+      Set_Left (Res, L);
+      Set_Right (Res, R);
+      Set_Hash_Link (Res, Head);
+      Set_Hash (Res, Hash);
+      Hash_Table (Hash mod Hash_Table'Length) := Res;
+      return Res;
+   end Build_Bool_Or;
+
+   function Build_Bool_Not (N : Node) return Node is
+      Res : Node;
+      Hash : Uns32;
+      Head : Node;
+      H : Node;
+   begin
+      if N = True_Node then
+         return False_Node;
+      elsif N = False_Node then
+         return True_Node;
+      elsif Get_Kind (N) = N_Not_Bool then
+         return Get_Boolean (N);
+      end if;
+
+      --  Find in hash table.
+      Hash := Compute_Hash (N, 1);
+      Head := Hash_Table (Hash mod Hash_Table'Length);
+      H := Head;
+      while H /= Null_Node loop
+         if Get_Hash (H) = Hash
+           and then Get_Kind (H) = N_Not_Bool
+           and then Get_Boolean (H) = N
+         then
+            return H;
+         end if;
+         H := Get_Hash_Link (H);
+      end loop;
+
+      Res := Create_Node (N_Not_Bool);
+      Set_Boolean (Res, N);
+      Set_Hash_Link (Res, Head);
+      Set_Hash (Res, Hash);
+      Hash_Table (Hash mod Hash_Table'Length) := Res;
+
+      return Res;
+   end Build_Bool_Not;
+end PSL.CSE;
diff --git a/src/psl/psl-cse.ads b/src/psl/psl-cse.ads
new file mode 100644
index 000000000..e40b0eeb2
--- /dev/null
+++ b/src/psl/psl-cse.ads
@@ -0,0 +1,10 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.CSE is
+   --  Build boolean expressions while trying to make the node uniq.
+   function Build_Bool_And (L, R : Node) return Node;
+   function Build_Bool_Or (L, R : Node) return Node;
+   function Build_Bool_Not (N : Node) return Node;
+
+   procedure Dump_Hash_Table (Level : Natural := 0);
+end PSL.CSE;
diff --git a/src/psl/psl-disp_nfas.adb b/src/psl/psl-disp_nfas.adb
new file mode 100644
index 000000000..c8f1532b9
--- /dev/null
+++ b/src/psl/psl-disp_nfas.adb
@@ -0,0 +1,111 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with Types; use Types;
+with PSL.Prints; use PSL.Prints;
+
+package body PSL.Disp_NFAs is
+   procedure Disp_State (S : NFA_State) is
+      Str : constant String := Int32'Image (Get_State_Label (S));
+   begin
+      Put (Str (2 .. Str'Last));
+   end Disp_State;
+
+   procedure Disp_Head (Name : String) is
+   begin
+      Put ("digraph ");
+      Put (Name);
+      Put_Line (" {");
+      Put_Line ("  rankdir=LR;");
+   end Disp_Head;
+
+   procedure Disp_Tail is
+   begin
+      Put_Line ("}");
+   end Disp_Tail;
+
+   procedure Disp_Body (N : NFA) is
+      S, F : NFA_State;
+      T : NFA_Edge;
+   begin
+      S := Get_Start_State (N);
+      F := Get_Final_State (N);
+      if S /= No_State then
+         if S = F then
+            Put ("  node [shape = doublecircle, style = bold];");
+         else
+            Put ("  node [shape = circle, style = bold];");
+         end if;
+         Put (" /* Start: */ ");
+         Disp_State (S);
+         Put_Line (";");
+      end if;
+      if F /= No_State and then F /= S then
+         Put ("  node [shape = doublecircle, style = solid];");
+         Put (" /* Final: */ ");
+         Disp_State (F);
+         Put_Line (";");
+      end if;
+      Put_Line ("  node [shape = circle, style = solid];");
+
+      if Get_Epsilon_NFA (N) then
+         Put ("  ");
+         Disp_State (Get_Start_State (N));
+         Put (" -> ");
+         Disp_State (Get_Final_State (N));
+         Put_Line (" [ label = ""*""]");
+      end if;
+
+      S := Get_First_State (N);
+      while S /= No_State loop
+         T := Get_First_Src_Edge (S);
+         if T = No_Edge then
+            if Get_First_Dest_Edge (S) = No_Edge then
+               Put ("  ");
+               Disp_State (S);
+               Put_Line (";");
+            end if;
+         else
+            loop
+               Put ("  ");
+               Disp_State (S);
+               Put (" -> ");
+               Disp_State (Get_Edge_Dest (T));
+               Put (" [ label = """);
+               Print_Expr (Get_Edge_Expr (T));
+               Put ('"');
+               if True then
+                  Put (" /* Node =");
+                  Put (Node'Image (Get_Edge_Expr (T)));
+                  Put (" */");
+               end if;
+               if True then
+                  Put (" /* Edge =");
+                  Put (NFA_Edge'Image (T));
+                  Put (" */");
+               end if;
+               Put_Line (" ];");
+
+               T := Get_Next_Src_Edge (T);
+               exit when T = No_Edge;
+            end loop;
+         end if;
+         S := Get_Next_State (S);
+      end loop;
+   end Disp_Body;
+
+   procedure Disp_NFA (N : NFA; Name : String := "nfa") is
+   begin
+      Disp_Head (Name);
+      Disp_Body (N);
+      Disp_Tail;
+   end Disp_NFA;
+
+   procedure Debug_NFA (N : NFA) is
+   begin
+      Labelize_States_Debug (N);
+      Disp_Head ("nfa");
+      Disp_Body (N);
+      Disp_Tail;
+   end Debug_NFA;
+
+   pragma Unreferenced (Debug_NFA);
+end PSL.Disp_NFAs;
diff --git a/src/psl/psl-disp_nfas.ads b/src/psl/psl-disp_nfas.ads
new file mode 100644
index 000000000..901eed72f
--- /dev/null
+++ b/src/psl/psl-disp_nfas.ads
@@ -0,0 +1,12 @@
+with PSL.NFAs; use PSL.NFAs;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Disp_NFAs is
+   procedure Disp_Head (Name : String);
+   procedure Disp_Tail;
+   procedure Disp_Body (N : NFA);
+
+   procedure Disp_State (S : NFA_State);
+
+   procedure Disp_NFA (N : NFA; Name : String := "nfa");
+end PSL.Disp_NFAs;
diff --git a/src/psl/psl-dump_tree.adb b/src/psl/psl-dump_tree.adb
new file mode 100644
index 000000000..db636dbb0
--- /dev/null
+++ b/src/psl/psl-dump_tree.adb
@@ -0,0 +1,867 @@
+--  This is in fact -*- Ada -*-
+with Ada.Text_IO; use Ada.Text_IO;
+with Types; use Types;
+with Name_Table;
+with PSL.Errors;
+
+package body PSL.Dump_Tree is
+
+   procedure Disp_Indent (Indent : Natural) is
+   begin
+      Put (String'(1 .. 2 * Indent => ' '));
+   end Disp_Indent;
+
+   Hex_Digits : constant array (Integer range 0 .. 15) of Character
+     := "0123456789abcdef";
+
+   procedure Disp_Uns32 (Val : Uns32)
+   is
+      Res : String (1 .. 8);
+      V : Uns32 := Val;
+   begin
+      for I in reverse Res'Range loop
+         Res (I) := Hex_Digits (Integer (V mod 16));
+         V := V / 16;
+      end loop;
+      Put (Res);
+   end Disp_Uns32;
+
+   procedure Disp_Int32 (Val : Int32)
+   is
+      Res : String (1 .. 8);
+      V : Int32 := Val;
+   begin
+      for I in reverse Res'Range loop
+         Res (I) := Hex_Digits (Integer (V mod 16));
+         V := V / 16;
+      end loop;
+      Put (Res);
+   end Disp_Int32;
+
+   procedure Disp_HDL_Node (Val : HDL_Node)
+   is
+   begin
+      if Dump_Hdl_Node /= null then
+         Dump_Hdl_Node.all (Val);
+      else
+         Disp_Int32 (Val);
+      end if;
+   end Disp_HDL_Node;
+
+   procedure Disp_Node_Number (N : Node) is
+   begin
+      Put ('[');
+      Disp_Int32 (Int32 (N));
+      Put (']');
+   end Disp_Node_Number;
+
+   procedure Disp_NFA (Val : NFA) is
+   begin
+      Disp_Int32 (Int32 (Val));
+   end Disp_NFA;
+
+   procedure Disp_Header (Msg : String; Indent : Natural) is
+   begin
+      Disp_Indent (Indent);
+      Put (Msg);
+      Put (": ");
+   end Disp_Header;
+
+   procedure Disp_Identifier (N : Node) is
+   begin
+      Put (Name_Table.Image (Get_Identifier (N)));
+      New_Line;
+   end Disp_Identifier;
+
+   procedure Disp_Label (N : Node) is
+   begin
+      Put (Name_Table.Image (Get_Label (N)));
+      New_Line;
+   end Disp_Label;
+
+   procedure Disp_Boolean (Val : Boolean) is
+   begin
+      if Val then
+         Put ("true");
+      else
+         Put ("false");
+      end if;
+   end Disp_Boolean;
+
+   procedure Disp_PSL_Presence_Kind (Pres : PSL_Presence_Kind) is
+   begin
+      case Pres is
+         when Present_Pos =>
+            Put ('+');
+         when Present_Neg =>
+            Put ('-');
+         when Present_Unknown =>
+            Put ('?');
+      end case;
+   end Disp_PSL_Presence_Kind;
+
+   procedure Disp_Location (Loc : Location_Type) is
+   begin
+      Put (PSL.Errors.Get_Location_Str (Loc));
+   end Disp_Location;
+
+--     procedure Disp_String_Id (N : Node) is
+--     begin
+--        Put ('"');
+--        Put (Str_Table.Image (Get_String_Id (N)));
+--        Put ('"');
+--        New_Line;
+--     end Disp_String_Id;
+
+   --  Subprograms.
+   procedure Disp_Tree (N : Node; Indent : Natural; Full : boolean := False) is
+   begin
+      Disp_Indent (Indent);
+      Disp_Node_Number (N);
+      Put (": ");
+      if N = Null_Node then
+         Put_Line ("*NULL*");
+         return;
+      end if;
+      Put_Line (Nkind'Image (Get_Kind (N)));
+      Disp_Indent (Indent);
+      Put ("loc: ");
+      Disp_Location (Get_Location (N));
+      New_Line;
+      case Get_Kind (N) is
+         when N_Error =>
+            if not Full then
+               return;
+            end if;
+            null;
+         when N_Vmode =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Instance", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Instance (N), Indent + 1, Full);
+            Disp_Header ("Item_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Item_Chain (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Vunit =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Instance", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Instance (N), Indent + 1, Full);
+            Disp_Header ("Item_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Item_Chain (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Vprop =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Instance", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Instance (N), Indent + 1, Full);
+            Disp_Header ("Item_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Item_Chain (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Hdl_Mod_Name =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Prefix", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Prefix (N), Indent + 1, Full);
+            null;
+         when N_Assert_Directive =>
+            Disp_Header ("Label", Indent + 1);
+            Disp_Label (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("String", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_String (N), Indent + 1, Full);
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("NFA", Indent + 1);
+            Disp_NFA (Get_NFA (N));
+            New_Line;
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Property_Declaration =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Global_Clock", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Global_Clock (N), Indent + 1, Full);
+            Disp_Header ("Parameter_List", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Parameter_List (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Sequence_Declaration =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Parameter_List", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Parameter_List (N), Indent + 1, Full);
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Endpoint_Declaration =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Parameter_List", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Parameter_List (N), Indent + 1, Full);
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Const_Parameter =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Actual", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Actual (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Boolean_Parameter =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Actual", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Actual (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Property_Parameter =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Actual", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Actual (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Sequence_Parameter =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Actual", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Actual (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Sequence_Instance =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Declaration", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Declaration (N), Indent + 1, False);
+            Disp_Header ("Association_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Association_Chain (N), Indent + 1, Full);
+            null;
+         when N_Endpoint_Instance =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Declaration", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Declaration (N), Indent + 1, False);
+            Disp_Header ("Association_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Association_Chain (N), Indent + 1, Full);
+            null;
+         when N_Property_Instance =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Declaration", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Declaration (N), Indent + 1, False);
+            Disp_Header ("Association_Chain", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Association_Chain (N), Indent + 1, Full);
+            null;
+         when N_Actual =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Actual", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Actual (N), Indent + 1, Full);
+            Disp_Header ("Formal", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Formal (N), Indent + 1, Full);
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Clock_Event =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            null;
+         when N_Always =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            null;
+         when N_Never =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            null;
+         when N_Eventually =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            null;
+         when N_Strong =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            null;
+         when N_Imp_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            null;
+         when N_Overlap_Imp_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            null;
+         when N_Log_Imp_Prop =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Next =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Number", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Number (N), Indent + 1, Full);
+            null;
+         when N_Next_A =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Next_E =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Next_Event =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Number", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Number (N), Indent + 1, Full);
+            null;
+         when N_Next_Event_A =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Next_Event_E =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Abort =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Property", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Property (N), Indent + 1, Full);
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            null;
+         when N_Until =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            Disp_Header ("Inclusive_Flag", Indent + 1);
+            Disp_Boolean (Get_Inclusive_Flag (N));
+            New_Line;
+            null;
+         when N_Before =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Strong_Flag", Indent + 1);
+            Disp_Boolean (Get_Strong_Flag (N));
+            New_Line;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            Disp_Header ("Inclusive_Flag", Indent + 1);
+            Disp_Boolean (Get_Inclusive_Flag (N));
+            New_Line;
+            null;
+         when N_Or_Prop =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_And_Prop =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Braced_SERE =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("SERE", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_SERE (N), Indent + 1, Full);
+            null;
+         when N_Concat_SERE =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Fusion_SERE =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Within_SERE =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Match_And_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_And_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Or_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            null;
+         when N_Star_Repeat_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Goto_Repeat_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Plus_Repeat_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            null;
+         when N_Equal_Repeat_Seq =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Sequence", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Sequence (N), Indent + 1, Full);
+            Disp_Header ("Low_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Low_Bound (N), Indent + 1, Full);
+            Disp_Header ("High_Bound", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_High_Bound (N), Indent + 1, Full);
+            null;
+         when N_Not_Bool =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Boolean", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Boolean (N), Indent + 1, Full);
+            Disp_Header ("Presence", Indent + 1);
+            Disp_PSL_Presence_Kind (Get_Presence (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_And_Bool =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            Disp_Header ("Presence", Indent + 1);
+            Disp_PSL_Presence_Kind (Get_Presence (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_Or_Bool =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            Disp_Header ("Presence", Indent + 1);
+            Disp_PSL_Presence_Kind (Get_Presence (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_Imp_Bool =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Left", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Left (N), Indent + 1, Full);
+            Disp_Header ("Right", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Right (N), Indent + 1, Full);
+            Disp_Header ("Presence", Indent + 1);
+            Disp_PSL_Presence_Kind (Get_Presence (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_HDL_Expr =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Presence", Indent + 1);
+            Disp_PSL_Presence_Kind (Get_Presence (N));
+            New_Line;
+            Disp_Header ("HDL_Node", Indent + 1);
+            Disp_HDL_Node (Get_HDL_Node (N));
+            New_Line;
+            Disp_Header ("HDL_Index", Indent + 1);
+            Disp_Int32 (Get_HDL_Index (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_False =>
+            if not Full then
+               return;
+            end if;
+            null;
+         when N_True =>
+            if not Full then
+               return;
+            end if;
+            null;
+         when N_EOS =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("HDL_Index", Indent + 1);
+            Disp_Int32 (Get_HDL_Index (N));
+            New_Line;
+            Disp_Header ("Hash", Indent + 1);
+            Disp_Uns32 (Get_Hash (N));
+            New_Line;
+            Disp_Header ("Hash_Link", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Hash_Link (N), Indent + 1, Full);
+            null;
+         when N_Name =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Decl", Indent + 1);
+            New_Line;
+            Disp_Tree (Get_Decl (N), Indent + 1, Full);
+            null;
+         when N_Name_Decl =>
+            Disp_Header ("Identifier", Indent + 1);
+            Disp_Identifier (N);
+            if not Full then
+               return;
+            end if;
+            Disp_Tree (Get_Chain (N), Indent, Full);
+            null;
+         when N_Number =>
+            if not Full then
+               return;
+            end if;
+            Disp_Header ("Value", Indent + 1);
+            Disp_Uns32 (Get_Value (N));
+            New_Line;
+            null;
+      end case;
+   end Disp_Tree;
+
+   procedure Dump_Tree (N : Node; Full : Boolean := False) is
+   begin
+      Disp_Tree (N, 0, Full);
+   end Dump_Tree;
+
+end PSL.Dump_Tree;
diff --git a/src/psl/psl-dump_tree.ads b/src/psl/psl-dump_tree.ads
new file mode 100644
index 000000000..f8b2eb3ab
--- /dev/null
+++ b/src/psl/psl-dump_tree.ads
@@ -0,0 +1,9 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Dump_Tree is
+   procedure Dump_Tree (N : Node; Full : Boolean := False);
+
+   --  Procedure to dump an HDL node.
+   type Dump_Hdl_Node_Acc is access procedure (N : HDL_Node);
+   Dump_Hdl_Node : Dump_Hdl_Node_Acc := null;
+end PSL.Dump_Tree;
diff --git a/src/psl/psl-hash.adb b/src/psl/psl-hash.adb
new file mode 100644
index 000000000..62744b336
--- /dev/null
+++ b/src/psl/psl-hash.adb
@@ -0,0 +1,60 @@
+with GNAT.Table;
+
+package body PSL.Hash is
+
+   type Index_Type is new Natural;
+   No_Index : constant Index_Type := 0;
+
+   type Cell_Record is record
+      Res : Node;
+      Next : Index_Type;
+   end record;
+
+   Hash_Size : constant Index_Type := 127;
+
+   package Cells is new GNAT.Table
+     (Table_Component_Type => Cell_Record,
+      Table_Index_Type => Index_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 256,
+      Table_Increment => 100);
+
+   procedure Init is
+   begin
+      Cells.Set_Last (Hash_Size - 1);
+      for I in 0 .. Hash_Size - 1 loop
+         Cells.Table (I) := (Res => Null_Node, Next => No_Index);
+      end loop;
+   end Init;
+
+   function Get_PSL_Node (Hdl : Int32) return Node is
+      Idx : Index_Type := Index_Type (Hdl mod Int32 (Hash_Size));
+      N_Idx : Index_Type;
+      Res : Node;
+   begin
+      --  In the primary table.
+      Res := Cells.Table (Idx).Res;
+      if Res = Null_Node then
+         Res := Create_Node (N_HDL_Expr);
+         Set_HDL_Node (Res, Hdl);
+         Cells.Table (Idx).Res := Res;
+         return Res;
+      end if;
+
+      loop
+         if Get_HDL_Node (Res) = Hdl then
+            return Res;
+         end if;
+         --  Look in collisions chain
+         N_Idx := Cells.Table (Idx).Next;
+         exit when N_Idx = No_Index;
+         Idx := N_Idx;
+         Res := Cells.Table (Idx).Res;
+      end loop;
+      Res := Create_Node (N_HDL_Expr);
+      Set_HDL_Node (Res, Hdl);
+      Cells.Append ((Res => Res, Next => No_Index));
+      Cells.Table (Idx).Next := Cells.Last;
+      return Res;
+   end Get_PSL_Node;
+end PSL.Hash;
diff --git a/src/psl/psl-hash.ads b/src/psl/psl-hash.ads
new file mode 100644
index 000000000..d1a60c971
--- /dev/null
+++ b/src/psl/psl-hash.ads
@@ -0,0 +1,11 @@
+with Types; use Types;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Hash is
+   --  Initialize the package.
+   procedure Init;
+
+   --  Get the PSL node for node HDL.
+   --  Only one PSL node is created for an HDL node.
+   function Get_PSL_Node (Hdl : Int32) return Node;
+end PSL.Hash;
diff --git a/src/psl/psl-nfas-utils.adb b/src/psl/psl-nfas-utils.adb
new file mode 100644
index 000000000..06601850d
--- /dev/null
+++ b/src/psl/psl-nfas-utils.adb
@@ -0,0 +1,330 @@
+with PSL.Errors; use PSL.Errors;
+
+package body PSL.NFAs.Utils is
+   generic
+      with function Get_First_Edge (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge (E : NFA_Edge) return NFA_Edge;
+      with procedure Set_First_Edge (S : NFA_State; E : NFA_Edge);
+      with procedure Set_Next_Edge (E : NFA_Edge; N_E : NFA_Edge);
+      with function Get_Edge_State (E : NFA_Edge) return NFA_State;
+   package Sort_Edges is
+      procedure Sort_Edges (S : NFA_State);
+      procedure Sort_Edges (N : NFA);
+   end Sort_Edges;
+
+   package body Sort_Edges is
+      --  Use merge sort to sort a list of edges.
+      --  The first edge is START and the list has LEN edges.
+      --  RES is the head of the sorted list.
+      --  NEXT_EDGE is the LEN + 1 edge (not sorted).
+      procedure Edges_Merge_Sort (Start : NFA_Edge;
+                                  Len : Natural;
+                                  Res : out NFA_Edge;
+                                  Next_Edge : out NFA_Edge)
+      is
+         function Lt (L, R : NFA_Edge) return Boolean
+         is
+            L_Expr : constant Node := Get_Edge_Expr (L);
+            R_Expr : constant Node := Get_Edge_Expr (R);
+         begin
+            return L_Expr < R_Expr
+              or else (L_Expr = R_Expr
+                         and then Get_Edge_State (L) < Get_Edge_State (R));
+         end Lt;
+
+         pragma Inline (Lt);
+
+         Half : constant Natural := Len / 2;
+         Left_Start, Right_Start : NFA_Edge;
+         Left_Next, Right_Next : NFA_Edge;
+         L, R : NFA_Edge;
+         Last, E : NFA_Edge;
+      begin
+         --  With less than 2 elements, the sort is trivial.
+         if Len < 2 then
+            if Len = 0 then
+               Next_Edge := Start;
+            else
+               Next_Edge := Get_Next_Edge (Start);
+            end if;
+            Res := Start;
+            return;
+         end if;
+
+         --  Sort each half.
+         Edges_Merge_Sort (Start, Half, Left_Start, Left_Next);
+         Edges_Merge_Sort (Left_Next, Len - Half, Right_Start, Right_Next);
+
+         --  Merge.
+         L := Left_Start;
+         R := Right_Start;
+         Last := No_Edge;
+         loop
+            --  Take from left iff:
+            --  * it is not empty
+            --  * right is empty or else (left < right)
+            if L /= Left_Next and then (R = Right_Next or else Lt (L, R)) then
+               E := L;
+               L := Get_Next_Edge (L);
+
+            --  Take from right if right is not empty.
+            elsif R /= Right_Next then
+               E := R;
+               R := Get_Next_Edge (R);
+
+            --  Both left are right are empty.
+            else
+               exit;
+            end if;
+
+            if Last = No_Edge then
+               Res := E;
+            else
+               Set_Next_Edge (Last, E);
+            end if;
+            Last := E;
+         end loop;
+         --  Let the link clean.
+         Next_Edge := Right_Next;
+         Set_Next_Edge (Last, Next_Edge);
+      end Edges_Merge_Sort;
+
+      procedure Sort_Edges (S : NFA_State)
+      is
+         Nbr_Edges : Natural;
+         First_E, E, Res : NFA_Edge;
+      begin
+         --  Count number of edges.
+         Nbr_Edges := 0;
+         First_E := Get_First_Edge (S);
+         E := First_E;
+         while E /= No_Edge loop
+            Nbr_Edges := Nbr_Edges + 1;
+            E := Get_Next_Edge (E);
+         end loop;
+
+         --  Sort edges by expression.
+         Edges_Merge_Sort (First_E, Nbr_Edges, Res, E);
+         pragma Assert (E = No_Edge);
+         Set_First_Edge (S, Res);
+
+      end Sort_Edges;
+
+      procedure Sort_Edges (N : NFA)
+      is
+         S : NFA_State;
+      begin
+         --  Iterate on states.
+         S := Get_First_State (N);
+         while S /= No_State loop
+            Sort_Edges (S);
+            S := Get_Next_State (S);
+         end loop;
+      end Sort_Edges;
+   end Sort_Edges;
+
+   package Sort_Src_Edges_Pkg is new
+     Sort_Edges (Get_First_Edge => Get_First_Src_Edge,
+                 Get_Next_Edge => Get_Next_Src_Edge,
+                 Set_First_Edge => Set_First_Src_Edge,
+                 Set_Next_Edge => Set_Next_Src_Edge,
+                 Get_Edge_State => Get_Edge_Dest);
+
+   procedure Sort_Src_Edges (S : NFA_State) renames
+     Sort_Src_Edges_Pkg.Sort_Edges;
+   procedure Sort_Src_Edges (N : NFA) renames
+     Sort_Src_Edges_Pkg.Sort_Edges;
+
+   package Sort_Dest_Edges_Pkg is new
+     Sort_Edges (Get_First_Edge => Get_First_Dest_Edge,
+                 Get_Next_Edge => Get_Next_Dest_Edge,
+                 Set_First_Edge => Set_First_Dest_Edge,
+                 Set_Next_Edge => Set_Next_Dest_Edge,
+                 Get_Edge_State => Get_Edge_Src);
+
+   procedure Sort_Dest_Edges (S : NFA_State) renames
+     Sort_Dest_Edges_Pkg.Sort_Edges;
+   procedure Sort_Dest_Edges (N : NFA) renames
+     Sort_Dest_Edges_Pkg.Sort_Edges;
+
+   generic
+      with function Get_First_Edge_Reverse (S : NFA_State) return NFA_Edge;
+      with function Get_First_Edge (S : NFA_State) return NFA_Edge;
+      with procedure Set_First_Edge (S : NFA_State; E : NFA_Edge);
+      with function Get_Next_Edge (E : NFA_Edge) return NFA_Edge;
+      with procedure Set_Next_Edge (E : NFA_Edge; E1 : NFA_Edge);
+      with procedure Set_Edge_State (E : NFA_Edge; S : NFA_State);
+   procedure Merge_State (N : NFA; S : NFA_State; S1 : NFA_State);
+
+   procedure Merge_State (N : NFA; S : NFA_State; S1 : NFA_State)
+   is
+      E, First_E, Next_E : NFA_Edge;
+   begin
+      pragma Assert (S /= S1);
+
+      --  Discard outgoing edges of S1.
+      loop
+         E := Get_First_Edge_Reverse (S1);
+         exit when E = No_Edge;
+         Remove_Edge (E);
+      end loop;
+
+      --  Prepend incoming edges of S1 to S.
+      First_E := Get_First_Edge (S);
+      E := Get_First_Edge (S1);
+      while E /= No_Edge loop
+         Next_E := Get_Next_Edge (E);
+         Set_Next_Edge (E, First_E);
+         Set_Edge_State (E, S);
+         First_E := E;
+         E := Next_E;
+      end loop;
+      Set_First_Edge (S, First_E);
+      Set_First_Edge (S1, No_Edge);
+
+      Remove_State (N, S1);
+   end Merge_State;
+
+   procedure Merge_State_Dest_1 is new Merge_State
+     (Get_First_Edge_Reverse => Get_First_Src_Edge,
+      Get_First_Edge => Get_First_Dest_Edge,
+      Set_First_Edge => Set_First_Dest_Edge,
+      Get_Next_Edge => Get_Next_Dest_Edge,
+      Set_Next_Edge => Set_Next_Dest_Edge,
+      Set_Edge_State => Set_Edge_Dest);
+
+   procedure Merge_State_Dest (N : NFA; S : NFA_State; S1 : NFA_State) renames
+     Merge_State_Dest_1;
+
+   procedure Merge_State_Src_1 is new Merge_State
+     (Get_First_Edge_Reverse => Get_First_Dest_Edge,
+      Get_First_Edge => Get_First_Src_Edge,
+      Set_First_Edge => Set_First_Src_Edge,
+      Get_Next_Edge => Get_Next_Src_Edge,
+      Set_Next_Edge => Set_Next_Src_Edge,
+      Set_Edge_State => Set_Edge_Src);
+
+   procedure Merge_State_Src (N : NFA; S : NFA_State; S1 : NFA_State) renames
+     Merge_State_Src_1;
+
+   procedure Sort_Outgoing_Edges (N : NFA; Nbr_States : Natural)
+   is
+      Last_State : constant NFA_State := NFA_State (Nbr_States) - 1;
+      type Edge_Array is array (0 .. Last_State) of NFA_Edge;
+      Edges : Edge_Array := (others => No_Edge);
+      S, D : NFA_State;
+      E, Next_E : NFA_Edge;
+      First_Edge, Last_Edge : NFA_Edge;
+   begin
+      --  Iterate on states.
+      S := Get_First_State (N);
+      while S /= No_State loop
+
+         --  Create an array of edges
+         E := Get_First_Dest_Edge (S);
+         while E /= No_Edge loop
+            Next_E := Get_Next_Dest_Edge (E);
+            D := Get_Edge_Dest (E);
+            if Edges (D) /= No_Edge then
+               --  TODO: merge edges.
+               raise Program_Error;
+            end if;
+            Edges (D) := E;
+            E := Next_E;
+         end loop;
+
+         --  Rebuild the edge list (sorted by destination).
+         Last_Edge := No_Edge;
+         First_Edge := No_Edge;
+         for I in Edge_Array'Range loop
+            E := Edges (I);
+            if E /= No_Edge then
+               Edges (I) := No_Edge;
+               if First_Edge = No_Edge then
+                  First_Edge := E;
+               else
+                  Set_Next_Dest_Edge (Last_Edge, E);
+               end if;
+               Last_Edge := E;
+            end if;
+         end loop;
+         Set_First_Dest_Edge (S, First_Edge);
+         S := Get_Next_State (S);
+      end loop;
+   end Sort_Outgoing_Edges;
+   pragma Unreferenced (Sort_Outgoing_Edges);
+
+   generic
+      with function Get_First_Edge (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge (E : NFA_Edge) return NFA_Edge;
+      with function Get_State_Reverse (E : NFA_Edge) return NFA_State;
+      with function Get_First_Edge_Reverse (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge_Reverse (E : NFA_Edge) return NFA_Edge;
+   procedure Check_Edges_Gen (N : NFA);
+
+   procedure Check_Edges_Gen (N : NFA)
+   is
+      S : NFA_State;
+      E : NFA_Edge;
+      R_S : NFA_State;
+      R_E : NFA_Edge;
+   begin
+      S := Get_First_State (N);
+      while S /= No_State loop
+         E := Get_First_Edge (S);
+         while E /= No_Edge loop
+            R_S := Get_State_Reverse (E);
+            R_E := Get_First_Edge_Reverse (R_S);
+            while R_E /= No_Edge and then R_E /= E loop
+               R_E := Get_Next_Edge_Reverse (R_E);
+            end loop;
+            if R_E /= E then
+               raise Program_Error;
+            end if;
+            E := Get_Next_Edge (E);
+         end loop;
+         S := Get_Next_State (S);
+      end loop;
+   end Check_Edges_Gen;
+
+   procedure Check_Edges_Src is new Check_Edges_Gen
+     (Get_First_Edge => Get_First_Src_Edge,
+      Get_Next_Edge => Get_Next_Src_Edge,
+      Get_State_Reverse => Get_Edge_Dest,
+      Get_First_Edge_Reverse => Get_First_Dest_Edge,
+      Get_Next_Edge_Reverse => Get_Next_Dest_Edge);
+
+   procedure Check_Edges_Dest is new Check_Edges_Gen
+     (Get_First_Edge => Get_First_Dest_Edge,
+      Get_Next_Edge => Get_Next_Dest_Edge,
+      Get_State_Reverse => Get_Edge_Src,
+      Get_First_Edge_Reverse => Get_First_Src_Edge,
+      Get_Next_Edge_Reverse => Get_Next_Src_Edge);
+
+   procedure Check_NFA (N : NFA) is
+   begin
+      Check_Edges_Src (N);
+      Check_Edges_Dest (N);
+   end Check_NFA;
+
+   function Has_EOS (N : Node) return Boolean is
+   begin
+      case Get_Kind (N) is
+         when N_EOS =>
+            return True;
+         when N_False
+           | N_True
+           | N_HDL_Expr =>
+            return False;
+         when N_Not_Bool =>
+            return Has_EOS (Get_Boolean (N));
+         when N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool =>
+            return Has_EOS (Get_Left (N)) or else Has_EOS (Get_Right (N));
+         when others =>
+            Error_Kind ("Has_EOS", N);
+      end case;
+   end Has_EOS;
+
+end PSL.NFAs.Utils;
diff --git a/src/psl/psl-nfas-utils.ads b/src/psl/psl-nfas-utils.ads
new file mode 100644
index 000000000..bdbc0d013
--- /dev/null
+++ b/src/psl/psl-nfas-utils.ads
@@ -0,0 +1,21 @@
+package PSL.NFAs.Utils is
+   --  Sort outgoing edges by expression.
+   procedure Sort_Src_Edges (S : NFA_State);
+   procedure Sort_Src_Edges (N : NFA);
+
+   procedure Sort_Dest_Edges (S : NFA_State);
+   procedure Sort_Dest_Edges (N : NFA);
+
+   --  Move incoming edges of S1 to S, remove S1 and its outgoing edges.
+   procedure Merge_State_Dest (N : NFA; S : NFA_State; S1 : NFA_State);
+
+   procedure Merge_State_Src (N : NFA; S : NFA_State; S1 : NFA_State);
+
+   --  Return True if N or a child of N is EOS.
+   --  N must be a boolean expression.
+   function Has_EOS (N : Node) return Boolean;
+
+   --  Raise Program_Error if N is not internally coherent.
+   procedure Check_NFA (N : NFA);
+end PSL.NFAs.Utils;
+
diff --git a/src/psl/psl-nfas.adb b/src/psl/psl-nfas.adb
new file mode 100644
index 000000000..da4866e53
--- /dev/null
+++ b/src/psl/psl-nfas.adb
@@ -0,0 +1,529 @@
+with GNAT.Table;
+
+package body PSL.NFAs is
+   --  Record that describes an NFA.
+   type NFA_Node is record
+      --  Chain of States.
+      First_State : NFA_State;
+      Last_State : NFA_State;
+
+      --  Start and final state.
+      Start : NFA_State;
+      Final : NFA_State;
+
+      --  If true there is an epsilon transition between the start and
+      --  the final state.
+      Epsilon : Boolean;
+   end record;
+
+   --  Record that describe a node.
+   type NFA_State_Node is record
+      --  States may be numbered.
+      Label : Int32;
+
+      --  Edges.
+      First_Src : NFA_Edge;
+      First_Dst : NFA_Edge;
+
+      --  State links.
+      Next_State : NFA_State;
+      Prev_State : NFA_State;
+
+      --  User fields.
+      User_Link : NFA_State;
+      User_Flag : Boolean;
+   end record;
+
+   --  Record that describe an edge between SRC and DEST.
+   type NFA_Edge_Node is record
+      Dest : NFA_State;
+      Src : NFA_State;
+      Expr : Node;
+
+      --  Links.
+      Next_Src : NFA_Edge;
+      Next_Dst : NFA_Edge;
+   end record;
+
+   --  Table of NFA.
+   package Nfat is new GNAT.Table
+     (Table_Component_Type => NFA_Node,
+      Table_Index_Type => NFA,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  List of free nodes.
+   Free_Nfas : NFA := No_NFA;
+
+   --  Table of States.
+   package Statet is new GNAT.Table
+     (Table_Component_Type => NFA_State_Node,
+      Table_Index_Type => NFA_State,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  List of free states.
+   Free_States : NFA_State := No_State;
+
+   --  Table of edges.
+   package Transt is new GNAT.Table
+     (Table_Component_Type => NFA_Edge_Node,
+      Table_Index_Type => NFA_Edge,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  List of free edges.
+   Free_Edges : NFA_Edge := No_Edge;
+
+   function Get_First_State (N : NFA) return NFA_State is
+   begin
+      return Nfat.Table (N).First_State;
+   end Get_First_State;
+
+   function Get_Last_State (N : NFA) return NFA_State is
+   begin
+      return Nfat.Table (N).Last_State;
+   end Get_Last_State;
+
+   procedure Set_First_State (N : NFA; S : NFA_State) is
+   begin
+      Nfat.Table (N).First_State := S;
+   end Set_First_State;
+
+   procedure Set_Last_State (N : NFA; S : NFA_State) is
+   begin
+      Nfat.Table (N).Last_State := S;
+   end Set_Last_State;
+
+   function Get_Next_State (S : NFA_State) return NFA_State is
+   begin
+      return Statet.Table (S).Next_State;
+   end Get_Next_State;
+
+   procedure Set_Next_State (S : NFA_State; N : NFA_State) is
+   begin
+      Statet.Table (S).Next_State := N;
+   end Set_Next_State;
+
+   function Get_Prev_State (S : NFA_State) return NFA_State is
+   begin
+      return Statet.Table (S).Prev_State;
+   end Get_Prev_State;
+
+   procedure Set_Prev_State (S : NFA_State; N : NFA_State) is
+   begin
+      Statet.Table (S).Prev_State := N;
+   end Set_Prev_State;
+
+   function Get_State_Label (S : NFA_State) return Int32 is
+   begin
+      return Statet.Table (S).Label;
+   end Get_State_Label;
+
+   procedure Set_State_Label (S : NFA_State; Label : Int32) is
+   begin
+      Statet.Table (S).Label := Label;
+   end Set_State_Label;
+
+   function Get_Epsilon_NFA (N : NFA) return Boolean is
+   begin
+      return Nfat.Table (N).Epsilon;
+   end Get_Epsilon_NFA;
+
+   procedure Set_Epsilon_NFA (N : NFA; Flag : Boolean) is
+   begin
+      Nfat.Table (N).Epsilon := Flag;
+   end Set_Epsilon_NFA;
+
+   function Add_State (N : NFA) return NFA_State is
+      Res : NFA_State;
+      Last : NFA_State;
+   begin
+      --  Get a new state.
+      if Free_States = No_State then
+         Statet.Increment_Last;
+         Res := Statet.Last;
+      else
+         Res := Free_States;
+         Free_States := Get_Next_State (Res);
+      end if;
+
+      --  Put it in N.
+      Last := Get_Last_State (N);
+      Statet.Table (Res) := (Label => 0,
+                             First_Src => No_Edge,
+                             First_Dst => No_Edge,
+                             Next_State => No_State,
+                             Prev_State => Last,
+                             User_Link => No_State,
+                             User_Flag => False);
+      if Last = No_State then
+         Nfat.Table (N).First_State := Res;
+      else
+         Statet.Table (Last).Next_State := Res;
+      end if;
+      Nfat.Table (N).Last_State := Res;
+      return Res;
+   end Add_State;
+
+   procedure Delete_Detached_State (S : NFA_State) is
+   begin
+      --  Put it in front of the free_states list.
+      Set_Next_State (S, Free_States);
+      Free_States := S;
+   end Delete_Detached_State;
+
+   function Create_NFA return NFA
+   is
+      Res : NFA;
+   begin
+      --  Allocate a node.
+      if Free_Nfas = No_NFA then
+         Nfat.Increment_Last;
+         Res := Nfat.Last;
+      else
+         Res := Free_Nfas;
+         Free_Nfas := NFA (Get_First_State (Res));
+      end if;
+
+      --  Fill it.
+      Nfat.Table (Res) := (First_State => No_State,
+                           Last_State => No_State,
+                           Start => No_State, Final => No_State,
+                           Epsilon => False);
+      return Res;
+   end Create_NFA;
+
+   procedure Set_First_Src_Edge (N : NFA_State; T : NFA_Edge) is
+   begin
+      Statet.Table (N).First_Src := T;
+   end Set_First_Src_Edge;
+
+   function Get_First_Src_Edge (N : NFA_State) return NFA_Edge is
+   begin
+      return Statet.Table (N).First_Src;
+   end Get_First_Src_Edge;
+
+   procedure Set_First_Dest_Edge (N : NFA_State; T : NFA_Edge) is
+   begin
+      Statet.Table (N).First_Dst := T;
+   end Set_First_Dest_Edge;
+
+   function Get_First_Dest_Edge (N : NFA_State) return NFA_Edge is
+   begin
+      return Statet.Table (N).First_Dst;
+   end Get_First_Dest_Edge;
+
+   function Get_State_Flag (S : NFA_State) return Boolean is
+   begin
+      return Statet.Table (S).User_Flag;
+   end Get_State_Flag;
+
+   procedure Set_State_Flag (S : NFA_State; Val : Boolean) is
+   begin
+      Statet.Table (S).User_Flag := Val;
+   end Set_State_Flag;
+
+   function Get_State_User_Link (S : NFA_State) return NFA_State is
+   begin
+      return Statet.Table (S).User_Link;
+   end Get_State_User_Link;
+
+   procedure Set_State_User_Link (S : NFA_State; Link : NFA_State) is
+   begin
+      Statet.Table (S).User_Link := Link;
+   end Set_State_User_Link;
+
+   function Add_Edge (Src : NFA_State; Dest : NFA_State; Expr : Node)
+                     return NFA_Edge
+   is
+      Res : NFA_Edge;
+   begin
+      --  Allocate a note.
+      if Free_Edges /= No_Edge then
+         Res := Free_Edges;
+         Free_Edges := Get_Next_Dest_Edge (Res);
+      else
+         Transt.Increment_Last;
+         Res := Transt.Last;
+      end if;
+
+      --  Initialize it.
+      Transt.Table (Res) := (Dest => Dest,
+                             Src => Src,
+                             Expr => Expr,
+                             Next_Src => Get_First_Src_Edge (Src),
+                             Next_Dst => Get_First_Dest_Edge (Dest));
+      Set_First_Src_Edge (Src, Res);
+      Set_First_Dest_Edge (Dest, Res);
+      return Res;
+   end Add_Edge;
+
+   procedure Add_Edge (Src : NFA_State; Dest : NFA_State; Expr : Node) is
+      Res : NFA_Edge;
+      pragma Unreferenced (Res);
+   begin
+      Res := Add_Edge (Src, Dest, Expr);
+   end Add_Edge;
+
+   procedure Delete_Empty_NFA (N : NFA) is
+   begin
+      pragma Assert (Get_First_State (N) = No_State);
+      pragma Assert (Get_Last_State (N) = No_State);
+
+      --  Put it in front of the free_nfas list.
+      Set_First_State (N, NFA_State (Free_Nfas));
+      Free_Nfas := N;
+   end Delete_Empty_NFA;
+
+   function Get_Start_State (N : NFA) return NFA_State is
+   begin
+      return Nfat.Table (N).Start;
+   end Get_Start_State;
+
+   procedure Set_Start_State (N : NFA; S : NFA_State) is
+   begin
+      Nfat.Table (N).Start := S;
+   end Set_Start_State;
+
+   function Get_Final_State (N : NFA) return NFA_State is
+   begin
+      return Nfat.Table (N).Final;
+   end Get_Final_State;
+
+   procedure Set_Final_State (N : NFA; S : NFA_State) is
+   begin
+      Nfat.Table (N).Final := S;
+   end Set_Final_State;
+
+   function Get_Next_Src_Edge (N : NFA_Edge) return NFA_Edge is
+   begin
+      return Transt.Table (N).Next_Src;
+   end Get_Next_Src_Edge;
+
+   procedure Set_Next_Src_Edge (E : NFA_Edge; N_E : NFA_Edge) is
+   begin
+      Transt.Table (E).Next_Src := N_E;
+   end Set_Next_Src_Edge;
+
+   function Get_Next_Dest_Edge (N : NFA_Edge) return NFA_Edge is
+   begin
+      return Transt.Table (N).Next_Dst;
+   end Get_Next_Dest_Edge;
+
+   procedure Set_Next_Dest_Edge (E : NFA_Edge; N_E : NFA_Edge) is
+   begin
+      Transt.Table (E).Next_Dst := N_E;
+   end Set_Next_Dest_Edge;
+
+   function Get_Edge_Dest (E : NFA_Edge) return NFA_State is
+   begin
+      return Transt.Table (E).Dest;
+   end Get_Edge_Dest;
+
+   procedure Set_Edge_Dest (E : NFA_Edge; D : NFA_State) is
+   begin
+      Transt.Table (E).Dest := D;
+   end Set_Edge_Dest;
+
+   function Get_Edge_Src (E : NFA_Edge) return NFA_State is
+   begin
+      return Transt.Table (E).Src;
+   end Get_Edge_Src;
+
+   procedure Set_Edge_Src (E : NFA_Edge; D : NFA_State) is
+   begin
+      Transt.Table (E).Src := D;
+   end Set_Edge_Src;
+
+   function Get_Edge_Expr (E : NFA_Edge) return Node is
+   begin
+      return Transt.Table (E).Expr;
+   end Get_Edge_Expr;
+
+   procedure Set_Edge_Expr (E : NFA_Edge; N : Node) is
+   begin
+      Transt.Table (E).Expr := N;
+   end Set_Edge_Expr;
+
+   procedure Remove_Unconnected_State (N : NFA; S : NFA_State) is
+      N_S : constant NFA_State := Get_Next_State (S);
+      P_S : constant NFA_State := Get_Prev_State (S);
+   begin
+      pragma Assert (Get_First_Src_Edge (S) = No_Edge);
+      pragma Assert (Get_First_Dest_Edge (S) = No_Edge);
+
+      if P_S = No_State then
+         Set_First_State (N, N_S);
+      else
+         Set_Next_State (P_S, N_S);
+      end if;
+      if N_S = No_State then
+         Set_Last_State (N, P_S);
+      else
+         Set_Prev_State (N_S, P_S);
+      end if;
+      Delete_Detached_State (S);
+   end Remove_Unconnected_State;
+
+   procedure Merge_NFA (L, R : NFA) is
+      Last_L  : constant NFA_State := Get_Last_State (L);
+      First_R : constant NFA_State := Get_First_State (R);
+      Last_R  : constant NFA_State := Get_Last_State (R);
+   begin
+      if First_R = No_State then
+         return;
+      end if;
+      if Last_L = No_State then
+         Set_First_State (L, First_R);
+      else
+         Set_Next_State (Last_L, First_R);
+         Set_Prev_State (First_R, Last_L);
+      end if;
+      Set_Last_State (L, Last_R);
+      Set_First_State (R, No_State);
+      Set_Last_State (R, No_State);
+      Delete_Empty_NFA (R);
+   end Merge_NFA;
+
+   procedure Redest_Edges (S : NFA_State; Dest : NFA_State) is
+      E, N_E : NFA_Edge;
+      Head : NFA_Edge;
+   begin
+      E := Get_First_Dest_Edge (S);
+      if E = No_Edge then
+         return;
+      end if;
+      Set_First_Dest_Edge (S, No_Edge);
+      Head := Get_First_Dest_Edge (Dest);
+      Set_First_Dest_Edge (Dest, E);
+      loop
+         N_E := Get_Next_Dest_Edge (E);
+         Set_Edge_Dest (E, Dest);
+         exit when N_E = No_Edge;
+         E := N_E;
+      end loop;
+      Set_Next_Dest_Edge (E, Head);
+   end Redest_Edges;
+
+   procedure Resource_Edges (S : NFA_State; Src : NFA_State) is
+      E, N_E : NFA_Edge;
+      Head : NFA_Edge;
+   begin
+      E := Get_First_Src_Edge (S);
+      if E = No_Edge then
+         return;
+      end if;
+      Set_First_Src_Edge (S, No_Edge);
+      Head := Get_First_Src_Edge (Src);
+      Set_First_Src_Edge (Src, E);
+      loop
+         N_E := Get_Next_Src_Edge (E);
+         Set_Edge_Src (E, Src);
+         exit when N_E = No_Edge;
+         E := N_E;
+      end loop;
+      Set_Next_Src_Edge (E, Head);
+   end Resource_Edges;
+
+   procedure Disconnect_Edge_Src (N : NFA_State; E : NFA_Edge) is
+      N_E : constant NFA_Edge := Get_Next_Src_Edge (E);
+      Prev, Cur : NFA_Edge;
+   begin
+      Cur := Get_First_Src_Edge (N);
+      if Cur = E then
+         Set_First_Src_Edge (N, N_E);
+      else
+         while Cur /= E loop
+            Prev := Cur;
+            Cur := Get_Next_Src_Edge (Prev);
+            pragma Assert (Cur /= No_Edge);
+         end loop;
+         Set_Next_Src_Edge (Prev, N_E);
+      end if;
+   end Disconnect_Edge_Src;
+
+   procedure Disconnect_Edge_Dest (N : NFA_State; E : NFA_Edge) is
+      N_E : constant NFA_Edge := Get_Next_Dest_Edge (E);
+      Prev, Cur : NFA_Edge;
+   begin
+      Cur := Get_First_Dest_Edge (N);
+      if Cur = E then
+         Set_First_Dest_Edge (N, N_E);
+      else
+         while Cur /= E loop
+            Prev := Cur;
+            Cur := Get_Next_Dest_Edge (Prev);
+            pragma Assert (Cur /= No_Edge);
+         end loop;
+         Set_Next_Dest_Edge (Prev, N_E);
+      end if;
+   end Disconnect_Edge_Dest;
+
+   procedure Remove_Edge (E : NFA_Edge) is
+   begin
+      Disconnect_Edge_Src (Get_Edge_Src (E), E);
+      Disconnect_Edge_Dest (Get_Edge_Dest (E), E);
+
+      -- Put it on the free list.
+      Set_Next_Dest_Edge (E, Free_Edges);
+      Free_Edges := E;
+   end Remove_Edge;
+
+   procedure Remove_State (N : NFA; S : NFA_State) is
+      E, N_E : NFA_Edge;
+   begin
+      E := Get_First_Dest_Edge (S);
+      while E /= No_Edge loop
+         N_E := Get_Next_Dest_Edge (E);
+         Remove_Edge (E);
+         E := N_E;
+      end loop;
+
+      E := Get_First_Src_Edge (S);
+      while E /= No_Edge loop
+         N_E := Get_Next_Src_Edge (E);
+         Remove_Edge (E);
+         E := N_E;
+      end loop;
+
+      Remove_Unconnected_State (N, S);
+   end Remove_State;
+
+   procedure Labelize_States (N : NFA; Nbr_States : out Natural)
+   is
+      S, Start, Final : NFA_State;
+   begin
+      S := Get_First_State (N);
+      Start := Get_Start_State (N);
+      Final := Get_Final_State (N);
+      pragma Assert (Start /= No_State);
+      Set_State_Label (Start, 0);
+      Nbr_States := 1;
+      while S /= No_State loop
+         if S /= Start and then S /= Final then
+            Set_State_Label (S, Int32 (Nbr_States));
+            Nbr_States := Nbr_States + 1;
+         end if;
+         S := Get_Next_State (S);
+      end loop;
+      pragma Assert (Final /= No_State);
+      Set_State_Label (Final, Int32 (Nbr_States));
+      Nbr_States := Nbr_States + 1;
+   end Labelize_States;
+
+   procedure Labelize_States_Debug (N : NFA)
+   is
+      S : NFA_State;
+   begin
+      S := Get_First_State (N);
+      while S /= No_State loop
+         Set_State_Label (S, Int32 (S));
+         S := Get_Next_State (S);
+      end loop;
+   end Labelize_States_Debug;
+
+end PSL.NFAs;
diff --git a/src/psl/psl-nfas.ads b/src/psl/psl-nfas.ads
new file mode 100644
index 000000000..815acf223
--- /dev/null
+++ b/src/psl/psl-nfas.ads
@@ -0,0 +1,108 @@
+with Types; use Types;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.NFAs is
+   --  Represents NFAs for PSL.
+   --  These NFAs have the following restrictions:
+   --  * 1 start state
+   --  * 1 final state (which can be the start state).
+   --  * possible epsilon transition between start and final state with the
+   --    meaning: A | eps
+
+   type NFA_State is new Nat32;
+   type NFA_Edge is new Nat32;
+
+   No_NFA   : constant NFA := 0;
+   No_State : constant NFA_State := 0;
+   No_Edge  : constant NFA_Edge := 0;
+
+   --  Create a new NFA.
+   function Create_NFA return NFA;
+
+   --  Add a new state to an NFA.
+   function Add_State (N : NFA) return NFA_State;
+
+   --  Add a transition.
+   procedure Add_Edge (Src : NFA_State; Dest : NFA_State; Expr : Node);
+   function Add_Edge (Src : NFA_State; Dest : NFA_State; Expr : Node)
+                     return NFA_Edge;
+
+   --  Disconnect and free edge E.
+   procedure Remove_Edge (E : NFA_Edge);
+
+   --  Return TRUE if there is an epsilon edge between start and final.
+   function Get_Epsilon_NFA (N : NFA) return Boolean;
+   procedure Set_Epsilon_NFA (N : NFA; Flag : Boolean);
+
+   --  Each NFA has one start and one final state.
+   function Get_Start_State (N : NFA) return NFA_State;
+   procedure Set_Start_State (N : NFA; S : NFA_State);
+
+   procedure Set_Final_State (N : NFA; S : NFA_State);
+   function Get_Final_State (N : NFA) return NFA_State;
+
+   --  Iterate on all states.
+   function Get_First_State (N : NFA) return NFA_State;
+   function Get_Next_State (S : NFA_State) return NFA_State;
+
+   --  Per state user flag.
+   --  Initialized set to false.
+   function Get_State_Flag (S : NFA_State) return Boolean;
+   procedure Set_State_Flag (S : NFA_State; Val : Boolean);
+
+   --  Per state user link.
+   function Get_State_User_Link (S : NFA_State) return NFA_State;
+   procedure Set_State_User_Link (S : NFA_State; Link : NFA_State);
+
+   --  Edges of a state.
+   --  A source edge is an edge whose source is the state.
+   function Get_First_Src_Edge (N : NFA_State) return NFA_Edge;
+   function Get_Next_Src_Edge (N : NFA_Edge) return NFA_Edge;
+
+   --  A dest edge is an edge whose destination is the state.
+   function Get_First_Dest_Edge (N : NFA_State) return NFA_Edge;
+   function Get_Next_Dest_Edge (N : NFA_Edge) return NFA_Edge;
+
+   function Get_State_Label (S : NFA_State) return Int32;
+   procedure Set_State_Label (S : NFA_State; Label : Int32);
+
+   function Get_Edge_Dest (E: NFA_Edge) return NFA_State;
+   function Get_Edge_Src (E : NFA_Edge) return NFA_State;
+   function Get_Edge_Expr (E : NFA_Edge) return Node;
+
+   --  Move States and edges of R to L.
+   procedure Merge_NFA (L, R : NFA);
+
+   --  All edges to S are redirected to DEST.
+   procedure Redest_Edges (S : NFA_State; Dest : NFA_State);
+
+   --  All edges from S are redirected from SRC.
+   procedure Resource_Edges (S : NFA_State; Src : NFA_State);
+
+   --  Remove a state.  The state must be unconnected.
+   procedure Remove_Unconnected_State (N : NFA; S : NFA_State);
+
+   --  Deconnect and remove state S.
+   procedure Remove_State (N : NFA; S : NFA_State);
+
+   procedure Delete_Empty_NFA (N : NFA);
+
+   --  Set a label on the states of the NFA N.
+   --  Start state is has label 0.
+   --  Return the number of states.
+   procedure Labelize_States (N : NFA; Nbr_States : out Natural);
+
+   --  Set state index as state label.
+   --  Used to debug an NFA.
+   procedure Labelize_States_Debug (N : NFA);
+
+   procedure Set_Edge_Expr (E : NFA_Edge; N : Node);
+private
+   --  Low level procedures.  Shouldn't be used directly.
+   procedure Set_First_Dest_Edge (N : NFA_State; T : NFA_Edge);
+   procedure Set_Next_Dest_Edge (E : NFA_Edge; N_E : NFA_Edge);
+   procedure Set_First_Src_Edge (N : NFA_State; T : NFA_Edge);
+   procedure Set_Next_Src_Edge (E : NFA_Edge; N_E : NFA_Edge);
+   procedure Set_Edge_Dest (E : NFA_Edge; D : NFA_State);
+   procedure Set_Edge_Src (E : NFA_Edge; D : NFA_State);
+end PSL.NFAs;
diff --git a/src/psl/psl-nodes.adb b/src/psl/psl-nodes.adb
new file mode 100644
index 000000000..a6482a142
--- /dev/null
+++ b/src/psl/psl-nodes.adb
@@ -0,0 +1,1231 @@
+--  This is in fact -*- Ada -*-
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with PSL.Errors;
+with PSL.Hash;
+
+package body PSL.Nodes is
+   --  Suppress the access check of the table base.  This is really safe to
+   --  suppress this check because the table base cannot be null.
+   pragma Suppress (Access_Check);
+
+   --  Suppress the index check on the table.
+   --  Could be done during non-debug, since this may catch errors (reading
+   --  Null_Node.
+   --pragma Suppress (Index_Check);
+
+   type Format_Type is
+     (
+      Format_Short,
+      Format_Medium
+     );
+
+   pragma Unreferenced (Format_Type, Format_Short, Format_Medium);
+
+   -- Common fields are:
+   --   Flag1 : Boolean
+   --   Flag2 : Boolean
+   --   Flag3 : Boolean
+   --   Flag4 : Boolean
+   --   Flag5 : Boolean
+   --   Flag6 : Boolean
+   --   Nkind : Kind_Type
+   --   State1 : Bit2_Type
+   --   State2 : Bit2_Type
+   --   Location : Int32
+   --   Field1 : Int32
+   --   Field2 : Int32
+   --   Field3 : Int32
+   --   Field4 : Int32
+
+   -- Fields of Format_Short:
+   --   Field5 : Int32
+   --   Field6 : Int32
+
+   -- Fields of Format_Medium:
+   --   Odigit1 : Bit3_Type
+   --   Odigit2 : Bit3_Type
+   --   State3 : Bit2_Type
+   --   State4 : Bit2_Type
+   --   Field5 : Int32
+   --   Field6 : Int32
+   --   Field7 : Int32 (location)
+   --   Field8 : Int32 (field1)
+   --   Field9 : Int32 (field2)
+   --   Field10 : Int32 (field3)
+   --   Field11 : Int32 (field4)
+   --   Field12 : Int32 (field5)
+
+   type State_Type is range 0 .. 3;
+   type Bit3_Type is range 0 .. 7;
+
+   type Node_Record is record
+      Kind : Nkind;
+      Flag1 : Boolean;
+      Flag2 : Boolean;
+      Flag3 : Boolean;
+      Flag4 : Boolean;
+      Flag5 : Boolean;
+      Flag6 : Boolean;
+      Flag7 : Boolean;
+      Flag8 : Boolean;
+      Flag9 : Boolean;
+      Flag10 : Boolean;
+      Flag11 : Boolean;
+      Flag12 : Boolean;
+      Flag13 : Boolean;
+      Flag14 : Boolean;
+      Flag15 : Boolean;
+      Flag16 : Boolean;
+      State1 : State_Type;
+      B3_1 : Bit3_Type;
+      Flag17 : Boolean;
+      Flag18 : Boolean;
+      Flag19 : Boolean;
+
+      Location : Int32;
+      Field1 : Int32;
+      Field2 : Int32;
+      Field3 : Int32;
+      Field4 : Int32;
+      Field5 : Int32;
+      Field6 : Int32;
+   end record;
+   pragma Pack (Node_Record);
+   for Node_Record'Size use 8 * 32;
+
+   package Nodet is new GNAT.Table
+     (Table_Component_Type => Node_Record,
+      Table_Index_Type => Node,
+      Table_Low_Bound => 1,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   Init_Node : constant Node_Record := (Kind => N_Error,
+                                        Flag1 => False,
+                                        Flag2 => False,
+                                        State1 => 0,
+                                        B3_1 => 0,
+                                        Location => 0,
+                                        Field1 => 0,
+                                        Field2 => 0,
+                                        Field3 => 0,
+                                        Field4 => 0,
+                                        Field5 => 0,
+                                        Field6 => 0,
+                                        others => False);
+
+   Free_Nodes : Node := Null_Node;
+
+
+   function Get_Last_Node return Node is
+   begin
+      return Nodet.Last;
+   end Get_Last_Node;
+
+   function Int32_To_Uns32 is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => Uns32);
+
+   function Uns32_To_Int32 is new Ada.Unchecked_Conversion
+     (Source => Uns32, Target => Int32);
+
+   function Int32_To_NFA is new Ada.Unchecked_Conversion
+     (Source => Int32, Target => NFA);
+
+   function NFA_To_Int32 is new Ada.Unchecked_Conversion
+     (Source => NFA, Target => Int32);
+
+   procedure Set_Kind (N : Node; K : Nkind) is
+   begin
+      Nodet.Table (N).Kind := K;
+   end Set_Kind;
+
+   function Get_Kind (N : Node) return Nkind is
+   begin
+      return Nodet.Table (N).Kind;
+   end Get_Kind;
+
+
+   procedure Set_Flag1 (N : Node; Flag : Boolean) is
+   begin
+      Nodet.Table (N).Flag1 := Flag;
+   end Set_Flag1;
+
+   function Get_Flag1 (N : Node) return Boolean is
+   begin
+      return Nodet.Table (N).Flag1;
+   end Get_Flag1;
+
+   procedure Set_Flag2 (N : Node; Flag : Boolean) is
+   begin
+      Nodet.Table (N).Flag2 := Flag;
+   end Set_Flag2;
+
+   function Get_Flag2 (N : Node) return Boolean is
+   begin
+      return Nodet.Table (N).Flag2;
+   end Get_Flag2;
+
+
+   procedure Set_State1 (N : Node; S : State_Type) is
+   begin
+      Nodet.Table (N).State1 := S;
+   end Set_State1;
+
+   function Get_State1 (N : Node) return State_Type is
+   begin
+      return Nodet.Table (N).State1;
+   end Get_State1;
+
+
+   function Get_Location (N : Node) return Location_Type is
+   begin
+      return Location_Type (Nodet.Table (N).Location);
+   end Get_Location;
+
+   procedure Set_Location (N : Node; Loc : Location_Type) is
+   begin
+      Nodet.Table (N).Location := Int32 (Loc);
+   end Set_Location;
+
+
+   procedure Set_Field1 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field1 := V;
+   end Set_Field1;
+
+   function Get_Field1 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field1;
+   end Get_Field1;
+
+
+   procedure Set_Field2 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field2 := V;
+   end Set_Field2;
+
+   function Get_Field2 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field2;
+   end Get_Field2;
+
+
+   function Get_Field3 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field3;
+   end Get_Field3;
+
+   procedure Set_Field3 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field3 := V;
+   end Set_Field3;
+
+
+   function Get_Field4 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field4;
+   end Get_Field4;
+
+   procedure Set_Field4 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field4 := V;
+   end Set_Field4;
+
+
+   function Get_Field5 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field5;
+   end Get_Field5;
+
+   procedure Set_Field5 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field5 := V;
+   end Set_Field5;
+
+
+   function Get_Field6 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N).Field6;
+   end Get_Field6;
+
+   procedure Set_Field6 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N).Field6 := V;
+   end Set_Field6;
+
+   procedure Set_Field7 (N : Node; V : Int32) is
+   begin
+      Nodet.Table (N + 1).Field1 := V;
+   end Set_Field7;
+
+   function Get_Field7 (N : Node) return Int32 is
+   begin
+      return Nodet.Table (N + 1).Field1;
+   end Get_Field7;
+
+
+   function Create_Node (Kind : Nkind) return Node
+   is
+      Res : Node;
+   begin
+      if Free_Nodes /= Null_Node then
+         Res := Free_Nodes;
+         Free_Nodes := Node (Get_Field1 (Res));
+      else
+         Nodet.Increment_Last;
+         Res := Nodet.Last;
+      end if;
+      Nodet.Table (Res) := Init_Node;
+      Set_Kind (Res, Kind);
+      return Res;
+   end Create_Node;
+
+   procedure Free_Node (N : Node)
+   is
+   begin
+      Set_Kind (N, N_Error);
+      Set_Field1 (N, Int32 (Free_Nodes));
+      Free_Nodes := N;
+   end Free_Node;
+
+   procedure Failed (Msg : String; N : Node)
+   is
+   begin
+      Errors.Error_Kind (Msg, N);
+   end Failed;
+
+   procedure Init is
+   begin
+      Nodet.Init;
+      if Create_Node (N_False) /= False_Node then
+         raise Internal_Error;
+      end if;
+      if Create_Node (N_True) /= True_Node then
+         raise Internal_Error;
+      end if;
+      if Create_Node (N_Number) /= One_Node then
+         raise Internal_Error;
+      end if;
+      Set_Value (One_Node, 1);
+      if Create_Node (N_EOS) /= EOS_Node then
+         raise Internal_Error;
+      end if;
+      Set_Hash (EOS_Node, 0);
+      PSL.Hash.Init;
+   end Init;
+
+   function Get_Psl_Type (N : Node) return PSL_Types is
+   begin
+      case Get_Kind (N) is
+         when N_And_Prop
+           | N_Or_Prop
+           | N_Log_Imp_Prop
+           | N_Always
+           | N_Never
+           | N_Eventually
+           | N_Next
+           | N_Next_E
+           | N_Next_A
+           | N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Before
+           | N_Until
+           | N_Abort
+           | N_Strong
+           | N_Property_Parameter
+           | N_Property_Instance =>
+            return Type_Property;
+         when N_Braced_SERE
+           | N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Within_SERE
+           | N_Overlap_Imp_Seq
+           | N_Imp_Seq
+           | N_And_Seq
+           | N_Or_Seq
+           | N_Match_And_Seq
+           | N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq
+           | N_Plus_Repeat_Seq
+           | N_Clock_Event
+           | N_Sequence_Instance
+           | N_Endpoint_Instance
+           | N_Sequence_Parameter =>
+            return Type_Sequence;
+         when N_Name =>
+            return Get_Psl_Type (Get_Decl (N));
+         when N_HDL_Expr =>
+            --  FIXME.
+            return Type_Boolean;
+         when N_Or_Bool
+           | N_And_Bool
+           | N_Not_Bool
+           | N_Imp_Bool
+           | N_False
+           | N_True
+           | N_Boolean_Parameter =>
+            return Type_Boolean;
+         when N_Number
+           | N_Const_Parameter =>
+            return Type_Numeric;
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop
+           | N_Hdl_Mod_Name
+           | N_Assert_Directive
+           | N_Sequence_Declaration
+           | N_Endpoint_Declaration
+           | N_Property_Declaration
+           | N_Actual
+           | N_Name_Decl
+           | N_Error
+           | N_EOS =>
+            PSL.Errors.Error_Kind ("get_psl_type", N);
+      end case;
+   end Get_Psl_Type;
+
+   procedure Reference_Failed (Msg : String; N : Node) is
+   begin
+      Failed (Msg, N);
+   end Reference_Failed;
+   pragma Unreferenced (Reference_Failed);
+
+   pragma Unreferenced (Set_Field7, Get_Field7);
+   --  Subprograms.
+   procedure Check_Kind_For_Identifier (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop
+           | N_Hdl_Mod_Name
+           | N_Property_Declaration
+           | N_Sequence_Declaration
+           | N_Endpoint_Declaration
+           | N_Const_Parameter
+           | N_Boolean_Parameter
+           | N_Property_Parameter
+           | N_Sequence_Parameter
+           | N_Name
+           | N_Name_Decl =>
+            null;
+         when others =>
+            Failed ("Get/Set_Identifier", N);
+      end case;
+   end Check_Kind_For_Identifier;
+
+   function Get_Identifier (N : Node) return Name_Id is
+   begin
+      Check_Kind_For_Identifier (N);
+      return Name_Id (Get_Field1 (N));
+   end Get_Identifier;
+
+   procedure Set_Identifier (N : Node; Id : Name_Id) is
+   begin
+      Check_Kind_For_Identifier (N);
+      Set_Field1 (N, Int32 (Id));
+   end Set_Identifier;
+
+   procedure Check_Kind_For_Chain (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop
+           | N_Assert_Directive
+           | N_Property_Declaration
+           | N_Sequence_Declaration
+           | N_Endpoint_Declaration
+           | N_Const_Parameter
+           | N_Boolean_Parameter
+           | N_Property_Parameter
+           | N_Sequence_Parameter
+           | N_Actual
+           | N_Name_Decl =>
+            null;
+         when others =>
+            Failed ("Get/Set_Chain", N);
+      end case;
+   end Check_Kind_For_Chain;
+
+   function Get_Chain (N : Node) return Node is
+   begin
+      Check_Kind_For_Chain (N);
+      return Node (Get_Field2 (N));
+   end Get_Chain;
+
+   procedure Set_Chain (N : Node; Chain : Node) is
+   begin
+      Check_Kind_For_Chain (N);
+      Set_Field2 (N, Int32 (Chain));
+   end Set_Chain;
+
+   procedure Check_Kind_For_Instance (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop =>
+            null;
+         when others =>
+            Failed ("Get/Set_Instance", N);
+      end case;
+   end Check_Kind_For_Instance;
+
+   function Get_Instance (N : Node) return Node is
+   begin
+      Check_Kind_For_Instance (N);
+      return Node (Get_Field3 (N));
+   end Get_Instance;
+
+   procedure Set_Instance (N : Node; Instance : Node) is
+   begin
+      Check_Kind_For_Instance (N);
+      Set_Field3 (N, Int32 (Instance));
+   end Set_Instance;
+
+   procedure Check_Kind_For_Item_Chain (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop =>
+            null;
+         when others =>
+            Failed ("Get/Set_Item_Chain", N);
+      end case;
+   end Check_Kind_For_Item_Chain;
+
+   function Get_Item_Chain (N : Node) return Node is
+   begin
+      Check_Kind_For_Item_Chain (N);
+      return Node (Get_Field4 (N));
+   end Get_Item_Chain;
+
+   procedure Set_Item_Chain (N : Node; Item : Node) is
+   begin
+      Check_Kind_For_Item_Chain (N);
+      Set_Field4 (N, Int32 (Item));
+   end Set_Item_Chain;
+
+   procedure Check_Kind_For_Prefix (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Hdl_Mod_Name =>
+            null;
+         when others =>
+            Failed ("Get/Set_Prefix", N);
+      end case;
+   end Check_Kind_For_Prefix;
+
+   function Get_Prefix (N : Node) return Node is
+   begin
+      Check_Kind_For_Prefix (N);
+      return Node (Get_Field2 (N));
+   end Get_Prefix;
+
+   procedure Set_Prefix (N : Node; Prefix : Node) is
+   begin
+      Check_Kind_For_Prefix (N);
+      Set_Field2 (N, Int32 (Prefix));
+   end Set_Prefix;
+
+   procedure Check_Kind_For_Label (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Assert_Directive =>
+            null;
+         when others =>
+            Failed ("Get/Set_Label", N);
+      end case;
+   end Check_Kind_For_Label;
+
+   function Get_Label (N : Node) return Name_Id is
+   begin
+      Check_Kind_For_Label (N);
+      return Name_Id (Get_Field1 (N));
+   end Get_Label;
+
+   procedure Set_Label (N : Node; Id : Name_Id) is
+   begin
+      Check_Kind_For_Label (N);
+      Set_Field1 (N, Int32 (Id));
+   end Set_Label;
+
+   procedure Check_Kind_For_String (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Assert_Directive =>
+            null;
+         when others =>
+            Failed ("Get/Set_String", N);
+      end case;
+   end Check_Kind_For_String;
+
+   function Get_String (N : Node) return Node is
+   begin
+      Check_Kind_For_String (N);
+      return Node (Get_Field3 (N));
+   end Get_String;
+
+   procedure Set_String (N : Node; Str : Node) is
+   begin
+      Check_Kind_For_String (N);
+      Set_Field3 (N, Int32 (Str));
+   end Set_String;
+
+   procedure Check_Kind_For_Property (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Assert_Directive
+           | N_Property_Declaration
+           | N_Clock_Event
+           | N_Always
+           | N_Never
+           | N_Eventually
+           | N_Strong
+           | N_Imp_Seq
+           | N_Overlap_Imp_Seq
+           | N_Next
+           | N_Next_A
+           | N_Next_E
+           | N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Abort =>
+            null;
+         when others =>
+            Failed ("Get/Set_Property", N);
+      end case;
+   end Check_Kind_For_Property;
+
+   function Get_Property (N : Node) return Node is
+   begin
+      Check_Kind_For_Property (N);
+      return Node (Get_Field4 (N));
+   end Get_Property;
+
+   procedure Set_Property (N : Node; Property : Node) is
+   begin
+      Check_Kind_For_Property (N);
+      Set_Field4 (N, Int32 (Property));
+   end Set_Property;
+
+   procedure Check_Kind_For_NFA (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Assert_Directive =>
+            null;
+         when others =>
+            Failed ("Get/Set_NFA", N);
+      end case;
+   end Check_Kind_For_NFA;
+
+   function Get_NFA (N : Node) return NFA is
+   begin
+      Check_Kind_For_NFA (N);
+      return Int32_To_NFA (Get_Field5 (N));
+   end Get_NFA;
+
+   procedure Set_NFA (N : Node; P : NFA) is
+   begin
+      Check_Kind_For_NFA (N);
+      Set_Field5 (N, NFA_To_Int32 (P));
+   end Set_NFA;
+
+   procedure Check_Kind_For_Global_Clock (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Property_Declaration =>
+            null;
+         when others =>
+            Failed ("Get/Set_Global_Clock", N);
+      end case;
+   end Check_Kind_For_Global_Clock;
+
+   function Get_Global_Clock (N : Node) return Node is
+   begin
+      Check_Kind_For_Global_Clock (N);
+      return Node (Get_Field3 (N));
+   end Get_Global_Clock;
+
+   procedure Set_Global_Clock (N : Node; Clock : Node) is
+   begin
+      Check_Kind_For_Global_Clock (N);
+      Set_Field3 (N, Int32 (Clock));
+   end Set_Global_Clock;
+
+   procedure Check_Kind_For_Parameter_List (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Property_Declaration
+           | N_Sequence_Declaration
+           | N_Endpoint_Declaration =>
+            null;
+         when others =>
+            Failed ("Get/Set_Parameter_List", N);
+      end case;
+   end Check_Kind_For_Parameter_List;
+
+   function Get_Parameter_List (N : Node) return Node is
+   begin
+      Check_Kind_For_Parameter_List (N);
+      return Node (Get_Field5 (N));
+   end Get_Parameter_List;
+
+   procedure Set_Parameter_List (N : Node; E : Node) is
+   begin
+      Check_Kind_For_Parameter_List (N);
+      Set_Field5 (N, Int32 (E));
+   end Set_Parameter_List;
+
+   procedure Check_Kind_For_Sequence (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Sequence_Declaration
+           | N_Endpoint_Declaration
+           | N_Imp_Seq
+           | N_Overlap_Imp_Seq
+           | N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Plus_Repeat_Seq
+           | N_Equal_Repeat_Seq =>
+            null;
+         when others =>
+            Failed ("Get/Set_Sequence", N);
+      end case;
+   end Check_Kind_For_Sequence;
+
+   function Get_Sequence (N : Node) return Node is
+   begin
+      Check_Kind_For_Sequence (N);
+      return Node (Get_Field3 (N));
+   end Get_Sequence;
+
+   procedure Set_Sequence (N : Node; S : Node) is
+   begin
+      Check_Kind_For_Sequence (N);
+      Set_Field3 (N, Int32 (S));
+   end Set_Sequence;
+
+   procedure Check_Kind_For_Actual (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Const_Parameter
+           | N_Boolean_Parameter
+           | N_Property_Parameter
+           | N_Sequence_Parameter
+           | N_Actual =>
+            null;
+         when others =>
+            Failed ("Get/Set_Actual", N);
+      end case;
+   end Check_Kind_For_Actual;
+
+   function Get_Actual (N : Node) return Node is
+   begin
+      Check_Kind_For_Actual (N);
+      return Node (Get_Field3 (N));
+   end Get_Actual;
+
+   procedure Set_Actual (N : Node; E : Node) is
+   begin
+      Check_Kind_For_Actual (N);
+      Set_Field3 (N, Int32 (E));
+   end Set_Actual;
+
+   procedure Check_Kind_For_Declaration (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Sequence_Instance
+           | N_Endpoint_Instance
+           | N_Property_Instance =>
+            null;
+         when others =>
+            Failed ("Get/Set_Declaration", N);
+      end case;
+   end Check_Kind_For_Declaration;
+
+   function Get_Declaration (N : Node) return Node is
+   begin
+      Check_Kind_For_Declaration (N);
+      return Node (Get_Field1 (N));
+   end Get_Declaration;
+
+   procedure Set_Declaration (N : Node; Decl : Node) is
+   begin
+      Check_Kind_For_Declaration (N);
+      Set_Field1 (N, Int32 (Decl));
+   end Set_Declaration;
+
+   procedure Check_Kind_For_Association_Chain (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Sequence_Instance
+           | N_Endpoint_Instance
+           | N_Property_Instance =>
+            null;
+         when others =>
+            Failed ("Get/Set_Association_Chain", N);
+      end case;
+   end Check_Kind_For_Association_Chain;
+
+   function Get_Association_Chain (N : Node) return Node is
+   begin
+      Check_Kind_For_Association_Chain (N);
+      return Node (Get_Field2 (N));
+   end Get_Association_Chain;
+
+   procedure Set_Association_Chain (N : Node; Chain : Node) is
+   begin
+      Check_Kind_For_Association_Chain (N);
+      Set_Field2 (N, Int32 (Chain));
+   end Set_Association_Chain;
+
+   procedure Check_Kind_For_Formal (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Actual =>
+            null;
+         when others =>
+            Failed ("Get/Set_Formal", N);
+      end case;
+   end Check_Kind_For_Formal;
+
+   function Get_Formal (N : Node) return Node is
+   begin
+      Check_Kind_For_Formal (N);
+      return Node (Get_Field4 (N));
+   end Get_Formal;
+
+   procedure Set_Formal (N : Node; E : Node) is
+   begin
+      Check_Kind_For_Formal (N);
+      Set_Field4 (N, Int32 (E));
+   end Set_Formal;
+
+   procedure Check_Kind_For_Boolean (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Clock_Event
+           | N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Abort
+           | N_Not_Bool =>
+            null;
+         when others =>
+            Failed ("Get/Set_Boolean", N);
+      end case;
+   end Check_Kind_For_Boolean;
+
+   function Get_Boolean (N : Node) return Node is
+   begin
+      Check_Kind_For_Boolean (N);
+      return Node (Get_Field3 (N));
+   end Get_Boolean;
+
+   procedure Set_Boolean (N : Node; B : Node) is
+   begin
+      Check_Kind_For_Boolean (N);
+      Set_Field3 (N, Int32 (B));
+   end Set_Boolean;
+
+   procedure Check_Kind_For_Strong_Flag (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Next
+           | N_Next_A
+           | N_Next_E
+           | N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Until
+           | N_Before =>
+            null;
+         when others =>
+            Failed ("Get/Set_Strong_Flag", N);
+      end case;
+   end Check_Kind_For_Strong_Flag;
+
+   function Get_Strong_Flag (N : Node) return Boolean is
+   begin
+      Check_Kind_For_Strong_Flag (N);
+      return Get_Flag1 (N);
+   end Get_Strong_Flag;
+
+   procedure Set_Strong_Flag (N : Node; B : Boolean) is
+   begin
+      Check_Kind_For_Strong_Flag (N);
+      Set_Flag1 (N, B);
+   end Set_Strong_Flag;
+
+   procedure Check_Kind_For_Number (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Next
+           | N_Next_Event =>
+            null;
+         when others =>
+            Failed ("Get/Set_Number", N);
+      end case;
+   end Check_Kind_For_Number;
+
+   function Get_Number (N : Node) return Node is
+   begin
+      Check_Kind_For_Number (N);
+      return Node (Get_Field1 (N));
+   end Get_Number;
+
+   procedure Set_Number (N : Node; S : Node) is
+   begin
+      Check_Kind_For_Number (N);
+      Set_Field1 (N, Int32 (S));
+   end Set_Number;
+
+   procedure Check_Kind_For_Decl (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Name =>
+            null;
+         when others =>
+            Failed ("Get/Set_Decl", N);
+      end case;
+   end Check_Kind_For_Decl;
+
+   function Get_Decl (N : Node) return Node is
+   begin
+      Check_Kind_For_Decl (N);
+      return Node (Get_Field2 (N));
+   end Get_Decl;
+
+   procedure Set_Decl (N : Node; D : Node) is
+   begin
+      Check_Kind_For_Decl (N);
+      Set_Field2 (N, Int32 (D));
+   end Set_Decl;
+
+   procedure Check_Kind_For_Value (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Number =>
+            null;
+         when others =>
+            Failed ("Get/Set_Value", N);
+      end case;
+   end Check_Kind_For_Value;
+
+   function Get_Value (N : Node) return Uns32 is
+   begin
+      Check_Kind_For_Value (N);
+      return Int32_To_Uns32 (Get_Field1 (N));
+   end Get_Value;
+
+   procedure Set_Value (N : Node; Val : Uns32) is
+   begin
+      Check_Kind_For_Value (N);
+      Set_Field1 (N, Uns32_To_Int32 (Val));
+   end Set_Value;
+
+   procedure Check_Kind_For_SERE (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Braced_SERE =>
+            null;
+         when others =>
+            Failed ("Get/Set_SERE", N);
+      end case;
+   end Check_Kind_For_SERE;
+
+   function Get_SERE (N : Node) return Node is
+   begin
+      Check_Kind_For_SERE (N);
+      return Node (Get_Field1 (N));
+   end Get_SERE;
+
+   procedure Set_SERE (N : Node; S : Node) is
+   begin
+      Check_Kind_For_SERE (N);
+      Set_Field1 (N, Int32 (S));
+   end Set_SERE;
+
+   procedure Check_Kind_For_Left (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Log_Imp_Prop
+           | N_Until
+           | N_Before
+           | N_Or_Prop
+           | N_And_Prop
+           | N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Within_SERE
+           | N_Match_And_Seq
+           | N_And_Seq
+           | N_Or_Seq
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool =>
+            null;
+         when others =>
+            Failed ("Get/Set_Left", N);
+      end case;
+   end Check_Kind_For_Left;
+
+   function Get_Left (N : Node) return Node is
+   begin
+      Check_Kind_For_Left (N);
+      return Node (Get_Field1 (N));
+   end Get_Left;
+
+   procedure Set_Left (N : Node; S : Node) is
+   begin
+      Check_Kind_For_Left (N);
+      Set_Field1 (N, Int32 (S));
+   end Set_Left;
+
+   procedure Check_Kind_For_Right (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Log_Imp_Prop
+           | N_Until
+           | N_Before
+           | N_Or_Prop
+           | N_And_Prop
+           | N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Within_SERE
+           | N_Match_And_Seq
+           | N_And_Seq
+           | N_Or_Seq
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool =>
+            null;
+         when others =>
+            Failed ("Get/Set_Right", N);
+      end case;
+   end Check_Kind_For_Right;
+
+   function Get_Right (N : Node) return Node is
+   begin
+      Check_Kind_For_Right (N);
+      return Node (Get_Field2 (N));
+   end Get_Right;
+
+   procedure Set_Right (N : Node; S : Node) is
+   begin
+      Check_Kind_For_Right (N);
+      Set_Field2 (N, Int32 (S));
+   end Set_Right;
+
+   procedure Check_Kind_For_Low_Bound (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Next_A
+           | N_Next_E
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq =>
+            null;
+         when others =>
+            Failed ("Get/Set_Low_Bound", N);
+      end case;
+   end Check_Kind_For_Low_Bound;
+
+   function Get_Low_Bound (N : Node) return Node is
+   begin
+      Check_Kind_For_Low_Bound (N);
+      return Node (Get_Field1 (N));
+   end Get_Low_Bound;
+
+   procedure Set_Low_Bound (N : Node; S : Node) is
+   begin
+      Check_Kind_For_Low_Bound (N);
+      Set_Field1 (N, Int32 (S));
+   end Set_Low_Bound;
+
+   procedure Check_Kind_For_High_Bound (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Next_A
+           | N_Next_E
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq =>
+            null;
+         when others =>
+            Failed ("Get/Set_High_Bound", N);
+      end case;
+   end Check_Kind_For_High_Bound;
+
+   function Get_High_Bound (N : Node) return Node is
+   begin
+      Check_Kind_For_High_Bound (N);
+      return Node (Get_Field2 (N));
+   end Get_High_Bound;
+
+   procedure Set_High_Bound (N : Node; S : Node) is
+   begin
+      Check_Kind_For_High_Bound (N);
+      Set_Field2 (N, Int32 (S));
+   end Set_High_Bound;
+
+   procedure Check_Kind_For_Inclusive_Flag (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Until
+           | N_Before =>
+            null;
+         when others =>
+            Failed ("Get/Set_Inclusive_Flag", N);
+      end case;
+   end Check_Kind_For_Inclusive_Flag;
+
+   function Get_Inclusive_Flag (N : Node) return Boolean is
+   begin
+      Check_Kind_For_Inclusive_Flag (N);
+      return Get_Flag2 (N);
+   end Get_Inclusive_Flag;
+
+   procedure Set_Inclusive_Flag (N : Node; B : Boolean) is
+   begin
+      Check_Kind_For_Inclusive_Flag (N);
+      Set_Flag2 (N, B);
+   end Set_Inclusive_Flag;
+
+   procedure Check_Kind_For_Presence (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Not_Bool
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool
+           | N_HDL_Expr =>
+            null;
+         when others =>
+            Failed ("Get/Set_Presence", N);
+      end case;
+   end Check_Kind_For_Presence;
+
+   function Get_Presence (N : Node) return PSL_Presence_Kind is
+   begin
+      Check_Kind_For_Presence (N);
+      return PSL_Presence_Kind'Val(Get_State1 (N));
+   end Get_Presence;
+
+   procedure Set_Presence (N : Node; P : PSL_Presence_Kind) is
+   begin
+      Check_Kind_For_Presence (N);
+      Set_State1 (N, PSL_Presence_Kind'pos (P));
+   end Set_Presence;
+
+   procedure Check_Kind_For_HDL_Node (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr =>
+            null;
+         when others =>
+            Failed ("Get/Set_HDL_Node", N);
+      end case;
+   end Check_Kind_For_HDL_Node;
+
+   function Get_HDL_Node (N : Node) return HDL_Node is
+   begin
+      Check_Kind_For_HDL_Node (N);
+      return Get_Field1 (N);
+   end Get_HDL_Node;
+
+   procedure Set_HDL_Node (N : Node; H : HDL_Node) is
+   begin
+      Check_Kind_For_HDL_Node (N);
+      Set_Field1 (N, H);
+   end Set_HDL_Node;
+
+   procedure Check_Kind_For_HDL_Index (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr
+           | N_EOS =>
+            null;
+         when others =>
+            Failed ("Get/Set_HDL_Index", N);
+      end case;
+   end Check_Kind_For_HDL_Index;
+
+   function Get_HDL_Index (N : Node) return Int32 is
+   begin
+      Check_Kind_For_HDL_Index (N);
+      return Get_Field2 (N);
+   end Get_HDL_Index;
+
+   procedure Set_HDL_Index (N : Node; Idx : Int32) is
+   begin
+      Check_Kind_For_HDL_Index (N);
+      Set_Field2 (N, Idx);
+   end Set_HDL_Index;
+
+   procedure Check_Kind_For_Hash (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Not_Bool
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool
+           | N_HDL_Expr
+           | N_EOS =>
+            null;
+         when others =>
+            Failed ("Get/Set_Hash", N);
+      end case;
+   end Check_Kind_For_Hash;
+
+   function Get_Hash (N : Node) return Uns32 is
+   begin
+      Check_Kind_For_Hash (N);
+      return Int32_To_Uns32 (Get_Field5 (N));
+   end Get_Hash;
+
+   procedure Set_Hash (N : Node; E : Uns32) is
+   begin
+      Check_Kind_For_Hash (N);
+      Set_Field5 (N, Uns32_To_Int32 (E));
+   end Set_Hash;
+
+   procedure Check_Kind_For_Hash_Link (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Not_Bool
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool
+           | N_HDL_Expr
+           | N_EOS =>
+            null;
+         when others =>
+            Failed ("Get/Set_Hash_Link", N);
+      end case;
+   end Check_Kind_For_Hash_Link;
+
+   function Get_Hash_Link (N : Node) return Node is
+   begin
+      Check_Kind_For_Hash_Link (N);
+      return Node (Get_Field6 (N));
+   end Get_Hash_Link;
+
+   procedure Set_Hash_Link (N : Node; E : Node) is
+   begin
+      Check_Kind_For_Hash_Link (N);
+      Set_Field6 (N, Int32 (E));
+   end Set_Hash_Link;
+
+
+end PSL.Nodes;
+
diff --git a/src/psl/psl-nodes.ads b/src/psl/psl-nodes.ads
new file mode 100644
index 000000000..241091805
--- /dev/null
+++ b/src/psl/psl-nodes.ads
@@ -0,0 +1,563 @@
+with Types; use Types;
+
+package PSL.Nodes is
+   type Nkind is
+     (
+      N_Error,
+
+      N_Vmode,
+      N_Vunit,
+      N_Vprop,
+
+      N_Hdl_Mod_Name,
+
+      N_Assert_Directive,
+      N_Property_Declaration,
+      N_Sequence_Declaration,
+      N_Endpoint_Declaration,
+
+      --  Formal parameters
+      N_Const_Parameter,
+      N_Boolean_Parameter,
+      N_Property_Parameter,
+      N_Sequence_Parameter,
+
+      N_Sequence_Instance,
+      N_Endpoint_Instance,
+      N_Property_Instance,
+      N_Actual,
+
+      N_Clock_Event,
+
+      --  Properties
+      N_Always,
+      N_Never,
+      N_Eventually,
+      N_Strong,          --  !
+      N_Imp_Seq,         --  |=>
+      N_Overlap_Imp_Seq, --  |->
+      N_Log_Imp_Prop,    --  ->
+      N_Next,
+      N_Next_A,
+      N_Next_E,
+      N_Next_Event,
+      N_Next_Event_A,
+      N_Next_Event_E,
+      N_Abort,
+      N_Until,
+      N_Before,
+      N_Or_Prop,
+      N_And_Prop,
+
+      --  Sequences/SERE.
+      N_Braced_SERE,
+      N_Concat_SERE,
+      N_Fusion_SERE,
+      N_Within_SERE,
+
+      N_Match_And_Seq,  --  &&
+      N_And_Seq,
+      N_Or_Seq,
+
+      N_Star_Repeat_Seq,
+      N_Goto_Repeat_Seq,
+      N_Plus_Repeat_Seq, -- [+]
+      N_Equal_Repeat_Seq,
+
+      --  Boolean layer.
+      N_Not_Bool,
+      N_And_Bool,
+      N_Or_Bool,
+      N_Imp_Bool,       -- ->
+      N_HDL_Expr,
+      N_False,
+      N_True,
+      N_EOS,
+
+      N_Name,
+      N_Name_Decl,
+      N_Number
+      );
+   for Nkind'Size use 8;
+
+   subtype N_Booleans is Nkind range N_Not_Bool .. N_True;
+   subtype N_Sequences is Nkind range N_Braced_SERE .. N_Equal_Repeat_Seq;
+
+   type PSL_Types is
+     (
+      Type_Unknown,
+      Type_Boolean,
+      Type_Bit,
+      Type_Bitvector,
+      Type_Numeric,
+      Type_String,
+      Type_Sequence,
+      Type_Property
+     );
+
+   --  Within CSE, it is useful to know which sub-expression already compose
+   --  an expression.
+   --  Eg: suppose we want to build A and B.
+   --  Each sub-expressions of B is marked either as Present_Pos or
+   --  Present_Neg.
+   --  If A is already present, return either B or FALSE.
+   --  Otherwise, build the node.
+   type PSL_Presence_Kind is
+     (
+      Present_Unknown,
+      Present_Pos,
+      Present_Neg
+     );
+
+   --  Start of nodes:
+
+   --  N_Error (Short)
+
+   --  N_Vmode (Short)
+   --  N_Vunit (Short)
+   --  N_Vprop (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  Get/Set_Instance (Field3)
+   --
+   --  Get/Set_Item_Chain (Field4)
+
+   --  N_Hdl_Mod_Name (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Prefix (Field2)
+
+   --  N_Assert_Directive (Short)
+   --
+   --  Get/Set_Label (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  Get/Set_String (Field3)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_NFA (Field5)
+
+   --  N_Property_Declaration (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  Get/Set_Global_Clock (Field3)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_Parameter_List (Field5)
+
+   --  N_Sequence_Declaration (Short)
+   --  N_Endpoint_Declaration (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  Get/Set_Sequence (Field3)
+   --
+   --  Get/Set_Parameter_List (Field5)
+
+   --  N_Const_Parameter (Short)
+   --  N_Boolean_Parameter (Short)
+   --  N_Property_Parameter (Short)
+   --  N_Sequence_Parameter (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  --  Current actual parameter.
+   --  Get/Set_Actual (Field3)
+
+   --  N_Sequence_Instance (Short)
+   --  N_Endpoint_Instance (Short)
+   --  N_Property_Instance (Short)
+   --
+   --  Get/Set_Declaration (Field1) [Flat]
+   --
+   --  Get/Set_Association_Chain (Field2)
+
+   --  N_Actual (Short)
+   --
+   --  Get/Set_Chain (Field2)
+   --
+   --  Get/Set_Actual (Field3)
+   --
+   --  Get/Set_Formal (Field4)
+
+   --  N_Clock_Event (Short)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_Boolean (Field3)
+
+   --  N_Always (Short)
+   --  N_Never (Short)
+   --  N_Eventually (Short)
+   --  N_Strong (Short)
+   --
+   --  Get/Set_Property (Field4)
+
+   --  N_Next (Short)
+   --
+   --  Get/Set_Strong_Flag (Flag1)
+   --
+   --  Get/Set_Number (Field1)
+   --
+   --  Get/Set_Property (Field4)
+
+   --  N_Name (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Decl (Field2)
+
+   --  N_Name_Decl (Short)
+   --
+   --  Get/Set_Identifier (Field1)
+   --
+   --  Get/Set_Chain (Field2)
+
+   --  N_Number (Short)
+   --
+   --  Get/Set_Value (Field1)
+
+   --  N_Braced_SERE (Short)
+   --
+   --  Get/Set_SERE (Field1)
+
+   --  N_Concat_SERE (Short)
+   --  N_Fusion_SERE (Short)
+   --  N_Within_SERE (Short)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+
+   --  N_Star_Repeat_Seq (Short)
+   --  N_Goto_Repeat_Seq (Short)
+   --  N_Equal_Repeat_Seq (Short)
+   --
+   --  Note: can be null_node for star_repeat_seq.
+   --  Get/Set_Sequence (Field3)
+   --
+   --  Get/Set_Low_Bound (Field1)
+   --
+   --  Get/Set_High_Bound (Field2)
+
+   --  N_Plus_Repeat_Seq (Short)
+   --
+   --  Note: can be null_node.
+   --  Get/Set_Sequence (Field3)
+
+   --  N_Match_And_Seq (Short)
+   --  N_And_Seq (Short)
+   --  N_Or_Seq (Short)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+
+   --  N_Imp_Seq (Short)
+   --  N_Overlap_Imp_Seq (Short)
+   --
+   --  Get/Set_Sequence (Field3)
+   --
+   --  Get/Set_Property (Field4)
+
+   --  N_Log_Imp_Prop (Short)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+
+   --  N_Next_A (Short)
+   --  N_Next_E (Short)
+   --
+   --  Get/Set_Strong_Flag (Flag1)
+   --
+   --  Get/Set_Low_Bound (Field1)
+   --
+   --  Get/Set_High_Bound (Field2)
+   --
+   --  Get/Set_Property (Field4)
+
+   --  N_Next_Event (Short)
+   --
+   --  Get/Set_Strong_Flag (Flag1)
+   --
+   --  Get/Set_Number (Field1)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_Boolean (Field3)
+
+   --  N_Or_Prop (Short)
+   --  N_And_Prop (Short)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+
+   --  N_Until (Short)
+   --  N_Before (Short)
+   --
+   --  Get/Set_Strong_Flag (Flag1)
+   --
+   --  Get/Set_Inclusive_Flag (Flag2)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+
+   --  N_Next_Event_A (Short)
+   --  N_Next_Event_E (Short)
+   --
+   --  Get/Set_Strong_Flag (Flag1)
+   --
+   --  Get/Set_Low_Bound (Field1)
+   --
+   --  Get/Set_High_Bound (Field2)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_Boolean (Field3)
+
+   --  N_Abort (Short)
+   --
+   --  Get/Set_Property (Field4)
+   --
+   --  Get/Set_Boolean (Field3)
+
+
+   --  N_HDL_Expr (Short)
+   --
+   --  Get/Set_Presence (State1)
+   --
+   --  Get/Set_HDL_Node (Field1)
+   --
+   --  Get/Set_HDL_Index (Field2)
+   --
+   --  Get/Set_Hash (Field5)
+   --
+   --  Get/Set_Hash_Link (Field6)
+
+   --  N_Not_Bool (Short)
+   --
+   --  Get/Set_Presence (State1)
+   --
+   --  Get/Set_Boolean (Field3)
+   --
+   --  Get/Set_Hash (Field5)
+   --
+   --  Get/Set_Hash_Link (Field6)
+
+   --  N_And_Bool (Short)
+   --  N_Or_Bool (Short)
+   --  N_Imp_Bool (Short)
+   --
+   --  Get/Set_Presence (State1)
+   --
+   --  Get/Set_Left (Field1)
+   --
+   --  Get/Set_Right (Field2)
+   --
+   --  Get/Set_Hash (Field5)
+   --
+   --  Get/Set_Hash_Link (Field6)
+
+   --  N_True (Short)
+   --  N_False (Short)
+
+   --  N_EOS (Short)
+   --  End of simulation.
+   --
+   --  Get/Set_HDL_Index (Field2)
+   --
+   --  Get/Set_Hash (Field5)
+   --
+   --  Get/Set_Hash_Link (Field6)
+
+   --  End of nodes.
+
+   subtype Node is Types.PSL_Node;
+
+   Null_Node  : constant Node := 0;
+   False_Node : constant Node := 1;
+   True_Node  : constant Node := 2;
+   One_Node   : constant Node := 3;
+   EOS_Node   : constant Node := 4;
+
+   subtype NFA is Types.PSL_NFA;
+
+   subtype HDL_Node is Types.Int32;
+   HDL_Null : constant HDL_Node := 0;
+
+   procedure Init;
+
+   --  Get the number of the last node.
+   --  To be used to size lateral tables.
+   function Get_Last_Node return Node;
+
+   -- subtype Regs_Type_Node is Node range Reg_Type_Node .. Time_Type_Node;
+
+   function Create_Node (Kind : Nkind) return Node;
+   procedure Free_Node (N : Node);
+
+   --  Return the type of a node.
+   function Get_Psl_Type (N : Node) return PSL_Types;
+
+   --  Field: Location
+   function Get_Location (N : Node) return Location_Type;
+   procedure Set_Location (N : Node; Loc : Location_Type);
+
+   function Get_Kind (N : Node) return Nkind;
+   pragma Inline (Get_Kind);
+
+--   --  Disp: None
+--   --  Field: Field6
+--   function Get_Parent (N : Node) return Node;
+--   procedure Set_Parent (N : Node; Parent : Node);
+
+   --  Disp: Special
+   --  Field: Field1 (conv)
+   function Get_Identifier (N : Node) return Name_Id;
+   procedure Set_Identifier (N : Node; Id : Name_Id);
+
+   --  Disp: Special
+   --  Field: Field1 (conv)
+   function Get_Label (N : Node) return Name_Id;
+   procedure Set_Label (N : Node; Id : Name_Id);
+
+   --  Disp: Chain
+   --  Field: Field2 (conv)
+   function Get_Chain (N : Node) return Node;
+   procedure Set_Chain (N : Node; Chain : Node);
+
+   --  Field: Field3 (conv)
+   function Get_Instance (N : Node) return Node;
+   procedure Set_Instance (N : Node; Instance : Node);
+
+   --  Field: Field2 (conv)
+   function Get_Prefix (N : Node) return Node;
+   procedure Set_Prefix (N : Node; Prefix : Node);
+
+   --  Field: Field4 (conv)
+   function Get_Item_Chain (N : Node) return Node;
+   procedure Set_Item_Chain (N : Node; Item : Node);
+
+   --  Field: Field4 (conv)
+   function Get_Property (N : Node) return Node;
+   procedure Set_Property (N : Node; Property : Node);
+
+   --  Field: Field3 (conv)
+   function Get_String (N : Node) return Node;
+   procedure Set_String (N : Node; Str : Node);
+
+   --  Field: Field1 (conv)
+   function Get_SERE (N : Node) return Node;
+   procedure Set_SERE (N : Node; S : Node);
+
+   --  Field: Field1 (conv)
+   function Get_Left (N : Node) return Node;
+   procedure Set_Left (N : Node; S : Node);
+
+   --  Field: Field2 (conv)
+   function Get_Right (N : Node) return Node;
+   procedure Set_Right (N : Node; S : Node);
+
+   --  Field: Field3 (conv)
+   function Get_Sequence (N : Node) return Node;
+   procedure Set_Sequence (N : Node; S : Node);
+
+   --  Field: Flag1
+   function Get_Strong_Flag (N : Node) return Boolean;
+   procedure Set_Strong_Flag (N : Node; B : Boolean);
+
+   --  Field: Flag2
+   function Get_Inclusive_Flag (N : Node) return Boolean;
+   procedure Set_Inclusive_Flag (N : Node; B : Boolean);
+
+   --  Field: Field1 (conv)
+   function Get_Low_Bound (N : Node) return Node;
+   procedure Set_Low_Bound (N : Node; S : Node);
+
+   --  Field: Field2 (conv)
+   function Get_High_Bound (N : Node) return Node;
+   procedure Set_High_Bound (N : Node; S : Node);
+
+   --  Field: Field1 (conv)
+   function Get_Number (N : Node) return Node;
+   procedure Set_Number (N : Node; S : Node);
+
+   --  Field: Field1 (uc)
+   function Get_Value (N : Node) return Uns32;
+   procedure Set_Value (N : Node; Val : Uns32);
+
+   --  Field: Field3 (conv)
+   function Get_Boolean (N : Node) return Node;
+   procedure Set_Boolean (N : Node; B : Node);
+
+   --  Field: Field2 (conv)
+   function Get_Decl (N : Node) return Node;
+   procedure Set_Decl (N : Node; D : Node);
+
+   --  Field: Field1 (conv)
+   function Get_HDL_Node (N : Node) return HDL_Node;
+   procedure Set_HDL_Node (N : Node; H : HDL_Node);
+
+   --  Field: Field5 (uc)
+   function Get_Hash (N : Node) return Uns32;
+   procedure Set_Hash (N : Node; E : Uns32);
+   pragma Inline (Get_Hash);
+
+   --  Field: Field6 (conv)
+   function Get_Hash_Link (N : Node) return Node;
+   procedure Set_Hash_Link (N : Node; E : Node);
+   pragma Inline (Get_Hash_Link);
+
+   --  Field: Field2
+   function Get_HDL_Index (N : Node) return Int32;
+   procedure Set_HDL_Index (N : Node; Idx : Int32);
+
+   --  Field: State1 (pos)
+   function Get_Presence (N : Node) return PSL_Presence_Kind;
+   procedure Set_Presence (N : Node; P : PSL_Presence_Kind);
+
+   --  Field: Field5 (uc)
+   function Get_NFA (N : Node) return NFA;
+   procedure Set_NFA (N : Node; P : NFA);
+
+   --  Field: Field5 (conv)
+   function Get_Parameter_List (N : Node) return Node;
+   procedure Set_Parameter_List (N : Node; E : Node);
+
+   --  Field: Field3 (conv)
+   function Get_Actual (N : Node) return Node;
+   procedure Set_Actual (N : Node; E : Node);
+
+   --  Field: Field4 (conv)
+   function Get_Formal (N : Node) return Node;
+   procedure Set_Formal (N : Node; E : Node);
+
+   --  Field: Field1 (conv)
+   function Get_Declaration (N : Node) return Node;
+   procedure Set_Declaration (N : Node; Decl : Node);
+
+   --  Field: Field2 (conv)
+   function Get_Association_Chain (N : Node) return Node;
+   procedure Set_Association_Chain (N : Node; Chain : Node);
+
+   --  Field: Field3 (conv)
+   function Get_Global_Clock (N : Node) return Node;
+   procedure Set_Global_Clock (N : Node; Clock : Node);
+end PSL.Nodes;
diff --git a/src/psl/psl-optimize.adb b/src/psl/psl-optimize.adb
new file mode 100644
index 000000000..4ca62b89e
--- /dev/null
+++ b/src/psl/psl-optimize.adb
@@ -0,0 +1,460 @@
+with Types; use Types;
+with PSL.NFAs.Utils; use PSL.NFAs.Utils;
+with PSL.CSE;
+
+package body PSL.Optimize is
+   procedure Push (Head : in out NFA_State; S : NFA_State) is
+   begin
+      Set_State_User_Link (S, Head);
+      Head := S;
+   end Push;
+
+   procedure Pop (Head : in out NFA_State; S : out NFA_State) is
+   begin
+      S := Head;
+      Head := Get_State_User_Link (S);
+   end Pop;
+
+   procedure Remove_Unreachable_States (N : NFA)
+   is
+      Head : NFA_State;
+      Start, Final : NFA_State;
+      E : NFA_Edge;
+      S, N_S : NFA_State;
+   begin
+      --  Remove unreachable states, ie states that can't be reached from
+      --  start state.
+      Start := Get_Start_State (N);
+      Final := Get_Final_State (N);
+
+      Head := No_State;
+
+      --  The start state is reachable.
+      Push (Head, Start);
+      Set_State_Flag (Start, True);
+
+      --  Follow edges and mark reachable states.
+      while Head /= No_State loop
+         Pop (Head, S);
+         E := Get_First_Src_Edge (S);
+         while E /= No_Edge loop
+            S := Get_Edge_Dest (E);
+            if not Get_State_Flag (S) then
+               Push (Head, S);
+               Set_State_Flag (S, True);
+            end if;
+            E := Get_Next_Src_Edge (E);
+         end loop;
+      end loop;
+
+      --  Remove unreachable states.
+      S := Get_First_State (N);
+      while S /= No_State loop
+         N_S := Get_Next_State (S);
+         if Get_State_Flag (S) then
+            --  Clean-up.
+            Set_State_Flag (S, False);
+         elsif S = Final then
+            --  Do not remove final state!
+            --  FIXME: deconnect state?
+            null;
+         else
+            Remove_State (N, S);
+         end if;
+         S := N_S;
+      end loop;
+
+      --  Remove no-where states, ie states that can't reach the final state.
+      Head := No_State;
+
+      --  The final state can reach the final state.
+      Push (Head, Final);
+      Set_State_Flag (Final, True);
+
+      --  Follow edges and mark reachable states.
+      while Head /= No_State loop
+         Pop (Head, S);
+         E := Get_First_Dest_Edge (S);
+         while E /= No_Edge loop
+            S := Get_Edge_Src (E);
+            if not Get_State_Flag (S) then
+               Push (Head, S);
+               Set_State_Flag (S, True);
+            end if;
+            E := Get_Next_Dest_Edge (E);
+         end loop;
+      end loop;
+
+      --  Remove unreachable states.
+      S := Get_First_State (N);
+      while S /= No_State loop
+         N_S := Get_Next_State (S);
+         if Get_State_Flag (S) then
+            --  Clean-up.
+            Set_State_Flag (S, False);
+         elsif S = Start then
+            --  Do not remove start state!
+            --  FIXME: deconnect state?
+            null;
+         else
+            Remove_State (N, S);
+         end if;
+         S := N_S;
+      end loop;
+   end Remove_Unreachable_States;
+
+   procedure Remove_Simple_Prefix (N : NFA)
+   is
+      Start : NFA_State;
+      D : NFA_State;
+      T_Start, T_D, Next_T_D : NFA_Edge;
+      T_Expr : Node;
+      Clean : Boolean := False;
+   begin
+      Start := Get_Start_State (N);
+
+      --  Iterate on edges from the start state.
+      T_Start := Get_First_Src_Edge (Start);
+      while T_Start /= No_Edge loop
+         --  Edge destination.
+         D := Get_Edge_Dest (T_Start);
+         T_Expr := Get_Edge_Expr (T_Start);
+
+         --  Iterate on destination incoming edges.
+         T_D := Get_First_Dest_Edge (D);
+         while T_D /= No_Edge loop
+            Next_T_D := Get_Next_Dest_Edge (T_D);
+            --  Remove parallel edge.
+            if T_D /= T_Start
+              and then Get_Edge_Expr (T_D) = T_Expr
+            then
+               Remove_Edge (T_D);
+               Clean := True;
+            end if;
+            T_D := Next_T_D;
+         end loop;
+         T_Start := Get_Next_Src_Edge (T_Start);
+      end loop;
+      if Clean then
+         Remove_Unreachable_States (N);
+      end if;
+   end Remove_Simple_Prefix;
+
+   --  Return TRUE iff the outgoing or incoming edges of L and R are the same.
+   --  Outgoing edges must be sorted.
+   generic
+      with function Get_First_Edge (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge (E : NFA_Edge) return NFA_Edge;
+      with function Get_Edge_State_Reverse (E : NFA_Edge) return NFA_State;
+   function Are_States_Identical_Gen (L, R : NFA_State) return Boolean;
+
+   function Are_States_Identical_Gen (L, R : NFA_State) return Boolean
+   is
+      L_E, R_E : NFA_Edge;
+      L_S, R_S : NFA_State;
+   begin
+      L_E := Get_First_Edge (L);
+      R_E := Get_First_Edge (R);
+      loop
+         if L_E = No_Edge and then R_E = No_Edge then
+            --  End of chain for both L and R -> identical states.
+            return True;
+         elsif L_E = No_Edge or R_E = No_Edge then
+            --  End of chain for either L or R -> non identical states.
+            return False;
+         elsif Get_Edge_Expr (L_E) /= Get_Edge_Expr (R_E) then
+            --  Different edge (different expressions).
+            return False;
+         end if;
+         L_S := Get_Edge_State_Reverse (L_E);
+         R_S := Get_Edge_State_Reverse (R_E);
+         if L_S /= R_S and then (L_S /= L or else R_S /= R) then
+            --  Predecessors are differents and not loop.
+            return False;
+         end if;
+         L_E := Get_Next_Edge (L_E);
+         R_E := Get_Next_Edge (R_E);
+      end loop;
+   end Are_States_Identical_Gen;
+
+   generic
+      with procedure Sort_Edges (N : NFA);
+      with procedure Sort_Edges_Reverse (S : NFA_State);
+      with function Get_First_Edge (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge (E : NFA_Edge) return NFA_Edge;
+      with function Get_First_Edge_Reverse (S : NFA_State) return NFA_Edge;
+      with function Get_Next_Edge_Reverse (E : NFA_Edge) return NFA_Edge;
+      with function Get_Edge_State (E : NFA_Edge) return NFA_State;
+      with function Get_Edge_State_Reverse (E : NFA_Edge) return NFA_State;
+      with procedure Merge_State_Reverse (N : NFA;
+                                          S : NFA_State; S1 : NFA_State);
+   procedure Merge_Identical_States_Gen (N : NFA);
+
+   procedure Merge_Identical_States_Gen (N : NFA)
+   is
+      function Are_States_Identical is new Are_States_Identical_Gen
+        (Get_First_Edge => Get_First_Edge,
+         Get_Next_Edge => Get_Next_Edge,
+         Get_Edge_State_Reverse => Get_Edge_State_Reverse);
+
+      S : NFA_State;
+      E : NFA_Edge;
+      E_State, Next_E_State : NFA_State;
+      Next_E, Next_Next_E : NFA_Edge;
+   begin
+      Sort_Edges (N);
+
+      --  Iterate on states.
+      S := Get_First_State (N);
+      while S /= No_State loop
+         Sort_Edges_Reverse (S);
+
+         --  Iterate on incoming edges.
+         E := Get_First_Edge_Reverse (S);
+         while E /= No_Edge loop
+            E_State := Get_Edge_State (E);
+
+            --  Try to merge E with its successors.
+            Next_E := Get_Next_Edge_Reverse (E);
+            while Next_E /= No_Edge
+              and then Get_Edge_Expr (E) = Get_Edge_Expr (Next_E)
+            loop
+               Next_E_State := Get_Edge_State (Next_E);
+               Next_Next_E := Get_Next_Edge_Reverse (Next_E);
+               if Next_E_State = E_State then
+                  --  Identical edge: remove the duplicate.
+                  Remove_Edge (Next_E);
+               elsif Are_States_Identical (E_State, Next_E_State) then
+                  Merge_State_Reverse (N, E_State, Next_E_State);
+               end if;
+               Next_E := Next_Next_E;
+            end loop;
+
+            E := Get_Next_Edge_Reverse (E);
+         end loop;
+
+         S := Get_Next_State (S);
+      end loop;
+   end Merge_Identical_States_Gen;
+
+   procedure Merge_Identical_States_Src is new Merge_Identical_States_Gen
+     (Sort_Edges => Sort_Src_Edges,
+      Sort_Edges_Reverse => Sort_Dest_Edges,
+      Get_First_Edge => Get_First_Src_Edge,
+      Get_Next_Edge => Get_Next_Src_Edge,
+      Get_First_Edge_Reverse => Get_First_Dest_Edge,
+      Get_Next_Edge_Reverse => Get_Next_Dest_Edge,
+      Get_Edge_State => Get_Edge_Src,
+      Get_Edge_State_Reverse => Get_Edge_Dest,
+      Merge_State_Reverse => Merge_State_Dest);
+
+   procedure Merge_Identical_States_Dest is new Merge_Identical_States_Gen
+     (Sort_Edges => Sort_Dest_Edges,
+      Sort_Edges_Reverse => Sort_Src_Edges,
+      Get_First_Edge => Get_First_Dest_Edge,
+      Get_Next_Edge => Get_Next_Dest_Edge,
+      Get_First_Edge_Reverse => Get_First_Src_Edge,
+      Get_Next_Edge_Reverse => Get_Next_Src_Edge,
+      Get_Edge_State => Get_Edge_Dest,
+      Get_Edge_State_Reverse => Get_Edge_Src,
+      Merge_State_Reverse => Merge_State_Src);
+
+   procedure Merge_Identical_States (N : NFA) is
+   begin
+      Merge_Identical_States_Src (N);
+      Merge_Identical_States_Dest (N);
+   end Merge_Identical_States;
+
+   procedure Merge_Edges (N : NFA)
+   is
+      use PSL.CSE;
+      Nbr_States : Natural;
+   begin
+      Labelize_States (N, Nbr_States);
+      declare
+         Last_State : constant Int32 := Int32 (Nbr_States) - 1;
+         type Edge_Array is array (0 .. Last_State) of NFA_Edge;
+         Edges : Edge_Array;
+         S, D : NFA_State;
+         L_D : Int32;
+         E, Next_E : NFA_Edge;
+      begin
+         --  Iterate on states.
+         S := Get_First_State (N);
+         while S /= No_State loop
+
+            Edges := (others => No_Edge);
+            E := Get_First_Src_Edge (S);
+            while E /= No_Edge loop
+               Next_E := Get_Next_Src_Edge (E);
+               D := Get_Edge_Dest (E);
+               L_D := Get_State_Label (D);
+               if Edges (L_D) /= No_Edge then
+                  Set_Edge_Expr
+                    (Edges (L_D),
+                     Build_Bool_Or (Get_Edge_Expr (Edges (L_D)),
+                                    Get_Edge_Expr (E)));
+                  --  FIXME: reduce expression.
+                  Remove_Edge (E);
+               else
+                  Edges (L_D) := E;
+               end if;
+               E := Next_E;
+            end loop;
+
+            S := Get_Next_State (S);
+         end loop;
+      end;
+   end Merge_Edges;
+
+   procedure Remove_Identical_Src_Edges (S : NFA_State)
+   is
+      Next_E, E : NFA_Edge;
+   begin
+      Sort_Src_Edges (S);
+      E := Get_First_Src_Edge (S);
+      if E = No_Edge then
+         return;
+      end if;
+      loop
+         Next_E := Get_Next_Src_Edge (E);
+         exit when Next_E = No_Edge;
+         if Get_Edge_Dest (E) = Get_Edge_Dest (Next_E)
+           and then Get_Edge_Expr (E) = Get_Edge_Expr (Next_E)
+         then
+            Remove_Edge (Next_E);
+         else
+            E := Next_E;
+         end if;
+      end loop;
+   end Remove_Identical_Src_Edges;
+
+   procedure Remove_Identical_Dest_Edges (S : NFA_State)
+   is
+      Next_E, E : NFA_Edge;
+   begin
+      Sort_Dest_Edges (S);
+      E := Get_First_Dest_Edge (S);
+      if E = No_Edge then
+         return;
+      end if;
+      loop
+         Next_E := Get_Next_Dest_Edge (E);
+         exit when Next_E = No_Edge;
+         if Get_Edge_Src (E) = Get_Edge_Src (Next_E)
+           and then Get_Edge_Expr (E) = Get_Edge_Expr (Next_E)
+         then
+            Remove_Edge (Next_E);
+         else
+            E := Next_E;
+         end if;
+      end loop;
+   end Remove_Identical_Dest_Edges;
+
+   procedure Find_Partitions (N : NFA; Nbr_States : Natural)
+   is
+      Last_State : constant NFA_State := NFA_State (Nbr_States) - 1;
+      type Part_Offset is new Int32 range -1 .. Nat32 (Nbr_States - 1);
+      type Part_Id is new Part_Offset range 0 .. Part_Offset'Last;
+
+      --  State to partition id.
+      State_Part : array (0 .. Last_State) of Part_Id;
+      pragma Unreferenced (State_Part);
+
+      --  Last partition index.
+      Last_Part : Part_Id;
+
+      --  Partitions content.
+
+      --  To get the states in a partition P, first get the offset OFF
+      --  (from Offsets) of P.  States are in Parts (OFF ...).  The
+      --  number of states is not known, but they all belong to P
+      --  (check with STATE_PART).
+      Parts : array (Part_Offset) of NFA_State;
+      type Offset_Array is array (Part_Id) of Part_Offset;
+      Start_Offsets : Offset_Array;
+      Last_Offsets : Offset_Array;
+
+      S, Final_State : NFA_State;
+      First_S : NFA_State;
+      Off, Last_Off : Part_Offset;
+
+      Stable, Stable1 : Boolean;
+
+      function Is_Equivalent (L, R : NFA_State) return Boolean is
+      begin
+         raise Program_Error;
+         return False;
+      end Is_Equivalent;
+   begin
+      --  Return now for trivial cases (0 or 1 state).
+      if Nbr_States < 2 then
+         return;
+      end if;
+
+      --  Partition 1 contains the final state.
+      --  Partition 0 contains the other states.
+      Final_State := Get_Final_State (N);
+      Last_Part := 1;
+      State_Part := (others => 0);
+      State_Part (Final_State) := 1;
+      S := Get_First_State (N);
+      Off := -1;
+      while S /= No_State loop
+         if S /= Last_State then
+            Off := Off + 1;
+            Parts (Off) := S;
+         end if;
+         S := Get_Next_State (S);
+      end loop;
+      Start_Offsets (0) := 0;
+      Last_Offsets (0) := Off;
+      Start_Offsets (1) := Off + 1;
+      Last_Offsets (1) := Off + 1;
+      Parts (Off + 1) := Final_State;
+
+      --  Now the hard work.
+      loop
+         Stable := True;
+         --  For every partition
+         for P in 0 .. Last_Part loop
+            Off := Start_Offsets (P);
+            First_S := Parts (Off);
+            Off := Off + 1;
+
+            --  For every S != First_S in P.
+            Last_Off := Last_Offsets (P);
+            Stable1 := True;
+            while Off <= Last_Off loop
+               S := Parts (Off);
+
+               if not Is_Equivalent (First_S, S) then
+                  --  Swap S with the last element of the partition.
+                  Parts (Off) := Parts (Last_Off);
+                  Parts (Last_Off) := S;
+                  --  Reduce partition size.
+                  Last_Off := Last_Off - 1;
+                  Last_Offsets (P) := Last_Off;
+
+                  if Stable1 then
+                     --  Create a new partition.
+                     Last_Part := Last_Part + 1;
+                     Last_Offsets (Last_Part) := Last_Off + 1;
+                     Stable1 := False;
+                  end if;
+                  --  Put S in the new partition.
+                  Start_Offsets (Last_Part) := Last_Off + 1;
+                  State_Part (S) := Last_Part;
+                  Stable := False;
+
+                  --  And continue with the swapped state.
+               else
+                  Off := Off + 1;
+               end if;
+            end loop;
+         end loop;
+         exit when Stable;
+      end loop;
+   end Find_Partitions;
+   pragma Unreferenced (Find_Partitions);
+end PSL.Optimize;
diff --git a/src/psl/psl-optimize.ads b/src/psl/psl-optimize.ads
new file mode 100644
index 000000000..5f36a0739
--- /dev/null
+++ b/src/psl/psl-optimize.ads
@@ -0,0 +1,24 @@
+with PSL.NFAs; use PSL.NFAs;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Optimize is
+   --  Remove unreachable states, ie
+   --  *  states that can't be reach from the start state.
+   --  *  states that can't reach the final state.
+   --  O(N) algorithm.
+   procedure Remove_Unreachable_States (N : NFA);
+
+   --  Remove single prefix, ie edges to a state S that is also from start
+   --  to S.
+   --  O(M) algorithm.
+   procedure Remove_Simple_Prefix (N : NFA);
+
+   procedure Merge_Identical_States (N : NFA);
+
+   procedure Merge_Edges (N : NFA);
+
+   procedure Remove_Identical_Src_Edges (S : NFA_State);
+   procedure Remove_Identical_Dest_Edges (S : NFA_State);
+
+   --procedure Find_Partitions (N : NFA; Nbr_States : Natural);
+end PSL.Optimize;
diff --git a/src/psl/psl-prints.adb b/src/psl/psl-prints.adb
new file mode 100644
index 000000000..80da47dab
--- /dev/null
+++ b/src/psl/psl-prints.adb
@@ -0,0 +1,433 @@
+with Types; use Types;
+with PSL.Errors; use PSL.Errors;
+with Name_Table; use Name_Table;
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body PSL.Prints is
+   function Get_Priority (N : Node) return Priority is
+   begin
+      case Get_Kind (N) is
+         when N_Never | N_Always =>
+            return Prio_FL_Invariance;
+         when N_Eventually
+           | N_Next
+           | N_Next_A
+           | N_Next_E
+           | N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E =>
+            return Prio_FL_Occurence;
+         when N_Braced_SERE =>
+            return Prio_SERE_Brace;
+         when N_Concat_SERE =>
+            return Prio_Seq_Concat;
+         when N_Fusion_SERE =>
+            return Prio_Seq_Fusion;
+         when N_Within_SERE =>
+            return Prio_Seq_Within;
+         when N_Match_And_Seq
+           | N_And_Seq =>
+            return Prio_Seq_And;
+         when N_Or_Seq =>
+            return Prio_Seq_Or;
+         when N_Until
+           | N_Before =>
+            return Prio_FL_Bounding;
+         when N_Abort =>
+            return Prio_FL_Abort;
+         when N_Or_Prop =>
+            return Prio_Seq_Or;
+         when N_And_Prop =>
+            return Prio_Seq_And;
+         when N_Imp_Seq
+           | N_Overlap_Imp_Seq
+           | N_Log_Imp_Prop
+           | N_Imp_Bool =>
+            return Prio_Bool_Imp;
+         when N_Name_Decl
+           | N_Number
+           | N_True
+           | N_False
+           | N_EOS
+           | N_HDL_Expr =>
+            return Prio_HDL;
+         when N_Or_Bool =>
+            return Prio_Seq_Or;
+         when N_And_Bool =>
+            return Prio_Seq_And;
+         when N_Not_Bool =>
+            return Prio_Bool_Not;
+         when N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq
+           | N_Plus_Repeat_Seq =>
+            return Prio_SERE_Repeat;
+         when N_Strong =>
+            return Prio_Strong;
+         when others =>
+            Error_Kind ("get_priority", N);
+      end case;
+   end Get_Priority;
+
+   procedure Print_HDL_Expr (N : HDL_Node) is
+   begin
+      Put (Image (Get_Identifier (Node (N))));
+   end Print_HDL_Expr;
+
+   procedure Dump_Expr (N : Node)
+   is
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr =>
+            if HDL_Expr_Printer = null then
+               Put ("Expr");
+            else
+               HDL_Expr_Printer.all (Get_HDL_Node (N));
+            end if;
+         when N_True =>
+            Put ("TRUE");
+         when N_False =>
+            Put ("FALSE");
+         when N_Not_Bool =>
+            Put ("!");
+            Dump_Expr (Get_Boolean (N));
+         when N_And_Bool =>
+            Put ("(");
+            Dump_Expr (Get_Left (N));
+            Put (" && ");
+            Dump_Expr (Get_Right (N));
+            Put (")");
+         when N_Or_Bool =>
+            Put ("(");
+            Dump_Expr (Get_Left (N));
+            Put (" || ");
+            Dump_Expr (Get_Right (N));
+            Put (")");
+         when others =>
+            PSL.Errors.Error_Kind ("dump_expr", N);
+      end case;
+   end Dump_Expr;
+
+   procedure Print_Expr (N : Node; Parent_Prio : Priority := Prio_Lowest)
+   is
+      Prio : Priority;
+   begin
+      if N = Null_Node then
+         Put (".");
+         return;
+      end if;
+      Prio := Get_Priority (N);
+      if Prio < Parent_Prio then
+         Put ("(");
+      end if;
+      case Get_Kind (N) is
+         when N_Number =>
+            declare
+               Str : constant String := Uns32'Image (Get_Value (N));
+            begin
+               Put (Str (2 .. Str'Last));
+            end;
+         when N_Name_Decl =>
+            Put (Image (Get_Identifier (N)));
+         when N_HDL_Expr =>
+            if HDL_Expr_Printer = null then
+               Put ("HDL_Expr");
+            else
+               HDL_Expr_Printer.all (Get_HDL_Node (N));
+            end if;
+            --  FIXME: this is true only when using the scanner.
+            --  Print_Expr (Node (Get_HDL_Node (N)));
+         when N_True =>
+            Put ("TRUE");
+         when N_False =>
+            Put ("FALSE");
+         when N_EOS =>
+            Put ("EOS");
+         when N_Not_Bool =>
+            Put ("!");
+            Print_Expr (Get_Boolean (N), Prio);
+         when N_And_Bool =>
+            Print_Expr (Get_Left (N), Prio);
+            Put (" && ");
+            Print_Expr (Get_Right (N), Prio);
+         when N_Or_Bool =>
+            Print_Expr (Get_Left (N), Prio);
+            Put (" || ");
+            Print_Expr (Get_Right (N), Prio);
+         when N_Imp_Bool =>
+            Print_Expr (Get_Left (N), Prio);
+            Put (" -> ");
+            Print_Expr (Get_Right (N), Prio);
+         when others =>
+            Error_Kind ("print_expr", N);
+      end case;
+      if Prio < Parent_Prio then
+         Put (")");
+      end if;
+   end Print_Expr;
+
+   procedure Print_Sequence (Seq : Node; Parent_Prio : Priority);
+
+   procedure Print_Count (N : Node) is
+      B : Node;
+   begin
+      B := Get_Low_Bound (N);
+      if B = Null_Node then
+         return;
+      end if;
+      Print_Expr (B);
+      B := Get_High_Bound (N);
+      if B = Null_Node then
+         return;
+      end if;
+      Put (":");
+      Print_Expr (B);
+   end Print_Count;
+
+   procedure Print_Binary_Sequence (Name : String; N : Node; Prio : Priority)
+   is
+   begin
+      Print_Sequence (Get_Left (N), Prio);
+      Put (Name);
+      Print_Sequence (Get_Right (N), Prio);
+   end Print_Binary_Sequence;
+
+   procedure Print_Repeat_Sequence (Name : String; N : Node) is
+      S : Node;
+   begin
+      S := Get_Sequence (N);
+      if S /= Null_Node then
+         Print_Sequence (S, Prio_SERE_Repeat);
+      end if;
+      Put (Name);
+      Print_Count (N);
+      Put ("]");
+   end Print_Repeat_Sequence;
+
+   procedure Print_Sequence (Seq : Node; Parent_Prio : Priority)
+   is
+      Prio : constant Priority := Get_Priority (Seq);
+      Add_Paren : constant Boolean := Prio < Parent_Prio
+        or else Parent_Prio <= Prio_FL_Paren;
+   begin
+      if Add_Paren then
+         Put ("{");
+      end if;
+      case Get_Kind (Seq) is
+         when N_Braced_SERE =>
+            Put ("{");
+            Print_Sequence (Get_SERE (Seq), Prio_Lowest);
+            Put ("}");
+         when N_Concat_SERE =>
+            Print_Binary_Sequence (";", Seq, Prio);
+         when N_Fusion_SERE =>
+            Print_Binary_Sequence (":", Seq, Prio);
+         when N_Within_SERE =>
+            Print_Binary_Sequence (" within ", Seq, Prio);
+         when N_Match_And_Seq =>
+            Print_Binary_Sequence (" && ", Seq, Prio);
+         when N_Or_Seq =>
+            Print_Binary_Sequence (" | ", Seq, Prio);
+         when N_And_Seq =>
+            Print_Binary_Sequence (" & ", Seq, Prio);
+         when N_Star_Repeat_Seq =>
+            Print_Repeat_Sequence ("[*", Seq);
+         when N_Goto_Repeat_Seq =>
+            Print_Repeat_Sequence ("[->", Seq);
+         when N_Equal_Repeat_Seq =>
+            Print_Repeat_Sequence ("[=", Seq);
+         when N_Plus_Repeat_Seq =>
+            Print_Sequence (Get_Sequence (Seq), Prio);
+            Put ("[+]");
+         when N_Booleans
+           | N_Name_Decl =>
+            Print_Expr (Seq);
+         when others =>
+            Error_Kind ("print_sequence", Seq);
+      end case;
+      if Add_Paren then
+         Put ("}");
+      end if;
+   end Print_Sequence;
+
+   procedure Print_Binary_Property (Name : String; N : Node; Prio : Priority)
+   is
+   begin
+      Print_Property (Get_Left (N), Prio);
+      Put (Name);
+      Print_Property (Get_Right (N), Prio);
+   end Print_Binary_Property;
+
+   procedure Print_Binary_Property_SI (Name : String;
+                                       N : Node; Prio : Priority)
+   is
+   begin
+      Print_Property (Get_Left (N), Prio);
+      Put (Name);
+      if Get_Strong_Flag (N) then
+         Put ('!');
+      end if;
+      if Get_Inclusive_Flag (N) then
+         Put ('_');
+      end if;
+      Put (' ');
+      Print_Property (Get_Right (N), Prio);
+   end Print_Binary_Property_SI;
+
+   procedure Print_Range_Property (Name : String; N : Node) is
+   begin
+      Put (Name);
+      Put ("[");
+      Print_Count (N);
+      Put ("](");
+      Print_Property (Get_Property (N), Prio_FL_Paren);
+      Put (")");
+   end Print_Range_Property;
+
+   procedure Print_Boolean_Range_Property (Name : String; N : Node) is
+   begin
+      Put (Name);
+      Put ("(");
+      Print_Expr (Get_Boolean (N));
+      Put (")[");
+      Print_Count (N);
+      Put ("](");
+      Print_Property (Get_Property (N), Prio_FL_Paren);
+      Put (")");
+   end Print_Boolean_Range_Property;
+
+   procedure Print_Property (Prop : Node;
+                             Parent_Prio : Priority := Prio_Lowest)
+   is
+      Prio : constant Priority := Get_Priority (Prop);
+   begin
+      if Prio < Parent_Prio then
+         Put ("(");
+      end if;
+      case Get_Kind (Prop) is
+         when N_Never =>
+            Put ("never ");
+            Print_Property (Get_Property (Prop), Prio);
+         when N_Always =>
+            Put ("always (");
+            Print_Property (Get_Property (Prop), Prio);
+            Put (")");
+         when N_Eventually =>
+            Put ("eventually! (");
+            Print_Property (Get_Property (Prop), Prio);
+            Put (")");
+         when N_Strong =>
+            Print_Property (Get_Property (Prop), Prio);
+            Put ("!");
+         when N_Next =>
+            Put ("next");
+--              if Get_Strong_Flag (Prop) then
+--                 Put ('!');
+--              end if;
+            Put (" (");
+            Print_Property (Get_Property (Prop), Prio);
+            Put (")");
+         when N_Next_A =>
+            Print_Range_Property ("next_a", Prop);
+         when N_Next_E =>
+            Print_Range_Property ("next_e", Prop);
+         when N_Next_Event =>
+            Put ("next_event");
+            Put ("(");
+            Print_Expr (Get_Boolean (Prop));
+            Put (")(");
+            Print_Property (Get_Property (Prop), Prio);
+            Put (")");
+         when N_Next_Event_A =>
+            Print_Boolean_Range_Property ("next_event_a", Prop);
+         when N_Next_Event_E =>
+            Print_Boolean_Range_Property ("next_event_e", Prop);
+         when N_Until =>
+            Print_Binary_Property_SI (" until", Prop, Prio);
+         when N_Abort =>
+            Print_Property (Get_Property (Prop), Prio);
+            Put (" abort ");
+            Print_Expr (Get_Boolean (Prop));
+         when N_Before =>
+            Print_Binary_Property_SI (" before", Prop, Prio);
+         when N_Or_Prop =>
+            Print_Binary_Property (" || ", Prop, Prio);
+         when N_And_Prop =>
+            Print_Binary_Property (" && ", Prop, Prio);
+         when N_Imp_Seq =>
+            Print_Property (Get_Sequence (Prop), Prio);
+            Put (" |=> ");
+            Print_Property (Get_Property (Prop), Prio);
+         when N_Overlap_Imp_Seq =>
+            Print_Property (Get_Sequence (Prop), Prio);
+            Put (" |-> ");
+            Print_Property (Get_Property (Prop), Prio);
+         when N_Log_Imp_Prop =>
+            Print_Binary_Property (" -> ", Prop, Prio);
+         when N_Booleans
+           | N_Name_Decl =>
+            Print_Expr (Prop);
+         when N_Sequences =>
+            Print_Sequence (Prop, Parent_Prio);
+         when others =>
+            Error_Kind ("print_property", Prop);
+      end case;
+      if Prio < Parent_Prio then
+         Put (")");
+      end if;
+   end Print_Property;
+
+   procedure Print_Assert (N : Node) is
+      Label : Name_Id;
+   begin
+      Put ("  ");
+      Label := Get_Label (N);
+      if Label /= Null_Identifier then
+         Put (Image (Label));
+         Put (": ");
+      end if;
+      Put ("assert ");
+      Print_Property (Get_Property (N));
+      Put_Line (";");
+   end Print_Assert;
+
+   procedure Print_Property_Declaration (N : Node) is
+   begin
+      Put ("  ");
+      Put ("property ");
+      Put (Image (Get_Identifier (N)));
+      Put (" = ");
+      Print_Property (Get_Property (N));
+      Put_Line (";");
+   end Print_Property_Declaration;
+
+   procedure Print_Unit (Unit : Node) is
+      Item : Node;
+   begin
+      case Get_Kind (Unit) is
+         when N_Vunit =>
+            Put ("vunit");
+         when others =>
+            Error_Kind ("disp_unit", Unit);
+      end case;
+      Put (' ');
+      Put (Image (Get_Identifier (Unit)));
+      Put_Line (" {");
+      Item := Get_Item_Chain (Unit);
+      while Item /= Null_Node loop
+         case Get_Kind (Item) is
+            when N_Name_Decl =>
+               null;
+            when N_Assert_Directive =>
+               Print_Assert (Item);
+            when N_Property_Declaration =>
+               Print_Property_Declaration (Item);
+            when others =>
+               Error_Kind ("disp_unit", Item);
+         end case;
+         Item := Get_Chain (Item);
+      end loop;
+      Put_Line ("}");
+   end Print_Unit;
+end PSL.Prints;
+
diff --git a/src/psl/psl-prints.ads b/src/psl/psl-prints.ads
new file mode 100644
index 000000000..18a36f78f
--- /dev/null
+++ b/src/psl/psl-prints.ads
@@ -0,0 +1,20 @@
+with PSL.Nodes; use PSL.Nodes;
+with PSL.Priorities; use PSL.Priorities;
+
+package PSL.Prints is
+   procedure Print_Unit (Unit : Node);
+   procedure Print_Property (Prop : Node;
+                             Parent_Prio : Priority := Prio_Lowest);
+   procedure Print_Expr (N : Node; Parent_Prio : Priority := Prio_Lowest);
+
+   --  Procedure to display HDL_Expr nodes.
+   type HDL_Expr_Printer_Acc is access procedure (N : HDL_Node);
+   HDL_Expr_Printer : HDL_Expr_Printer_Acc;
+
+   procedure Print_HDL_Expr (N : HDL_Node);
+
+   --  Like Print_Expr but always put parenthesis.
+   procedure Dump_Expr (N : Node);
+
+end PSL.Prints;
+
diff --git a/src/psl/psl-priorities.ads b/src/psl/psl-priorities.ads
new file mode 100644
index 000000000..cb49239e4
--- /dev/null
+++ b/src/psl/psl-priorities.ads
@@ -0,0 +1,63 @@
+package PSL.Priorities is
+   --  Operator priorities, defined by PSL1.1 4.2.3.2
+   type Priority is
+     (
+      Prio_Lowest,
+
+      --  always, never, G
+      Prio_FL_Invariance,
+
+      --  ->, <->
+      Prio_Bool_Imp,
+
+      --  |->, |=>
+      Prio_Seq_Imp,
+
+      --  U, W, until*, before*
+      Prio_FL_Bounding,
+
+      --  next*, eventually!, X, X!, F
+      Prio_FL_Occurence,
+
+      --  abort
+      Prio_FL_Abort,
+
+      --  ( )
+      Prio_FL_Paren,
+
+      --  ;
+      Prio_Seq_Concat,
+
+      --  :
+      Prio_Seq_Fusion,
+
+      --  |
+      Prio_Seq_Or,
+
+      --  &, &&
+      Prio_Seq_And,
+
+      --  within
+      Prio_Seq_Within,
+
+      --  [*], [+], [=], [->]
+      Prio_SERE_Repeat,
+
+      --  { }
+      Prio_SERE_Brace,
+
+      --  @
+      Prio_Clock_Event,
+
+      --  !
+      Prio_Strong,
+
+      --  union
+      Prio_Union,
+
+      --  !
+      Prio_Bool_Not,
+
+      Prio_HDL
+     );
+end PSL.Priorities;
diff --git a/src/psl/psl-qm.adb b/src/psl/psl-qm.adb
new file mode 100644
index 000000000..f5b5e1db3
--- /dev/null
+++ b/src/psl/psl-qm.adb
@@ -0,0 +1,318 @@
+with Ada.Text_IO;
+with Types; use Types;
+with PSL.Errors; use PSL.Errors;
+with PSL.Prints;
+with PSL.CSE;
+
+package body PSL.QM is
+   procedure Reset is
+   begin
+      for I in 1 .. Nbr_Terms loop
+         Set_HDL_Index (Term_Assoc (I), 0);
+      end loop;
+      Nbr_Terms := 0;
+      Term_Assoc := (others => Null_Node);
+   end Reset;
+
+   function Term (P : Natural) return Vector_Type is
+   begin
+      return Shift_Left (1, P - 1);
+   end Term;
+
+   procedure Disp_Primes_Set (Ps : Primes_Set)
+   is
+      use Ada.Text_IO;
+      use PSL.Prints;
+      Prime : Prime_Type;
+      T : Vector_Type;
+      First_Term : Boolean;
+   begin
+      if Ps.Nbr = 0 then
+         Put ("FALSE");
+         return;
+      end if;
+      for I in 1 .. Ps.Nbr loop
+         Prime := Ps.Set (I);
+         if I /= 1 then
+            Put (" | ");
+         end if;
+         if Prime.Set = 0 then
+            Put ("TRUE");
+         else
+            First_Term := True;
+            for J in 1 .. Max_Terms loop
+               T := Term (J);
+               if (Prime.Set and T) /= 0 then
+                  if First_Term then
+                     First_Term := False;
+                  else
+                     Put ('.');
+                  end if;
+                  if (Prime.Val and T) = 0 then
+                     Put ('!');
+                  end if;
+                  Print_Expr (Term_Assoc (J));
+               end if;
+            end loop;
+         end if;
+      end loop;
+   end Disp_Primes_Set;
+
+   --  Return TRUE iff L includes R, ie
+   --  for all x, x in L => x in R.
+   function Included (L, R : Prime_Type) return Boolean is
+   begin
+      return ((L.Set or R.Set) = L.Set)
+        and then ((L.Val and R.Set) = (R.Val and R.Set));
+   end Included;
+
+   --  Return TRUE iff L and R have the same don't care set
+   --  and L and R can be merged into a new prime with a new don't care.
+   function Is_One_Change_Same (L, R : Prime_Type) return Boolean
+   is
+      V : Vector_Type;
+   begin
+      if L.Set /= R.Set then
+         return False;
+      end if;
+      V := L.Val xor R.Val;
+      return (V and -V) = V;
+   end Is_One_Change_Same;
+
+   --  Return true iff L can add a new DC in R.
+   function Is_One_Change (L, R : Prime_Type) return Boolean
+   is
+      V : Vector_Type;
+   begin
+      if (L.Set or R.Set) /= R.Set then
+         return False;
+      end if;
+      V := (L.Val xor R.Val) and L.Set;
+      return (V and -V) = V;
+   end Is_One_Change;
+
+   procedure Merge (Ps : in out Primes_Set; P : Prime_Type)
+   is
+      Do_Append : Boolean := True;
+      T : Prime_Type;
+   begin
+      for I in 1 .. Ps.Nbr loop
+         T := Ps.Set (I);
+         if Included (P, T) then
+            --  Already in the set.
+            return;
+         end if;
+         if Included (T, P) then
+            Ps.Set (I) := P;
+            Do_Append := False;
+         else
+            if Is_One_Change_Same (P, T) then
+               declare
+                  V : constant Vector_Type := T.Val xor P.Val;
+               begin
+                  Ps.Set (I).Set := T.Set and not V;
+                  Ps.Set (I).Val := T.Val and not V;
+               end;
+               Do_Append := False;
+            end if;
+            if Is_One_Change (P, T) then
+               declare
+                  V : constant Vector_Type := (T.Val xor P.Val) and P.Set;
+               begin
+                  Ps.Set (I).Set := T.Set and not V;
+                  Ps.Set (I).Val := T.Val and not V;
+               end;
+               --  continue.
+            end if;
+         end if;
+      end loop;
+      if Do_Append then
+         Ps.Nbr := Ps.Nbr + 1;
+         Ps.Set (Ps.Nbr) := P;
+      end if;
+   end Merge;
+
+   function Build_Primes_And (L, R : Primes_Set) return Primes_Set
+   is
+      Res : Primes_Set (L.Nbr * R.Nbr);
+      L_P, R_P : Prime_Type;
+      P : Prime_Type;
+   begin
+      for I in 1 .. L.Nbr loop
+         L_P := L.Set (I);
+         for J in 1 .. R.Nbr loop
+            R_P := R.Set (J);
+            --  In case of conflict, discard.
+            if ((L_P.Val xor R_P.Val) and (L_P.Set and R_P.Set)) /= 0 then
+               null;
+            else
+               P.Set := L_P.Set or R_P.Set;
+               P.Val := (R_P.Set and R_P.Val)
+                 or ((L_P.Set and not R_P.Set) and L_P.Val);
+               Merge (Res, P);
+            end if;
+         end loop;
+      end loop;
+
+      return Res;
+   end Build_Primes_And;
+
+
+   function Build_Primes_Or (L, R : Primes_Set) return Primes_Set
+   is
+      Res : Primes_Set (L.Nbr + R.Nbr);
+      L_P, R_P : Prime_Type;
+   begin
+      for I in 1 .. L.Nbr loop
+         L_P := L.Set (I);
+         Merge (Res, L_P);
+      end loop;
+      for J in 1 .. R.Nbr loop
+         R_P := R.Set (J);
+         Merge (Res, R_P);
+      end loop;
+
+      return Res;
+   end Build_Primes_Or;
+
+   function Build_Primes (N : Node; Negate : Boolean) return Primes_Set is
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr
+           | N_EOS =>
+            declare
+               Res : Primes_Set (1);
+               Index : Int32;
+               T : Vector_Type;
+            begin
+               Index := Get_HDL_Index (N);
+               if Index = 0 then
+                  Nbr_Terms := Nbr_Terms + 1;
+                  if Nbr_Terms > Max_Terms then
+                     raise Program_Error;
+                  end if;
+                  Term_Assoc (Nbr_Terms) := N;
+                  Index := Int32 (Nbr_Terms);
+                  Set_HDL_Index (N, Index);
+               else
+                  if Index not in 1 .. Int32 (Nbr_Terms)
+                    or else Term_Assoc (Natural (Index)) /= N
+                  then
+                     raise Internal_Error;
+                  end if;
+               end if;
+               T := Term (Natural (Index));
+               Res.Nbr := 1;
+               Res.Set (1).Set := T;
+               if Negate then
+                  Res.Set (1).Val := 0;
+               else
+                  Res.Set (1).Val := T;
+               end if;
+               return Res;
+            end;
+         when N_False =>
+            declare
+               Res : Primes_Set (0);
+            begin
+               return Res;
+            end;
+         when N_True =>
+            declare
+               Res : Primes_Set (1);
+            begin
+               Res.Nbr := 1;
+               Res.Set (1).Set := 0;
+               Res.Set (1).Val := 0;
+               return Res;
+            end;
+         when N_Not_Bool =>
+            return Build_Primes (Get_Boolean (N), not Negate);
+         when N_And_Bool =>
+            if Negate then
+               --  !(a & b) <-> !a || !b
+               return Build_Primes_Or (Build_Primes (Get_Left (N), True),
+                                       Build_Primes (Get_Right (N), True));
+            else
+               return Build_Primes_And (Build_Primes (Get_Left (N), False),
+                                        Build_Primes (Get_Right (N), False));
+            end if;
+         when N_Or_Bool =>
+            if Negate then
+               --  !(a || b) <-> !a && !b
+               return Build_Primes_And (Build_Primes (Get_Left (N), True),
+                                        Build_Primes (Get_Right (N), True));
+            else
+               return Build_Primes_Or (Build_Primes (Get_Left (N), False),
+                                       Build_Primes (Get_Right (N), False));
+            end if;
+         when N_Imp_Bool =>
+            if not Negate then
+               --  a -> b  <->  !a || b
+               return Build_Primes_Or (Build_Primes (Get_Left (N), True),
+                                       Build_Primes (Get_Right (N), False));
+            else
+               -- !(a -> b)  <->  a && !b
+               return Build_Primes_And (Build_Primes (Get_Left (N), False),
+                                        Build_Primes (Get_Right (N), True));
+            end if;
+         when others =>
+            Error_Kind ("build_primes", N);
+      end case;
+   end Build_Primes;
+
+   function Build_Primes (N : Node) return Primes_Set is
+   begin
+      return Build_Primes (N, False);
+   end Build_Primes;
+
+   function Build_Node (P : Prime_Type) return Node
+   is
+      Res : Node := Null_Node;
+      N : Node;
+      S : Vector_Type := P.Set;
+      T : Vector_Type;
+   begin
+      if S = 0 then
+         return True_Node;
+      end if;
+      for I in Natural range 1 .. Vector_Type'Modulus loop
+         T := Term (I);
+         if (S and T) /= 0 then
+            N := Term_Assoc (I);
+            if (P.Val and T) = 0 then
+               N := PSL.CSE.Build_Bool_Not (N);
+            end if;
+            if Res = Null_Node then
+               Res := N;
+            else
+               Res := PSL.CSE.Build_Bool_And (Res, N);
+            end if;
+            S := S and not T;
+            exit when S = 0;
+         end if;
+      end loop;
+      return Res;
+   end Build_Node;
+
+   function Build_Node (Ps : Primes_Set) return Node
+   is
+      Res : Node;
+   begin
+      if Ps.Nbr = 0 then
+         return False_Node;
+      else
+         Res := Build_Node (Ps.Set (1));
+         for I in 2 .. Ps.Nbr loop
+            Res := PSL.CSE.Build_Bool_Or (Res, Build_Node (Ps.Set (I)));
+         end loop;
+         return Res;
+      end if;
+   end Build_Node;
+
+   --  FIXME: finish the work: do a real Quine-McKluskey minimization.
+   function Reduce (N : Node) return Node is
+   begin
+      return Build_Node (Build_Primes (N));
+   end Reduce;
+end PSL.QM;
diff --git a/src/psl/psl-qm.ads b/src/psl/psl-qm.ads
new file mode 100644
index 000000000..85f1e3cf4
--- /dev/null
+++ b/src/psl/psl-qm.ads
@@ -0,0 +1,49 @@
+with PSL.Nodes; use PSL.Nodes;
+with Interfaces; use Interfaces;
+
+package PSL.QM is
+   type Primes_Set (<>) is private;
+
+   function Build_Primes (N : Node) return Primes_Set;
+
+   function Build_Node (Ps : Primes_Set) return Node;
+
+   function Reduce (N : Node) return Node;
+
+   --  The maximum number of terms that this package can handle.
+   --  The algorithm is in O(2**n)
+   Max_Terms : constant Natural := 12;
+
+   type Term_Assoc_Type is array (1 .. Max_Terms) of Node;
+   Term_Assoc : Term_Assoc_Type := (others => Null_Node);
+   Nbr_Terms : Natural := 0;
+
+   procedure Reset;
+
+   procedure Disp_Primes_Set (Ps : Primes_Set);
+private
+   --  Scalar type used to represent a vector of booleans for terms.
+   subtype Vector_Type is Unsigned_16;
+   pragma Assert (Vector_Type'Modulus >= 2 ** Max_Terms);
+
+   --  States of a vector of term.
+   --  If SET is 0, this is a don't care: the term has no influence.
+   --  If SET is 1, the value of the term is in VAL.
+   type Prime_Type is record
+      Val : Unsigned_16;
+      Set : Unsigned_16;
+   end record;
+
+   subtype Len_Type is Natural range 0 .. 2 ** Max_Terms;
+
+   type Set_Type is array (Natural range <>) of Prime_Type;
+
+   --  A set of primes is a collection of at most MAX prime.
+   type Primes_Set (Max : Len_Type) is record
+      Nbr : Len_Type := 0;
+      Set : Set_Type (1 .. Max);
+   end record;
+end PSL.QM;
+
+
+
diff --git a/src/psl/psl-rewrites.adb b/src/psl/psl-rewrites.adb
new file mode 100644
index 000000000..6ba5b1026
--- /dev/null
+++ b/src/psl/psl-rewrites.adb
@@ -0,0 +1,604 @@
+with Types; use Types;
+with PSL.Errors; use PSL.Errors;
+with PSL.CSE; use PSL.CSE;
+
+package body PSL.Rewrites is
+--     procedure Location_Copy (Dst, Src : Node) is
+--     begin
+--        Set_Location (Dst, Get_Location (Src));
+--     end Location_Copy;
+
+   --  Return [*0]
+   function Build_Empty return Node is
+      Res, Tmp : Node;
+   begin
+      Res := Create_Node (N_Star_Repeat_Seq);
+      Tmp := Create_Node (N_Number);
+      Set_Value (Tmp, 0);
+      Set_Low_Bound (Res, Tmp);
+      return Res;
+   end Build_Empty;
+
+   --  Return N[*]
+   function Build_Star (N : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node (N_Star_Repeat_Seq);
+      Set_Sequence (Res, N);
+      return Res;
+   end Build_Star;
+
+   --  Return N[+]
+   function Build_Plus (N : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node (N_Plus_Repeat_Seq);
+      Set_Sequence (Res, N);
+      return Res;
+   end Build_Plus;
+
+   --  Return N!
+   function Build_Strong (N : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node (N_Strong);
+      Set_Property (Res, N);
+      return Res;
+   end Build_Strong;
+
+   --  Return T[*]
+   function Build_True_Star return Node is
+   begin
+      return Build_Star (True_Node);
+   end Build_True_Star;
+
+   function Build_Binary (K : Nkind; L, R : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node (K);
+      Set_Left (Res, L);
+      Set_Right (Res, R);
+      return Res;
+   end Build_Binary;
+
+   function Build_Concat (L, R : Node) return Node is
+   begin
+      return Build_Binary (N_Concat_SERE, L, R);
+   end Build_Concat;
+
+   function Build_Repeat (N : Node; Cnt : Uns32) return Node is
+      Res : Node;
+   begin
+      if Cnt = 0 then
+         raise Internal_Error;
+      end if;
+      Res := N;
+      for I in 2 .. Cnt loop
+         Res := Build_Concat (Res, N);
+      end loop;
+      return Res;
+   end Build_Repeat;
+
+   function Build_Overlap_Imp_Seq (S : Node; P : Node) return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node (N_Overlap_Imp_Seq);
+      Set_Sequence (Res, S);
+      Set_Property (Res, P);
+      return Res;
+   end Build_Overlap_Imp_Seq;
+
+   function Rewrite_Boolean (N : Node) return Node
+   is
+      Res : Node;
+   begin
+      case Get_Kind (N) is
+         when N_Name =>
+            Res := Get_Decl (N);
+            pragma Assert (Res /= Null_Node);
+            return Res;
+         when N_Not_Bool =>
+            Set_Boolean (N, Rewrite_Boolean (Get_Boolean (N)));
+            return N;
+         when N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool =>
+            Set_Left (N, Rewrite_Boolean (Get_Left (N)));
+            Set_Right (N, Rewrite_Boolean (Get_Right (N)));
+            return N;
+         when N_HDL_Expr =>
+            return N;
+         when others =>
+            Error_Kind ("rewrite_boolean", N);
+      end case;
+   end Rewrite_Boolean;
+
+   function Rewrite_Star_Repeat_Seq (Seq : Node;
+                                     Lo, Hi : Uns32) return Node
+   is
+      Res : Node;
+   begin
+      pragma Assert (Lo <= Hi);
+
+      if Lo = Hi then
+
+         if Lo = 0 then
+            --  r[*0]  -->  [*0]
+            return Build_Empty;
+         elsif Lo = 1 then
+            --  r[*1]  -->  r
+            return Seq;
+         end if;
+         --  r[*c+]  -->  r;r;r...;r (c times)
+         return Build_Repeat (Seq, Lo);
+      end if;
+
+      --  r[*0:1]  -->  [*0] | r
+      --  r[*0:2]  -->  [*0] | r;{[*0]|r}
+
+      --  r[*0:n]  -->  [*0] | r;r[*0:n-1]
+      --  r[*l:h]  -->  r[*l] ; r[*0:h-l]
+      Res := Build_Binary (N_Or_Seq, Build_Empty, Seq);
+      for I in Lo + 2 .. Hi loop
+         Res := Build_Concat (Seq, Res);
+         Res := Build_Binary (N_Or_Seq, Build_Empty, Res);
+      end loop;
+      if Lo > 0 then
+         Res := Build_Concat (Build_Repeat (Seq, Lo), Res);
+      end if;
+
+      return Res;
+   end Rewrite_Star_Repeat_Seq;
+
+   function Rewrite_Star_Repeat_Seq (Seq : Node;
+                                     Lo, Hi : Node) return Node
+   is
+      Cnt_Lo : Uns32;
+      Cnt_Hi : Uns32;
+   begin
+      if Lo = Null_Node then
+         --  r[*]
+         raise Program_Error;
+      end if;
+
+      Cnt_Lo := Get_Value (Lo);
+      if Hi = Null_Node then
+         Cnt_Hi := Cnt_Lo;
+      else
+         Cnt_Hi := Get_Value (Hi);
+      end if;
+      return Rewrite_Star_Repeat_Seq (Seq, Cnt_Lo, Cnt_Hi);
+   end Rewrite_Star_Repeat_Seq;
+
+   function Rewrite_Star_Repeat_Seq (N : Node) return Node
+   is
+      Seq : constant Node := Get_Sequence (N);
+      Lo : constant Node := Get_Low_Bound (N);
+   begin
+      if Lo = Null_Node then
+         --  r[*]  -->  r[*]
+         return N;
+      else
+         return Rewrite_Star_Repeat_Seq (Seq, Lo, Get_High_Bound (N));
+      end if;
+   end Rewrite_Star_Repeat_Seq;
+
+   function Rewrite_Goto_Repeat_Seq (Seq : Node;
+                                     Lo, Hi : Node) return Node is
+      Res : Node;
+   begin
+      --  b[->]  -->  {(~b)[*];b}
+      Res := Build_Concat (Build_Star (Build_Bool_Not (Seq)), Seq);
+
+      if Lo = Null_Node then
+         return Res;
+      end if;
+
+      --  b[->l:h]  -->  {b[->]}[*l:h]
+      return Rewrite_Star_Repeat_Seq (Res, Lo, Hi);
+   end Rewrite_Goto_Repeat_Seq;
+
+   function Rewrite_Goto_Repeat_Seq (Seq : Node;
+                                     Lo, Hi : Uns32) return Node is
+      Res : Node;
+   begin
+      --  b[->]  -->  {(~b)[*];b}
+      Res := Build_Concat (Build_Star (Build_Bool_Not (Seq)), Seq);
+
+      --  b[->l:h]  -->  {b[->]}[*l:h]
+      return Rewrite_Star_Repeat_Seq (Res, Lo, Hi);
+   end Rewrite_Goto_Repeat_Seq;
+
+   function Rewrite_Equal_Repeat_Seq (N : Node) return Node
+   is
+      Seq : constant Node := Get_Sequence (N);
+      Lo : constant Node := Get_Low_Bound (N);
+      Hi : constant Node := Get_High_Bound (N);
+   begin
+      --  b[=l:h]  -->  {b[->l:h]};(~b)[*]
+      return Build_Concat (Rewrite_Goto_Repeat_Seq (Seq, Lo, Hi),
+                           Build_Star (Build_Bool_Not (Seq)));
+   end Rewrite_Equal_Repeat_Seq;
+
+   function Rewrite_Within (N : Node) return Node is
+      Res : Node;
+   begin
+      Res := Build_Concat (Build_Concat (Build_True_Star, Get_Left (N)),
+                           Build_True_Star);
+      return Build_Binary (N_Match_And_Seq, Res, Get_Right (N));
+   end Rewrite_Within;
+
+   function Rewrite_And_Seq (L : Node; R : Node) return Node is
+   begin
+      return Build_Binary (N_Or_Seq,
+                           Build_Binary (N_Match_And_Seq,
+                                         L,
+                                         Build_Concat (R, Build_True_Star)),
+                           Build_Binary (N_Match_And_Seq,
+                                         Build_Concat (L, Build_True_Star),
+                                         R));
+   end Rewrite_And_Seq;
+   pragma Unreferenced (Rewrite_And_Seq);
+
+   procedure Rewrite_Instance (N : Node)
+   is
+      Assoc : Node := Get_Association_Chain (N);
+   begin
+      while Assoc /= Null_Node loop
+         case Get_Kind (Get_Formal (Assoc)) is
+            when N_Const_Parameter =>
+               null;
+            when N_Boolean_Parameter =>
+               Set_Actual (Assoc, Rewrite_Boolean (Get_Actual (Assoc)));
+            when N_Sequence_Parameter =>
+               Set_Actual (Assoc, Rewrite_SERE (Get_Actual (Assoc)));
+            when N_Property_Parameter =>
+               Set_Actual (Assoc, Rewrite_Property (Get_Actual (Assoc)));
+            when others =>
+               Error_Kind ("rewrite_instance",
+                           Get_Formal (Assoc));
+         end case;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Rewrite_Instance;
+
+   function Rewrite_SERE (N : Node) return Node is
+      S : Node;
+   begin
+      case Get_Kind (N) is
+         when N_Star_Repeat_Seq =>
+            S := Get_Sequence (N);
+            if S = Null_Node then
+               S := True_Node;
+            else
+               S := Rewrite_SERE (S);
+            end if;
+            Set_Sequence (N, S);
+            return Rewrite_Star_Repeat_Seq (N);
+         when N_Plus_Repeat_Seq =>
+            S := Get_Sequence (N);
+            if S = Null_Node then
+               S := True_Node;
+            else
+               S := Rewrite_SERE (S);
+            end if;
+            Set_Sequence (N, S);
+            return N;
+         when N_Goto_Repeat_Seq =>
+            return Rewrite_Goto_Repeat_Seq
+              (Rewrite_SERE (Get_Sequence (N)),
+               Get_Low_Bound (N), Get_High_Bound (N));
+         when N_Equal_Repeat_Seq =>
+            Set_Sequence (N, Rewrite_SERE (Get_Sequence (N)));
+            return Rewrite_Equal_Repeat_Seq (N);
+         when N_Braced_SERE =>
+            return Rewrite_SERE (Get_SERE (N));
+         when N_Within_SERE =>
+            Set_Left (N, Rewrite_SERE (Get_Left (N)));
+            Set_Right (N, Rewrite_SERE (Get_Right (N)));
+            return Rewrite_Within (N);
+--           when N_And_Seq =>
+--              return Rewrite_And_Seq (Rewrite_SERE (Get_Left (N)),
+--                                      Rewrite_SERE (Get_Right (N)));
+         when N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Match_And_Seq
+           | N_And_Seq
+           | N_Or_Seq =>
+            Set_Left (N, Rewrite_SERE (Get_Left (N)));
+            Set_Right (N, Rewrite_SERE (Get_Right (N)));
+            return N;
+         when N_Booleans =>
+            return Rewrite_Boolean (N);
+         when N_Name =>
+            return Get_Decl (N);
+         when N_Sequence_Instance
+           | N_Endpoint_Instance =>
+            Rewrite_Instance (N);
+            return N;
+         when N_Boolean_Parameter
+           | N_Sequence_Parameter
+           | N_Const_Parameter =>
+            return N;
+         when others =>
+            Error_Kind ("rewrite_SERE", N);
+      end case;
+   end Rewrite_SERE;
+
+   function Rewrite_Until (N : Node) return Node
+   is
+      Res : Node;
+      B : Node;
+      L : Node;
+      S : Node;
+   begin
+      if Get_Inclusive_Flag (N) then
+         --  B1 until_ B2 --> {B1[+]:B2}
+         Res := Build_Binary (N_Fusion_SERE,
+                              Build_Plus (Rewrite_Boolean (Get_Left (N))),
+                              Rewrite_Boolean (Get_Right (N)));
+         if Get_Strong_Flag (N) then
+            Res := Build_Strong (Res);
+         end if;
+      else
+         --  P until B  -->  {(!B)[+]} |-> P
+         B := Rewrite_Boolean (Get_Right (N));
+         L := Build_Plus (Build_Bool_Not (B));
+         Res := Build_Overlap_Imp_Seq (L, Rewrite_Property (Get_Left (N)));
+
+         if Get_Strong_Flag (N) then
+            --  p until! b  -->  (p until b) && ({b[->]}!)
+            S := Build_Strong
+              (Rewrite_Goto_Repeat_Seq (B, Null_Node, Null_Node));
+            Res := Build_Binary (N_And_Prop, Res, S);
+         end if;
+      end if;
+      return Res;
+   end Rewrite_Until;
+
+   function Rewrite_Next_Event_A (B : Node;
+                                  Lo, Hi : Uns32;
+                                  P : Node;
+                                  Strong : Boolean) return Node
+   is
+      Res : Node;
+   begin
+      Res := Rewrite_Goto_Repeat_Seq (B, Lo, Hi);
+      Res := Build_Overlap_Imp_Seq (Res, P);
+
+      if Strong then
+         Res := Build_Binary
+           (N_And_Prop,
+            Res,
+            Build_Strong (Rewrite_Goto_Repeat_Seq (B, Lo, Lo)));
+      end if;
+
+      return Res;
+   end Rewrite_Next_Event_A;
+
+   function Rewrite_Next_Event (B : Node;
+                                N : Uns32;
+                                P : Node;
+                                Strong : Boolean) return Node is
+   begin
+      return Rewrite_Next_Event_A (B, N, N, P, Strong);
+   end Rewrite_Next_Event;
+
+   function Rewrite_Next_Event (B : Node;
+                                Num : Node;
+                                P : Node;
+                                Strong : Boolean) return Node
+   is
+      N : Uns32;
+   begin
+      if Num = Null_Node then
+         N := 1;
+      else
+         N := Get_Value (Num);
+      end if;
+      return Rewrite_Next_Event (B, N, P, Strong);
+   end Rewrite_Next_Event;
+
+   function Rewrite_Next (Num : Node; P : Node; Strong : Boolean) return Node
+   is
+      N : Uns32;
+   begin
+      if Num = Null_Node then
+         N := 1;
+      else
+         N := Get_Value (Num);
+      end if;
+      return Rewrite_Next_Event (True_Node, N + 1, P, Strong);
+   end Rewrite_Next;
+
+   function Rewrite_Next_A (Lo, Hi : Uns32;
+                            P : Node; Strong : Boolean) return Node
+   is
+   begin
+      return Rewrite_Next_Event_A (True_Node, Lo + 1, Hi + 1, P, Strong);
+   end Rewrite_Next_A;
+
+   function Rewrite_Next_Event_E (B1 : Node;
+                                  Lo, Hi : Uns32;
+                                  B2 : Node; Strong : Boolean) return Node
+   is
+      Res : Node;
+   begin
+      Res := Build_Binary (N_Fusion_SERE,
+                           Rewrite_Goto_Repeat_Seq (B1, Lo, Hi),
+                           B2);
+      if Strong then
+         Res := Build_Strong (Res);
+      end if;
+      return Res;
+   end Rewrite_Next_Event_E;
+
+   function Rewrite_Next_E (Lo, Hi : Uns32;
+                            B : Node; Strong : Boolean) return Node
+   is
+   begin
+      return Rewrite_Next_Event_E (True_Node, Lo + 1, Hi + 1, B, Strong);
+   end Rewrite_Next_E;
+
+   function Rewrite_Before (N : Node) return Node
+   is
+      Res : Node;
+      R : Node;
+      B1, B2 : Node;
+      N_B2 : Node;
+   begin
+      B1 := Rewrite_Boolean (Get_Left (N));
+      B2 := Rewrite_Boolean (Get_Right (N));
+      N_B2 := Build_Bool_Not (B2);
+      Res := Build_Star (Build_Bool_And (Build_Bool_Not (B1), N_B2));
+
+      if Get_Inclusive_Flag (N) then
+         R := B2;
+      else
+         R := Build_Bool_And (B1, N_B2);
+      end if;
+      Res := Build_Concat (Res, R);
+      if Get_Strong_Flag (N) then
+         Res := Build_Strong (Res);
+      end if;
+      return Res;
+   end Rewrite_Before;
+
+   function Rewrite_Or (L, R : Node) return Node
+   is
+      B, P : Node;
+   begin
+      if Get_Kind (L) in N_Booleans then
+         if Get_Kind (R) in N_Booleans then
+            return Build_Bool_Or (L, R);
+         else
+            B := L;
+            P := R;
+         end if;
+      elsif Get_Kind (R) in N_Booleans then
+         B := R;
+         P := L;
+      else
+         --  Not in the simple subset.
+         raise Program_Error;
+      end if;
+
+      --  B || P  --> (~B) -> P
+      return Build_Binary (N_Log_Imp_Prop, Build_Bool_Not (B), P);
+   end Rewrite_Or;
+
+   function Rewrite_Property (N : Node) return Node is
+   begin
+      case Get_Kind (N) is
+         when N_Star_Repeat_Seq
+           | N_Plus_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Sequence_Instance
+           | N_Endpoint_Instance
+           | N_Braced_SERE =>
+            return Rewrite_SERE (N);
+         when N_Imp_Seq
+           | N_Overlap_Imp_Seq =>
+            Set_Sequence (N, Rewrite_Property (Get_Sequence (N)));
+            Set_Property (N, Rewrite_Property (Get_Property (N)));
+            return N;
+         when N_Log_Imp_Prop =>
+            --  b -> p   -->  {b} |-> p
+            return Build_Overlap_Imp_Seq
+              (Rewrite_Boolean (Get_Left (N)),
+               Rewrite_Property (Get_Right (N)));
+         when N_Eventually =>
+            return Build_Strong
+              (Build_Binary (N_Fusion_SERE,
+                             Build_Plus (True_Node),
+                             Rewrite_SERE (Get_Property (N))));
+         when N_Until =>
+            return Rewrite_Until (N);
+         when N_Next =>
+            return Rewrite_Next (Get_Number (N),
+                                 Rewrite_Property (Get_Property (N)),
+                                 Get_Strong_Flag (N));
+         when N_Next_Event =>
+            return Rewrite_Next_Event (Rewrite_Boolean (Get_Boolean (N)),
+                                       Get_Number (N),
+                                       Rewrite_Property (Get_Property (N)),
+                                       Get_Strong_Flag (N));
+         when N_Next_A =>
+            return Rewrite_Next_A (Get_Value (Get_Low_Bound (N)),
+                                   Get_Value (Get_High_Bound (N)),
+                                   Rewrite_Property (Get_Property (N)),
+                                   Get_Strong_Flag (N));
+         when N_Next_Event_A =>
+            return Rewrite_Next_Event_A
+              (Rewrite_Boolean (Get_Boolean (N)),
+               Get_Value (Get_Low_Bound (N)),
+               Get_Value (Get_High_Bound (N)),
+               Rewrite_Property (Get_Property (N)),
+               Get_Strong_Flag (N));
+         when N_Next_E =>
+            return Rewrite_Next_E (Get_Value (Get_Low_Bound (N)),
+                                   Get_Value (Get_High_Bound (N)),
+                                   Rewrite_Property (Get_Property (N)),
+                                   Get_Strong_Flag (N));
+         when N_Next_Event_E =>
+            return Rewrite_Next_Event_E
+              (Rewrite_Boolean (Get_Boolean (N)),
+               Get_Value (Get_Low_Bound (N)),
+               Get_Value (Get_High_Bound (N)),
+               Rewrite_Property (Get_Property (N)),
+               Get_Strong_Flag (N));
+         when N_Before =>
+            return Rewrite_Before (N);
+         when N_Booleans =>
+            return Rewrite_Boolean (N);
+         when N_Name =>
+            return Get_Decl (N);
+         when N_Never
+           | N_Always
+           | N_Strong =>
+            --  Fully handled by psl.build
+            Set_Property (N, Rewrite_Property (Get_Property (N)));
+            return N;
+         when N_Clock_Event =>
+            Set_Property (N, Rewrite_Property (Get_Property (N)));
+            Set_Boolean (N, Rewrite_Boolean (Get_Boolean (N)));
+            return N;
+         when N_And_Prop =>
+            Set_Left (N, Rewrite_Property (Get_Left (N)));
+            Set_Right (N, Rewrite_Property (Get_Right (N)));
+            return N;
+         when N_Or_Prop =>
+            return Rewrite_Or (Rewrite_Property (Get_Left (N)),
+                               Rewrite_Property (Get_Right (N)));
+         when N_Abort =>
+            Set_Boolean (N, Rewrite_Boolean (Get_Boolean (N)));
+            Set_Property (N, Rewrite_Property (Get_Property (N)));
+            return N;
+         when N_Property_Instance =>
+            Rewrite_Instance (N);
+            return N;
+         when others =>
+            Error_Kind ("rewrite_property", N);
+      end case;
+   end Rewrite_Property;
+
+   procedure Rewrite_Unit (N : Node) is
+      Item : Node;
+   begin
+      Item := Get_Item_Chain (N);
+      while Item /= Null_Node loop
+         case Get_Kind (Item) is
+            when N_Name_Decl =>
+               null;
+            when N_Assert_Directive =>
+               Set_Property (Item, Rewrite_Property (Get_Property (Item)));
+            when N_Property_Declaration =>
+               Set_Property (Item, Rewrite_Property (Get_Property (Item)));
+            when others =>
+               Error_Kind ("rewrite_unit", Item);
+         end case;
+         Item := Get_Chain (Item);
+      end loop;
+   end Rewrite_Unit;
+end PSL.Rewrites;
diff --git a/src/psl/psl-rewrites.ads b/src/psl/psl-rewrites.ads
new file mode 100644
index 000000000..ac76b7805
--- /dev/null
+++ b/src/psl/psl-rewrites.ads
@@ -0,0 +1,7 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Rewrites is
+   function Rewrite_SERE (N : Node) return Node;
+   function Rewrite_Property (N : Node) return Node;
+   procedure Rewrite_Unit (N : Node);
+end PSL.Rewrites;
diff --git a/src/psl/psl-subsets.adb b/src/psl/psl-subsets.adb
new file mode 100644
index 000000000..f322eafda
--- /dev/null
+++ b/src/psl/psl-subsets.adb
@@ -0,0 +1,177 @@
+with PSL.Errors; use PSL.Errors;
+with Types; use Types;
+
+package body PSL.Subsets is
+   procedure Check_Simple (N : Node)
+   is
+   begin
+      case Get_Kind (N) is
+         when N_Not_Bool =>
+            if Get_Psl_Type (Get_Boolean (N)) /= Type_Boolean then
+               Error_Msg_Sem
+                 ("operand of a negation operator must be a boolean", N);
+            end if;
+         when N_Never =>
+            case Get_Psl_Type (Get_Property (N)) is
+               when Type_Sequence | Type_Boolean =>
+                  null;
+               when others =>
+                  Error_Msg_Sem ("operand of a 'never' operator must be "
+                                   & "a boolean or a sequence", N);
+            end case;
+         when N_Eventually =>
+            case Get_Psl_Type (Get_Property (N)) is
+               when Type_Sequence | Type_Boolean =>
+                  null;
+               when others =>
+                  Error_Msg_Sem ("operand of an 'eventually!' operator must be"
+                                   & " a boolean or a sequence", N);
+            end case;
+         when N_And_Bool =>
+            if Get_Psl_Type (Get_Left (N)) /= Type_Boolean then
+               Error_Msg_Sem ("left-hand side operand of logical 'and' must be"
+                                & " a boolean", N);
+            end if;
+         when N_Or_Bool =>
+            if Get_Psl_Type (Get_Left (N)) /= Type_Boolean then
+               Error_Msg_Sem ("left-hand side operand of logical 'or' must be"
+                                & " a boolean", N);
+            end if;
+         when N_Log_Imp_Prop =>
+            if Get_Psl_Type (Get_Left (N)) /= Type_Boolean then
+               Error_Msg_Sem ("left-hand side operand of logical '->' must be"
+                                & " a boolean", N);
+            end if;
+            --  FIXME: <->
+         when N_Until =>
+            if not Get_Inclusive_Flag (N) then
+               if Get_Psl_Type (Get_Right (N)) /= Type_Boolean then
+                  Error_Msg_Sem ("right-hand side of a non-overlapping "
+                                   & "'until*' operator must be a boolean", N);
+               end if;
+            else
+               if Get_Psl_Type (Get_Right (N)) /= Type_Boolean
+                 or else Get_Psl_Type (Get_Left (N)) /= Type_Boolean
+               then
+                  Error_Msg_Sem ("both operands of an overlapping 'until*'"
+                                   & " operator are boolean", N);
+               end if;
+            end if;
+         when N_Before =>
+            if Get_Psl_Type (Get_Right (N)) /= Type_Boolean
+              or else Get_Psl_Type (Get_Left (N)) /= Type_Boolean
+            then
+               Error_Msg_Sem ("both operands of a 'before*'"
+                                & " operator are boolean", N);
+            end if;
+         when others =>
+            null;
+      end case;
+
+      --  Recursion.
+      case Get_Kind (N) is
+         when N_Error =>
+            null;
+         when N_Hdl_Mod_Name =>
+            null;
+         when N_Vunit
+           | N_Vmode
+           | N_Vprop =>
+            declare
+               Item : Node;
+            begin
+               Item := Get_Item_Chain (N);
+               while Item /= Null_Node loop
+                  Check_Simple (Item);
+                  Item := Get_Chain (Item);
+               end loop;
+            end;
+         when N_Name_Decl =>
+            null;
+         when N_Assert_Directive
+           | N_Property_Declaration =>
+            Check_Simple (Get_Property (N));
+         when N_Endpoint_Declaration
+           | N_Sequence_Declaration =>
+            Check_Simple (Get_Sequence (N));
+         when N_Clock_Event =>
+            Check_Simple (Get_Property (N));
+            Check_Simple (Get_Boolean (N));
+         when N_Always
+           | N_Never
+           | N_Eventually
+           | N_Strong =>
+            Check_Simple (Get_Property (N));
+         when N_Braced_SERE =>
+            Check_Simple (Get_SERE (N));
+         when N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Within_SERE =>
+            Check_Simple (Get_Left (N));
+            Check_Simple (Get_Right (N));
+         when N_Name =>
+            null;
+         when N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq =>
+            declare
+               N2 : constant Node := Get_Sequence (N);
+            begin
+               if N2 /= Null_Node then
+                  Check_Simple (N2);
+               end if;
+            end;
+         when N_Plus_Repeat_Seq =>
+            Check_Simple (Get_Sequence (N));
+         when N_Match_And_Seq
+           | N_And_Seq
+           | N_Or_Seq =>
+            Check_Simple (Get_Left (N));
+            Check_Simple (Get_Right (N));
+         when N_Imp_Seq
+           | N_Overlap_Imp_Seq =>
+            Check_Simple (Get_Sequence (N));
+            Check_Simple (Get_Property (N));
+         when N_Log_Imp_Prop
+           | N_Until
+           | N_Before
+           | N_Or_Prop
+           | N_And_Prop
+           | N_And_Bool
+           | N_Or_Bool
+           | N_Imp_Bool =>
+            Check_Simple (Get_Left (N));
+            Check_Simple (Get_Right (N));
+         when N_Next
+           | N_Next_A
+           | N_Next_E =>
+            Check_Simple (Get_Property (N));
+         when N_Next_Event
+           | N_Next_Event_A
+           | N_Next_Event_E
+           | N_Abort =>
+            Check_Simple (Get_Boolean (N));
+            Check_Simple (Get_Property (N));
+         when N_Not_Bool =>
+            Check_Simple (Get_Boolean (N));
+         when N_Const_Parameter
+           | N_Sequence_Parameter
+           | N_Boolean_Parameter
+           | N_Property_Parameter =>
+            null;
+         when N_Actual =>
+            null;
+         when N_Sequence_Instance
+           | N_Endpoint_Instance
+           | N_Property_Instance =>
+            null;
+         when N_True
+           | N_False
+           | N_Number
+           | N_EOS
+           | N_HDL_Expr =>
+            null;
+      end case;
+   end Check_Simple;
+end PSL.Subsets;
+
diff --git a/src/psl/psl-subsets.ads b/src/psl/psl-subsets.ads
new file mode 100644
index 000000000..c3bae09ef
--- /dev/null
+++ b/src/psl/psl-subsets.ads
@@ -0,0 +1,23 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Subsets is
+   --  Check that N (a property) follows the simple subset rules from
+   --  PSL v1.1 4.4.4 Simple subset.
+   --  Ie:
+   --  - The operand of a negation operator is a Boolean.
+   --  - The operand of a 'never' operator is a Boolean or a Sequence.
+   --  - The operand of an 'eventually!' operator is a Boolean or a Sequence.
+   --  - The left-hand side operand of a logical 'and' operator is a Boolean.
+   --  - The left-hand side operand of a logical 'or' operator is a Boolean.
+   --  - The left-hand side operand of a logical implication '->' operator
+   --    is a Boolean.
+   --  - Both operands of a logical iff '<->' operator are Boolean.
+   --  - The right-hand side operand of a non-overlapping 'until*' operator is
+   --    a Boolean.
+   --  - Both operands of an overlapping 'until*' operator are Boolean.
+   --  - Both operands of a 'before*' operator are Boolean.
+   --
+   --  All other operators not mentioned above are supported in the simple
+   --  subset without restriction.
+   procedure Check_Simple (N : Node);
+end PSL.Subsets;
diff --git a/src/psl/psl-tprint.adb b/src/psl/psl-tprint.adb
new file mode 100644
index 000000000..eabe8bd28
--- /dev/null
+++ b/src/psl/psl-tprint.adb
@@ -0,0 +1,255 @@
+with Types; use Types;
+with PSL.Errors; use PSL.Errors;
+with PSL.Prints;
+with Ada.Text_IO; use Ada.Text_IO;
+with Name_Table; use Name_Table;
+
+package body PSL.Tprint is
+   procedure Disp_Expr (N : Node) is
+   begin
+      case Get_Kind (N) is
+         when N_Number =>
+            declare
+               Str : constant String := Uns32'Image (Get_Value (N));
+            begin
+               Put (Str (2 .. Str'Last));
+            end;
+         when others =>
+            Error_Kind ("disp_expr", N);
+      end case;
+   end Disp_Expr;
+
+   procedure Disp_Count (N : Node) is
+      B : Node;
+   begin
+      B := Get_Low_Bound (N);
+      if B = Null_Node then
+         return;
+      end if;
+      Disp_Expr (B);
+      B := Get_High_Bound (N);
+      if B = Null_Node then
+         return;
+      end if;
+      Put (":");
+      Disp_Expr (B);
+   end Disp_Count;
+
+   procedure Put_Node (Prefix : String; Name : String) is
+   begin
+      Put (Prefix);
+      Put ("-+ ");
+      Put (Name);
+   end Put_Node;
+
+   procedure Put_Node_Line (Prefix : String; Name : String) is
+   begin
+      Put_Node (Prefix, Name);
+      New_Line;
+   end Put_Node_Line;
+
+   function Down (Str : String) return String is
+      L : constant Natural := Str'Last;
+   begin
+      if Str (L) = '\' then
+         return Str (Str'First .. L - 1) & "  \";
+      elsif Str (L) = '/' then
+         return Str (Str'First .. L - 1) & "| \";
+      else
+         raise Program_Error;
+      end if;
+   end Down;
+
+   function Up (Str : String) return String is
+      L : constant Natural := Str'Last;
+   begin
+      if Str (L) = '/' then
+         return Str (Str'First .. L - 1) & "  /";
+      elsif Str (L) = '\' then
+         return Str (Str'First .. L - 1) & "| /";
+      else
+         raise Program_Error;
+      end if;
+   end Up;
+
+   procedure Disp_Repeat_Sequence (Prefix : String; Name : String; N : Node) is
+      S : Node;
+   begin
+      Put_Node (Prefix, Name);
+      Disp_Count (N);
+      Put_Line ("]");
+      S := Get_Sequence (N);
+      if S /= Null_Node then
+         Disp_Property (Down (Prefix), S);
+      end if;
+   end Disp_Repeat_Sequence;
+
+   procedure Disp_Binary_Sequence (Prefix : String; Name : String; N : Node) is
+   begin
+      Disp_Property (Up (Prefix), Get_Left (N));
+      Put_Node_Line (Prefix, Name);
+      Disp_Property (Down (Prefix), Get_Right (N));
+   end Disp_Binary_Sequence;
+
+   procedure Disp_Range_Property (Prefix : String; Name : String; N : Node) is
+   begin
+      Put_Node (Prefix, Name);
+      Put ("[");
+      Disp_Count (N);
+      Put_Line ("]");
+      Disp_Property (Down (Prefix), Get_Property (N));
+   end Disp_Range_Property;
+
+   procedure Disp_Boolean_Range_Property (Prefix : String;
+                                          Name : String; N : Node) is
+   begin
+      Disp_Property (Up (Prefix), Get_Boolean (N));
+      Put_Node (Prefix, Name);
+      Put ("[");
+      Disp_Count (N);
+      Put_Line ("]");
+      Disp_Property (Down (Prefix), Get_Property (N));
+   end Disp_Boolean_Range_Property;
+
+   procedure Disp_Property (Prefix : String; Prop : Node) is
+   begin
+      case Get_Kind (Prop) is
+         when N_Never =>
+            Put_Node_Line (Prefix, "never");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Always =>
+            Put_Node_Line (Prefix, "always");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Eventually =>
+            Put_Node_Line (Prefix, "eventually!");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Next =>
+            Put_Node_Line (Prefix, "next");
+--              if Get_Strong_Flag (Prop) then
+--                 Put ('!');
+--              end if;
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Next_A =>
+            Disp_Range_Property (Prefix, "next_a", Prop);
+         when N_Next_E =>
+            Disp_Range_Property (Prefix, "next_e", Prop);
+         when N_Next_Event =>
+            Disp_Property (Up (Prefix), Get_Boolean (Prop));
+            Put_Node_Line (Prefix, "next_event");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Next_Event_A =>
+            Disp_Boolean_Range_Property (Prefix, "next_event_a", Prop);
+         when N_Next_Event_E =>
+            Disp_Boolean_Range_Property (Prefix, "next_event_e", Prop);
+         when N_Braced_SERE =>
+            Put_Node_Line (Prefix, "{} (braced_SERE)");
+            Disp_Property (Down (Prefix), Get_SERE (Prop));
+         when N_Concat_SERE =>
+            Disp_Binary_Sequence (Prefix, "; (concat)", Prop);
+         when N_Fusion_SERE =>
+            Disp_Binary_Sequence (Prefix, ": (fusion)", Prop);
+         when N_Within_SERE =>
+            Disp_Binary_Sequence (Prefix, "within", Prop);
+         when N_Match_And_Seq =>
+            Disp_Binary_Sequence (Prefix, "&& (sequence matching len)", Prop);
+         when N_Or_Seq =>
+            Disp_Binary_Sequence (Prefix, "| (sequence or)", Prop);
+         when N_And_Seq =>
+            Disp_Binary_Sequence (Prefix, "& (sequence and)", Prop);
+         when N_Imp_Seq =>
+            Disp_Property (Up (Prefix), Get_Sequence (Prop));
+            Put_Node_Line (Prefix, "|=> (sequence implication)");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Overlap_Imp_Seq =>
+            Disp_Property (Up (Prefix), Get_Sequence (Prop));
+            Put_Node_Line (Prefix, "|->");
+            Disp_Property (Down (Prefix), Get_Property (Prop));
+         when N_Or_Prop =>
+            Disp_Binary_Sequence (Prefix, "|| (property or)", Prop);
+         when N_And_Prop =>
+            Disp_Binary_Sequence (Prefix, "&& (property and)", Prop);
+         when N_Log_Imp_Prop =>
+            Disp_Binary_Sequence (Prefix, "-> (property impliciation)", Prop);
+         when N_Until =>
+            Disp_Binary_Sequence (Prefix, "until", Prop);
+         when N_Before =>
+            Disp_Binary_Sequence (Prefix, "before", Prop);
+         when N_Abort =>
+            Disp_Property (Up (Prefix), Get_Property (Prop));
+            Put_Node_Line (Prefix, "abort");
+            Disp_Property (Down (Prefix), Get_Boolean (Prop));
+         when N_Not_Bool =>
+            Put_Node_Line (Prefix, "! (boolean not)");
+            Disp_Property (Down (Prefix), Get_Boolean (Prop));
+         when N_Or_Bool =>
+            Disp_Binary_Sequence (Prefix, "|| (boolean or)", Prop);
+         when N_And_Bool =>
+            Disp_Binary_Sequence (Prefix, "&& (boolean and)", Prop);
+         when N_Name_Decl =>
+            Put_Node_Line (Prefix,
+                           "Name_Decl: " & Image (Get_Identifier (Prop)));
+         when N_Name =>
+            Put_Node_Line (Prefix, "Name: " & Image (Get_Identifier (Prop)));
+            Disp_Property (Down (Prefix), Get_Decl (Prop));
+         when N_True =>
+            Put_Node_Line (Prefix, "TRUE");
+         when N_False =>
+            Put_Node_Line (Prefix, "FALSE");
+         when N_HDL_Expr =>
+            Put_Node (Prefix, "HDL_Expr: ");
+            PSL.Prints.HDL_Expr_Printer.all (Get_HDL_Node (Prop));
+            New_Line;
+         when N_Star_Repeat_Seq =>
+            Disp_Repeat_Sequence (Prefix, "[*", Prop);
+         when N_Goto_Repeat_Seq =>
+            Disp_Repeat_Sequence (Prefix, "[->", Prop);
+         when N_Equal_Repeat_Seq =>
+            Disp_Repeat_Sequence (Prefix, "[=", Prop);
+         when N_Plus_Repeat_Seq =>
+            Put_Node_Line (Prefix, "[+]");
+            Disp_Property (Down (Prefix), Get_Sequence (Prop));
+         when others =>
+            Error_Kind ("disp_property", Prop);
+      end case;
+   end Disp_Property;
+
+   procedure Disp_Assert (N : Node) is
+      Label : constant Name_Id := Get_Label (N);
+   begin
+      Put ("  ");
+      if Label /= Null_Identifier then
+         Put (Image (Label));
+         Put (": ");
+      end if;
+      Put_Line ("assert ");
+      Disp_Property ("  \", Get_Property (N));
+   end Disp_Assert;
+
+   procedure Disp_Unit (Unit : Node) is
+      Item : Node;
+   begin
+      case Get_Kind (Unit) is
+         when N_Vunit =>
+            Put ("vunit");
+         when others =>
+            Error_Kind ("disp_unit", Unit);
+      end case;
+      Put (' ');
+      Put (Image (Get_Identifier (Unit)));
+      Put_Line (" {");
+      Item := Get_Item_Chain (Unit);
+      while Item /= Null_Node loop
+         case Get_Kind (Item) is
+            when N_Assert_Directive =>
+               Disp_Assert (Item);
+            when N_Name_Decl =>
+               null;
+            when others =>
+               Error_Kind ("disp_unit", Item);
+         end case;
+         Item := Get_Chain (Item);
+      end loop;
+      Put_Line ("}");
+   end Disp_Unit;
+end PSL.Tprint;
+
diff --git a/src/psl/psl-tprint.ads b/src/psl/psl-tprint.ads
new file mode 100644
index 000000000..1b06ebf1a
--- /dev/null
+++ b/src/psl/psl-tprint.ads
@@ -0,0 +1,6 @@
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Tprint is
+   procedure Disp_Unit (Unit : Node);
+   procedure Disp_Property (Prefix : String; Prop : Node);
+end PSL.Tprint;
diff --git a/src/psl/psl.ads b/src/psl/psl.ads
new file mode 100644
index 000000000..a2f4bdce0
--- /dev/null
+++ b/src/psl/psl.ads
@@ -0,0 +1,3 @@
+package PSL is
+   pragma Pure (PSL);
+end PSL;
diff --git a/src/scanner-scan_literal.adb b/src/scanner-scan_literal.adb
new file mode 100644
index 000000000..74acf44d5
--- /dev/null
+++ b/src/scanner-scan_literal.adb
@@ -0,0 +1,651 @@
+--  Lexical analysis for numbers.
+--  Copyright (C) 2002 - 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+
+separate (Scanner)
+
+-- scan a decimal literal or a based literal.
+--
+-- LRM93 13.4.1
+-- DECIMAL_LITERAL ::= INTEGER [ . INTEGER ] [ EXPONENT ]
+-- EXPONENT ::= E [ + ] INTEGER | E - INTEGER
+--
+-- LRM93 13.4.2
+-- BASED_LITERAL ::= BASE # BASED_INTEGER [ . BASED_INTEGER ] # EXPONENT
+-- BASE ::= INTEGER
+procedure Scan_Literal is
+   --  The base of an E_NUM is 2**16.
+   --  Type Uint16 is the type of a digit.
+   type Uint16 is mod 2 ** 16;
+
+   type Uint32 is mod 2 ** 32;
+
+   --  Type of the exponent.
+   type Sint16 is range -2 ** 15 .. 2 ** 15 - 1;
+
+   --  Number of digits in a E_NUM.
+   --  We want at least 64bits of precision, so at least 5 digits of 16 bits
+   --  are required.
+   Nbr_Digits : constant Sint16 := 5;
+   subtype Digit_Range is Sint16 range 0 .. Nbr_Digits - 1;
+
+   type Uint16_Array is array (Sint16 range <>) of Uint16;
+
+   --  The value of an E_NUM is (S(N-1)|S(N-2) .. |S(0))* 2**(16*E)
+   --  where '|' is concatenation.
+   type E_Num is record
+      S : Uint16_Array (Digit_Range);
+      E : Sint16;
+   end record;
+
+   E_Zero : constant E_Num := (S => (others => 0), E => 0);
+   E_One  : constant E_Num := (S => (0 => 1, others => 0), E => 0);
+
+   --  Compute RES = E * B + V.
+   --  RES and E can be the same object.
+   procedure Bmul (Res : out E_Num; E : E_Num; V : Uint16; B : Uint16);
+
+   --  Convert to integer.
+   procedure Fix (Res : out Iir_Int64; Ok : out Boolean; E : E_Num);
+
+   --  RES := A * B
+   --  RES can be A or B.
+   procedure Mul (Res : out E_Num; A, B : E_Num);
+
+   --  RES := A / B.
+   --  RES can be A.
+   --  May raise constraint error.
+   procedure Div (Res : out E_Num; A, B: E_Num);
+
+   --  Convert V to an E_Num.
+   function To_E_Num (V : Uint16) return E_Num;
+
+   --  Convert E to RES.
+   procedure To_Float (Res : out Iir_Fp64; Ok : out Boolean; E : E_Num);
+
+   procedure Bmul (Res : out E_Num; E : E_Num; V : Uint16; B : Uint16)
+   is
+      --  The carry.
+      C : Uint32;
+   begin
+      --  Only consider V if E is not scaled (otherwise V is not significant).
+      if E.E = 0 then
+         C := Uint32 (V);
+      else
+         C := 0;
+      end if;
+
+      --  Multiply and propagate the carry.
+      for I in Digit_Range loop
+         C := Uint32 (E.S (I)) * Uint32 (B) + C;
+         Res.S (I) := Uint16 (C mod Uint16'Modulus);
+         C := C / Uint16'Modulus;
+      end loop;
+
+      --  There is a carry, shift.
+      if C /= 0 then
+         --  ERR: Possible overflow.
+         Res.E := E.E + 1;
+         for I in 0 .. Nbr_Digits - 2 loop
+            Res.S (I) := Res.S (I + 1);
+         end loop;
+         Res.S (Nbr_Digits - 1) := Uint16 (C);
+      else
+         Res.E := E.E;
+      end if;
+   end Bmul;
+
+   type Uint64 is mod 2 ** 64;
+   function Shift_Left (Value : Uint64; Amount: Natural) return Uint64;
+   function Shift_Left (Value : Uint16; Amount: Natural) return Uint16;
+   pragma Import (Intrinsic, Shift_Left);
+
+   function Shift_Right (Value : Uint16; Amount: Natural) return Uint16;
+   pragma Import (Intrinsic, Shift_Right);
+
+   function Unchecked_Conversion is new Ada.Unchecked_Conversion
+     (Source => Uint64, Target => Iir_Int64);
+
+   procedure Fix (Res : out Iir_Int64; Ok : out Boolean; E : E_Num)
+   is
+      R : Uint64;
+      M : Sint16;
+   begin
+      --  Find the most significant digit.
+      M := -1;
+      for I in reverse Digit_Range loop
+         if E.S (I) /= 0 then
+            M := I;
+            exit;
+         end if;
+      end loop;
+
+      --  Handle the easy 0 case.
+      --  The case M = -1 is handled below, in the normal flow.
+      if M + E.E < 0 then
+         Res := 0;
+         Ok := True;
+         return;
+      end if;
+
+      --  Handle overflow.
+      --  4 is the number of uint16 in a uint64.
+      if M + E.E >= 4 then
+         Ok := False;
+         return;
+      end if;
+
+      --  Convert
+      R := 0;
+      for I in 0 .. M loop
+         R := R or Shift_Left (Uint64 (E.S (I)), 16 * Natural (E.E + I));
+      end loop;
+      --  Check the sign bit is 0.
+      if (R and Shift_Left (1, 63)) /= 0 then
+         Ok := False;
+      else
+         Ok := True;
+         Res := Unchecked_Conversion (R);
+      end if;
+   end Fix;
+
+   --  Return the position of the most non-null digit, -1 if V is 0.
+   function First_Digit (V : E_Num) return Sint16 is
+   begin
+      for I in reverse Digit_Range loop
+         if V.S (I) /= 0 then
+            return I;
+         end if;
+      end loop;
+      return -1;
+   end First_Digit;
+
+   procedure Mul (Res : out E_Num; A, B : E_Num)
+   is
+      T : Uint16_Array (0 .. 2 * Nbr_Digits - 1);
+      V : Uint32;
+      Max : Sint16;
+   begin
+      V := 0;
+      for I in 0 .. Nbr_Digits - 1 loop
+         for J in 0 .. I loop
+            V := V + Uint32 (A.S (J)) * Uint32 (B.S (I - J));
+         end loop;
+         T (I) := Uint16 (V mod Uint16'Modulus);
+         V := V / Uint16'Modulus;
+      end loop;
+      for I in Nbr_Digits .. 2 * Nbr_Digits - 2 loop
+         for J in I - Nbr_Digits + 1 .. Nbr_Digits - 1 loop
+            V := V + Uint32 (A.S (J)) * Uint32 (B.S (I - J));
+         end loop;
+         T (I) := Uint16 (V mod Uint16'Modulus);
+         V := V / Uint16'Modulus;
+      end loop;
+      T (T'Last) := Uint16 (V);
+      --  Search the leading non-nul.
+      Max := -1;
+      for I in reverse T'Range loop
+         if T (I) /= 0 then
+            Max := I;
+            exit;
+         end if;
+      end loop;
+      if Max > Nbr_Digits - 1 then
+         --  Loss of precision.
+         --  Round.
+         if T (Max - Nbr_Digits) >= Uint16 (Uint16'Modulus / 2) then
+            V := 1;
+            for I in Max - (Nbr_Digits - 1) .. Max loop
+               V := V + Uint32 (T (I));
+               T (I) := Uint16 (V mod Uint16'Modulus);
+               V := V / Uint16'Modulus;
+               exit when V = 0;
+            end loop;
+            if V /= 0 then
+               Max := Max + 1;
+               T (Max) := Uint16 (V);
+            end if;
+         end if;
+         Res.S := T (Max - (Nbr_Digits - 1) .. Max);
+         --  This may overflow.
+         Res.E := A.E + B.E + Max - (Nbr_Digits - 1);
+      else
+         Res.S (0 .. Max) := T (0 .. Max);
+         Res.S (Max + 1 .. Nbr_Digits - 1) := (others => 0);
+         --  This may overflow.
+         Res.E := A.E + B.E;
+      end if;
+   end Mul;
+
+   procedure Div (Res : out E_Num; A, B: E_Num)
+   is
+      Dividend : Uint16_Array (0 .. Nbr_Digits);
+      A_F : constant Sint16 := First_Digit (A);
+      B_F : constant Sint16 := First_Digit (B);
+
+      --  Digit corresponding to the first digit of B.
+      Doff : constant Sint16 := Dividend'Last - B_F;
+      Q : Uint16;
+      C, N_C : Uint16;
+   begin
+      --  Check for division by 0.
+      if B_F < 0 then
+         raise Constraint_Error;
+      end if;
+
+      --  Copy and shift dividend.
+      --  Bit 15 of the most significant digit of A becomes bit 0 of the
+      --  most significant digit of DIVIDEND.  Therefore we are sure
+      --  DIVIDEND < B (after realignment).
+      C := 0;
+      for K in 0 .. A_F loop
+         N_C := Shift_Right (A.S (K), 15);
+         Dividend (Dividend'Last - A_F - 1 + K)
+           := Shift_Left (A.S (K), 1) or C;
+         C := N_C;
+      end loop;
+      Dividend (Nbr_Digits) := C;
+      Dividend (0 .. Dividend'last - 2 - A_F) := (others => 0);
+
+      --  Algorithm is the same as division by hand.
+      C := 0;
+      for I in reverse Digit_Range loop
+         Q := 0;
+         for J in 0 .. 15 loop
+            declare
+               Borrow : Uint32;
+               Tmp : Uint16_Array (0 .. B_F);
+               V : Uint32;
+               V16 : Uint16;
+            begin
+               --  Compute TMP := dividend - B;
+               Borrow := 0;
+               for K in 0 .. B_F loop
+                  V := Uint32 (B.S (K)) + Borrow;
+                  V16 := Uint16 (V mod Uint16'Modulus);
+                  if V16 > Dividend (Doff + K) then
+                     Borrow := 1;
+                  else
+                     Borrow := 0;
+                  end if;
+                  Tmp (K) := Dividend (Doff + K) - V16;
+               end loop;
+
+               --  If the last shift creates a carry, we are sure Dividend > B
+               if C /= 0 then
+                  Borrow := 0;
+               end if;
+
+               Q := Q * 2;
+               --  Begin of : Dividend = Dividend * 2
+               C := 0;
+               for K in 0 .. Doff - 1 loop
+                  N_C := Shift_Right (Dividend (K), 15);
+                  Dividend (K) := Shift_Left (Dividend (K), 1) or C;
+                  C := N_C;
+               end loop;
+
+               if Borrow = 0 then
+                  --  Dividend > B
+                  Q := Q + 1;
+                  --  Dividend = Tmp * 2
+                  --           = (Dividend - B) * 2
+                  for K in Doff .. Nbr_Digits loop
+                     N_C := Shift_Right (Tmp (K - Doff), 15);
+                     Dividend (K) := Shift_Left (Tmp (K - Doff), 1) or C;
+                     C := N_C;
+                  end loop;
+               else
+                  --  Dividend = Dividend * 2
+                  for K in Doff .. Nbr_Digits loop
+                     N_C := Shift_Right (Dividend (K), 15);
+                     Dividend (K) := Shift_Left (Dividend (K), 1) or C;
+                     C := N_C;
+                  end loop;
+               end if;
+            end;
+         end loop;
+         Res.S (I) := Q;
+      end loop;
+      Res.E := A.E - B.E + (A_F - B_F) - (Nbr_Digits - 1);
+   end Div;
+
+   procedure To_Float (Res : out Iir_Fp64; Ok : out Boolean; E : E_Num)
+   is
+      V : Iir_Fp64;
+      P : Iir_Fp64;
+   begin
+      Res := 0.0;
+      P := Iir_Fp64'Scaling (1.0, 16 * E.E);
+      for I in Digit_Range loop
+         V := Iir_Fp64 (E.S (I)) * P;
+         P := Iir_Fp64'Scaling (P, 16);
+         Res := Res + V;
+      end loop;
+      Ok := True;
+   end To_Float;
+
+   function To_E_Num (V : Uint16) return E_Num
+   is
+      Res : E_Num;
+   begin
+      Res.E := 0;
+      Res.S := (0 => V, others => 0);
+      return Res;
+   end To_E_Num;
+
+   --  Numbers of digits.
+   Scale : Integer;
+   Res : E_Num;
+
+   --  LRM 13.4.1
+   --  INTEGER ::= DIGIT { [ UNDERLINE ] DIGIT }
+   --
+   --  Update SCALE, RES.
+   --  The first character must be a digit.
+   procedure Scan_Integer
+   is
+      C : Character;
+   begin
+      C := Source (Pos);
+      loop
+         --  C is a digit.
+         Bmul (Res, Res, Character'Pos (C) - Character'Pos ('0'), 10);
+         Scale := Scale + 1;
+
+         Pos := Pos + 1;
+         C := Source (Pos);
+         if C = '_' then
+            loop
+               Pos := Pos + 1;
+               C := Source (Pos);
+               exit when C /= '_';
+               Error_Msg_Scan ("double underscore in number");
+            end loop;
+            if C not in '0' .. '9' then
+               Error_Msg_Scan ("underscore must be followed by a digit");
+            end if;
+         end if;
+         exit when C not in '0' .. '9';
+      end loop;
+   end Scan_Integer;
+
+   C : Character;
+   D : Uint16;
+   Ok : Boolean;
+   Has_Dot : Boolean;
+   Exp : Integer;
+   Exp_Neg : Boolean;
+   Base : Uint16;
+begin
+   --  Start with a simple and fast conversion.
+   C := Source (Pos);
+   D := 0;
+   loop
+      D := D * 10 + Character'Pos (C) - Character'Pos ('0');
+
+      Pos := Pos + 1;
+      C := Source (Pos);
+      if C = '_' then
+         loop
+            Pos := Pos + 1;
+            C := Source (Pos);
+            exit when C /= '_';
+            Error_Msg_Scan ("double underscore in number");
+         end loop;
+         if C not in '0' .. '9' then
+            Error_Msg_Scan ("underscore must be followed by a digit");
+         end if;
+      end if;
+      if C not in '0' .. '9' then
+         if C = '.' or else C = '#' or else (C = 'e' or C = 'E' or C = ':')
+         then
+            --  Continue scanning.
+            Res := To_E_Num (D);
+            exit;
+         end if;
+
+         --  Finished.
+         --  a universal integer.
+         Current_Token := Tok_Integer;
+         --  No possible overflow.
+         Current_Context.Int64 := Iir_Int64 (D);
+         return;
+      elsif D >= 6552 then
+         --  Number may be greather than the uint16 limit.
+         Scale := 0;
+         Res := To_E_Num (D);
+         Scan_Integer;
+         exit;
+      end if;
+   end loop;
+
+   Has_Dot := False;
+   Base := 10;
+
+   C := Source (Pos);
+   if C = '.' then
+      --  Decimal integer.
+      Has_Dot := True;
+      Scale := 0;
+      Pos := Pos + 1;
+      C := Source (Pos);
+      if C not in '0' .. '9' then
+         Error_Msg_Scan ("a dot must be followed by a digit");
+         return;
+      end if;
+      Scan_Integer;
+   elsif C = '#'
+     or else (C = ':' and then (Source (Pos + 1) in '0' .. '9'
+                                or else Source (Pos + 1) in 'a' .. 'f'
+                                or else Source (Pos + 1) in 'A' .. 'F'))
+   then
+      --  LRM 13.10
+      --  The number sign (#) of a based literal can be replaced by colon (:),
+      --  provided that the replacement is done for both occurrences.
+      -- GHDL: correctly handle 'variable v : integer range 0 to 7:= 3'.
+      --   Is there any other places where a digit can be followed
+      --   by a colon ? (See IR 1093).
+
+      --  Based integer.
+      declare
+         Number_Sign : constant Character := C;
+         Res_Int : Iir_Int64;
+      begin
+         Fix (Res_Int, Ok, Res);
+         if not Ok or else Res_Int > 16 then
+            --  LRM 13.4.2
+            --  The base must be [...] at most sixteen.
+            Error_Msg_Scan ("base must be at most 16");
+            --  Fallback.
+            Base := 16;
+         elsif Res_Int < 2 then
+            --  LRM 13.4.2
+            --  The base must be at least two [...].
+            Error_Msg_Scan ("base must be at least 2");
+            --  Fallback.
+            Base := 2;
+         else
+            Base := Uint16 (Res_Int);
+         end if;
+
+         Pos := Pos + 1;
+         Res := E_Zero;
+         C := Source (Pos);
+         loop
+            if C >= '0' and C <= '9' then
+               D := Character'Pos (C) - Character'Pos ('0');
+            elsif C >= 'A' and C <= 'F' then
+               D := Character'Pos (C) - Character'Pos ('A') + 10;
+            elsif C >= 'a' and C <= 'f' then
+               D := Character'Pos (C) - Character'Pos ('a') + 10;
+            else
+               Error_Msg_Scan ("bad extended digit");
+               exit;
+            end if;
+
+            if D >= Base then
+               --  LRM 13.4.2
+               --  The conventional meaning of base notation is
+               --  assumed; in particular the value of each extended
+               --  digit of a based literal must be less then the base.
+               Error_Msg_Scan ("digit beyond base");
+               D := 1;
+            end if;
+            Pos := Pos + 1;
+            Bmul (Res, Res, D, Base);
+            Scale := Scale + 1;
+
+            C := Source (Pos);
+            if C = '_' then
+               loop
+                  Pos := Pos + 1;
+                  C := Source (Pos);
+                  exit when C /= '_';
+                  Error_Msg_Scan ("double underscore in based integer");
+               end loop;
+            elsif C = '.' then
+               if Has_Dot then
+                  Error_Msg_Scan ("double dot ignored");
+               else
+                  Has_Dot := True;
+                  Scale := 0;
+               end if;
+               Pos := Pos + 1;
+               C := Source (Pos);
+            elsif C = Number_Sign then
+               Pos := Pos + 1;
+               exit;
+            elsif C = '#' or C = ':' then
+               Error_Msg_Scan ("bad number sign replacement character");
+               exit;
+            end if;
+         end loop;
+      end;
+   end if;
+   C := Source (Pos);
+   Exp := 0;
+   if C = 'E' or else C = 'e' then
+      Pos := Pos + 1;
+      C := Source (Pos);
+      Exp_Neg := False;
+      if C = '+' then
+         Pos := Pos + 1;
+         C := Source (Pos);
+      elsif C = '-' then
+         if Has_Dot then
+            Exp_Neg := True;
+         else
+            --  LRM 13.4.1
+            --  An exponent for an integer literal must not have a minus sign.
+            --
+            --  LRM 13.4.2
+            --  An exponent for a based integer literal must not have a minus
+            --  sign.
+            Error_Msg_Scan
+              ("negative exponent not allowed for integer literal");
+         end if;
+         Pos := Pos + 1;
+         C := Source (Pos);
+      end if;
+      if C not in '0' .. '9' then
+         Error_Msg_Scan ("digit expected after exponent");
+      else
+         loop
+            --  C is a digit.
+            Exp := Exp * 10 + (Character'Pos (C) - Character'Pos ('0'));
+
+            Pos := Pos + 1;
+            C := Source (Pos);
+            if C = '_' then
+               loop
+                  Pos := Pos + 1;
+                  C := Source (Pos);
+                  exit when C /= '_';
+                  Error_Msg_Scan ("double underscore not allowed in integer");
+               end loop;
+               if C not in '0' .. '9' then
+                  Error_Msg_Scan ("digit expected after underscore");
+                  exit;
+               end if;
+            elsif C not in '0' .. '9' then
+               exit;
+            end if;
+         end loop;
+      end if;
+      if Exp_Neg then
+         Exp := -Exp;
+      end if;
+   end if;
+
+   if Has_Dot then
+      Scale := Scale - Exp;
+   else
+      Scale := -Exp;
+   end if;
+   if Scale /= 0 then
+      declare
+         Scale_Neg : Boolean;
+         Val_Exp : E_Num;
+         Val_Pow : E_Num;
+      begin
+         if Scale > 0 then
+            Scale_Neg := True;
+         else
+            Scale_Neg := False;
+            Scale := -Scale;
+         end if;
+
+         Val_Pow := To_E_Num (Base);
+         Val_Exp := E_One;
+         while Scale /= 0 loop
+            if Scale mod 2 = 1 then
+               Mul (Val_Exp, Val_Exp, Val_Pow);
+            end if;
+            Scale := Scale / 2;
+            Mul (Val_Pow, Val_Pow, Val_Pow);
+         end loop;
+         if Scale_Neg then
+            Div (Res, Res, Val_Exp);
+         else
+            Mul (Res, Res, Val_Exp);
+         end if;
+      end;
+   end if;
+
+   if Has_Dot then
+      -- a universal real.
+      Current_Token := Tok_Real;
+      -- Set to a valid literal, in case of constraint error.
+      To_Float (Current_Context.Fp64, Ok, Res);
+      if not Ok then
+         Error_Msg_Scan ("literal beyond real bounds");
+      end if;
+   else
+      -- a universal integer.
+      Current_Token := Tok_Integer;
+      -- Set to a valid literal, in case of constraint error.
+      Fix (Current_Context.Int64, Ok, Res);
+      if not Ok then
+         Error_Msg_Scan ("literal beyond integer bounds");
+      end if;
+   end if;
+exception
+   when Constraint_Error =>
+      Error_Msg_Scan ("literal overflow");
+end Scan_Literal;
diff --git a/src/scanner.adb b/src/scanner.adb
new file mode 100644
index 000000000..260bd7c8f
--- /dev/null
+++ b/src/scanner.adb
@@ -0,0 +1,1621 @@
+--  VHDL lexical scanner.
+--  Copyright (C) 2002 - 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Errorout; use Errorout;
+with Name_Table;
+with Files_Map; use Files_Map;
+with Std_Names;
+with Str_Table;
+with Flags; use Flags;
+
+package body Scanner is
+
+   -- This classification is a simplification of the categories of LRM93 13.1
+   -- LRM93 13.1
+   -- The only characters allowed in the text of a VHDL description are the
+   -- graphic characters and format effector.
+
+   type Character_Kind_Type is
+      (
+   -- Neither a format effector nor a graphic character.
+       Invalid,
+       Format_Effector,
+       Upper_Case_Letter,
+       Digit,
+       Special_Character,
+       Space_Character,
+       Lower_Case_Letter,
+       Other_Special_Character);
+
+   -- LRM93 13.1
+   -- BASIC_GRAPHIC_CHARACTER ::=
+   --   UPPER_CASE_LETTER | DIGIT | SPECIAL_CHARACTER | SPACE_CHARACTER
+   --subtype Basic_Graphic_Character is
+   --  Character_Kind_Type range Upper_Case_Letter .. Space_Character;
+
+   -- LRM93 13.1
+   -- GRAPHIC_CHARACTER ::=
+   --   BASIC_GRAPHIC_CHARACTER | LOWER_CASE_LETTER | OTHER_SPECIAL_CHARACTER
+   -- Note: There is 191 graphic character.
+   subtype Graphic_Character is
+     Character_Kind_Type range Upper_Case_Letter .. Other_Special_Character;
+
+   -- LRM93 13.1
+   -- The characters included in each of the categories of basic graphic
+   -- characters are defined as follows:
+   type Character_Array is array (Character) of Character_Kind_Type;
+   Characters_Kind : constant Character_Array :=
+     (NUL .. BS => Invalid,
+
+      -- Format effectors are the ISO (and ASCII) characters called horizontal
+      -- tabulation, vertical tabulation, carriage return, line feed, and form
+      -- feed.
+      HT | LF | VT | FF | CR => Format_Effector,
+
+      SO .. US => Invalid,
+
+      -- 1. upper case letters
+      'A' .. 'Z' | UC_A_Grave .. UC_O_Diaeresis |
+      UC_O_Oblique_Stroke .. UC_Icelandic_Thorn => Upper_Case_Letter,
+
+      -- 2. digits
+      '0' .. '9' => Digit,
+
+      -- 3. special characters
+      Quotation | '#' | '&' | ''' | '(' | ')' | '+' | ',' | '-' | '.' | '/'
+        | ':' | ';' | '<' | '=' | '>' | '[' | ']'
+        | '_' | '|' | '*' => Special_Character,
+
+      -- 4. the space characters
+      ' ' | No_Break_Space => Space_Character,
+
+      -- 5. lower case letters
+      'a' .. 'z' | LC_German_Sharp_S .. LC_O_Diaeresis |
+      LC_O_Oblique_Stroke .. LC_Y_Diaeresis => Lower_Case_Letter,
+
+      -- 6. other special characters
+      '!' | '$' | '%' | '@' | '?' | '\' | '^' | '`' | '{' | '}' | '~'
+        | Inverted_Exclamation .. Inverted_Question | Multiplication_Sign |
+        Division_Sign => Other_Special_Character,
+
+      --  '¡'    -- INVERTED EXCLAMATION MARK
+      --  '¢'    -- CENT SIGN
+      --  '£'    -- POUND SIGN
+      --  '¤'    -- CURRENCY SIGN
+      --  'Â¥'    -- YEN SIGN
+      --  '¦'    -- BROKEN BAR
+      --  '§'    -- SECTION SIGN
+      --  '¨'    -- DIAERESIS
+      --  '©'    -- COPYRIGHT SIGN
+      --  'ª'    -- FEMININE ORDINAL INDICATOR
+      --  '«'    -- LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+      --  '¬'    -- NOT SIGN
+      --  '­'    -- SOFT HYPHEN
+      --  '®'    -- REGISTERED SIGN
+      --  '¯'    -- MACRON
+      --  '°'    -- DEGREE SIGN
+      --  '±'    -- PLUS-MINUS SIGN
+      --  '²'    -- SUPERSCRIPT TWO
+      --  '³'    -- SUPERSCRIPT THREE
+      --  '´'    -- ACUTE ACCENT
+      --  'µ'    -- MICRO SIGN
+      --  '¶'    -- PILCROW SIGN
+      --  '·'    -- MIDDLE DOT
+      --  '¸'    -- CEDILLA
+      --  '¹'    -- SUPERSCRIPT ONE
+      --  'º'    -- MASCULINE ORDINAL INDICATOR
+      --  '»'    -- RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+      --  '¼'    -- VULGAR FRACTION ONE QUARTER
+      --  '½'    -- VULGAR FRACTION ONE HALF
+      --  '¾'    -- VULGAR FRACTION THREE QUARTERS
+      --  '¿'    -- INVERTED QUESTION MARK
+      --  '×'    -- MULTIPLICATION SIGN
+      --  '÷'    -- DIVISION SIGN
+
+      DEL .. APC => Invalid);
+
+   -- The context contains the whole internal state of the scanner, ie
+   -- it can be used to push/pop a lexical analysis, to restart the
+   -- scanner from a context marking a previous point.
+   type Scan_Context is record
+      Source: File_Buffer_Acc;
+      Source_File: Source_File_Entry;
+      Line_Number: Natural;
+      Line_Pos: Source_Ptr;
+      Pos: Source_Ptr;
+      Token_Pos: Source_Ptr;
+      File_Len: Source_Ptr;
+      File_Name: Name_Id;
+      Token: Token_Type;
+      Prev_Token: Token_Type;
+      Str_Id : String_Id;
+      Str_Len : Nat32;
+      Identifier: Name_Id;
+      Int64: Iir_Int64;
+      Fp64: Iir_Fp64;
+   end record;
+
+   -- The current context.
+   -- Default value is an invalid context.
+   Current_Context: Scan_Context := (Source => null,
+                                     Source_File => No_Source_File_Entry,
+                                     Line_Number => 0,
+                                     Line_Pos => 0,
+                                     Pos => 0,
+                                     Token_Pos => 0,
+                                     File_Len => 0,
+                                     File_Name => Null_Identifier,
+                                     Token => Tok_Invalid,
+                                     Prev_Token => Tok_Invalid,
+                                     Identifier => Null_Identifier,
+                                     Str_Id => Null_String,
+                                     Str_Len => 0,
+                                     Int64 => 0,
+                                     Fp64 => 0.0);
+
+   Source: File_Buffer_Acc renames Current_Context.Source;
+   Pos: Source_Ptr renames Current_Context.Pos;
+
+   -- When CURRENT_TOKEN is an identifier, its name_id is stored into
+   -- this global variable.
+   -- Function current_text can be used to convert it into an iir.
+   function Current_Identifier return Name_Id is
+   begin
+      return Current_Context.Identifier;
+   end Current_Identifier;
+
+   procedure Invalidate_Current_Identifier is
+   begin
+      Current_Context.Identifier := Null_Identifier;
+   end Invalidate_Current_Identifier;
+
+   procedure Invalidate_Current_Token is
+   begin
+      if Current_Token /= Tok_Invalid then
+         Current_Context.Prev_Token := Current_Token;
+         Current_Token := Tok_Invalid;
+      end if;
+   end Invalidate_Current_Token;
+
+   function Current_String_Id return String_Id is
+   begin
+      return Current_Context.Str_Id;
+   end Current_String_Id;
+
+   function Current_String_Length return Nat32 is
+   begin
+      return Current_Context.Str_Len;
+   end Current_String_Length;
+
+   function Current_Iir_Int64 return Iir_Int64 is
+   begin
+      return Current_Context.Int64;
+   end Current_Iir_Int64;
+
+   function Current_Iir_Fp64 return Iir_Fp64 is
+   begin
+      return Current_Context.Fp64;
+   end Current_Iir_Fp64;
+
+   function Get_Current_File return Name_Id is
+   begin
+      return Current_Context.File_Name;
+   end Get_Current_File;
+
+   function Get_Current_Source_File return Source_File_Entry is
+   begin
+      return Current_Context.Source_File;
+   end Get_Current_Source_File;
+
+   function Get_Current_Line return Natural is
+   begin
+      return Current_Context.Line_Number;
+   end Get_Current_Line;
+
+   function Get_Current_Column return Natural
+   is
+      Col : Natural;
+      Name : Name_Id;
+   begin
+      Coord_To_Position
+        (Current_Context.Source_File,
+         Current_Context.Line_Pos,
+         Integer (Current_Context.Pos - Current_Context.Line_Pos),
+         Name, Col);
+      return Col;
+   end Get_Current_Column;
+
+   function Get_Token_Column return Natural
+   is
+      Col : Natural;
+      Name : Name_Id;
+   begin
+      Coord_To_Position
+        (Current_Context.Source_File,
+         Current_Context.Line_Pos,
+         Integer (Current_Context.Token_Pos - Current_Context.Line_Pos),
+         Name, Col);
+      return Col;
+   end Get_Token_Column;
+
+   function Get_Token_Position return Source_Ptr is
+   begin
+      return Current_Context.Token_Pos;
+   end Get_Token_Position;
+
+   function Get_Position return Source_Ptr is
+   begin
+      return Current_Context.Pos;
+   end Get_Position;
+
+   procedure Set_File (Source_File : Source_File_Entry)
+   is
+      N_Source: File_Buffer_Acc;
+   begin
+      if Current_Context.Source /= null then
+         raise Internal_Error;
+      end if;
+      if Source_File = No_Source_File_Entry then
+         raise Internal_Error;
+      end if;
+      N_Source := Get_File_Source (Source_File);
+      Current_Context :=
+        (Source => N_Source,
+         Source_File => Source_File,
+         Line_Number => 1,
+         Line_Pos => 0,
+         Pos => N_Source'First,
+         Token_Pos => 0, -- should be invalid,
+         File_Len => Get_File_Length (Source_File),
+         File_Name => Get_File_Name (Source_File),
+         Token => Tok_Invalid,
+         Prev_Token => Tok_Invalid,
+         Identifier => Null_Identifier,
+         Str_Id => Null_String,
+         Str_Len => 0,
+         Int64 => -1,
+         Fp64 => 0.0);
+      Current_Token := Tok_Invalid;
+   end Set_File;
+
+   procedure Set_Current_Position (Position: Source_Ptr)
+   is
+      Loc : Location_Type;
+      Offset: Natural;
+      File_Entry : Source_File_Entry;
+   begin
+      if Current_Context.Source = null then
+         raise Internal_Error;
+      end if;
+      Current_Token := Tok_Invalid;
+      Current_Context.Pos := Position;
+      Loc := File_Pos_To_Location (Current_Context.Source_File,
+                                   Current_Context.Pos);
+      Location_To_Coord (Loc,
+                         File_Entry, Current_Context.Line_Pos,
+                         Current_Context.Line_Number, Offset);
+   end Set_Current_Position;
+
+   procedure Close_File is
+   begin
+      Current_Context.Source := null;
+   end Close_File;
+
+   -- Emit an error when a character above 128 was found.
+   -- This must be called only in vhdl87.
+   procedure Error_8bit is
+   begin
+      Error_Msg_Scan ("8 bits characters not allowed in vhdl87");
+   end Error_8bit;
+
+   -- Emit an error when a separator is expected.
+   procedure Error_Separator is
+   begin
+      Error_Msg_Scan ("a separator is required here");
+   end Error_Separator;
+
+   -- scan a decimal literal or a based literal.
+   --
+   -- LRM93 13.4.1
+   -- DECIMAL_LITERAL ::= INTEGER [ . INTEGER ] [ EXPONENT ]
+   -- EXPONENT ::= E [ + ] INTEGER | E - INTEGER
+   --
+   -- LRM93 13.4.2
+   -- BASED_LITERAL ::= BASE # BASED_INTEGER [ . BASED_INTEGER ] # EXPONENT
+   -- BASE ::= INTEGER
+   procedure Scan_Literal is separate;
+
+   -- Scan a string literal.
+   --
+   -- LRM93 13.6
+   -- A string literal is formed by a sequence of graphic characters
+   -- (possibly none) enclosed between two quotation marks used as string
+   -- brackets.
+   -- STRING_LITERAL ::= " { GRAPHIC_CHARACTER } "
+   --
+   -- IN: for a string, at the call of this procedure, the current character
+   -- must be either '"' or '%'.
+   procedure Scan_String
+   is
+      -- The quotation character (can be " or %).
+      Mark: Character;
+      -- Current character.
+      C : Character;
+      --  Current length.
+      Length : Nat32;
+   begin
+      Mark := Source (Pos);
+      if Mark /= Quotation and then Mark /= '%' then
+         raise Internal_Error;
+      end if;
+      Pos := Pos + 1;
+      Length := 0;
+      Current_Context.Str_Id := Str_Table.Start;
+      loop
+         C := Source (Pos);
+         if C = Mark then
+            -- LRM93 13.6
+            -- If a quotation mark value is to be represented in the sequence
+            -- of character values, then a pair of adjacent quoatation
+            -- characters marks must be written at the corresponding place
+            -- within the string literal.
+            -- LRM93 13.10
+            -- Any pourcent sign within the sequence of characters must then
+            -- be doubled, and each such doubled percent sign is interpreted
+            -- as a single percent sign value.
+            -- The same replacement is allowed for a bit string literal,
+            -- provieded that both bit string brackets are replaced.
+            Pos := Pos + 1;
+            exit when Source (Pos) /= Mark;
+         end if;
+
+         case Characters_Kind (C) is
+            when Format_Effector =>
+               Error_Msg_Scan ("format effector not allowed in a string");
+               exit;
+            when Invalid =>
+               Error_Msg_Scan
+                 ("invalid character not allowed, even in a string");
+            when Graphic_Character =>
+               if Vhdl_Std = Vhdl_87 and then C > Character'Val (127) then
+                  Error_8bit;
+               end if;
+         end case;
+
+         if C = Quotation and Mark = '%' then
+            -- LRM93 13.10
+            -- The quotation marks (") used as string brackets at both ends of
+            -- a string literal can be replaced by percent signs (%), provided
+            -- that the enclosed sequence of characters constains no quotation
+            -- marks, and provided that both string brackets are replaced.
+            Error_Msg_Scan
+              ("'""' cannot be used in a string delimited with '%'");
+         end if;
+
+         Length := Length + 1;
+         Str_Table.Append (C);
+         Pos := Pos + 1;
+      end loop;
+
+      Str_Table.Finish;
+
+      Current_Token := Tok_String;
+      Current_Context.Str_Len := Length;
+   end Scan_String;
+
+   -- Scan a bit string literal.
+   --
+   -- LRM93 13.7
+   -- A bit string literal is formed by a sequence of extended digits
+   -- (possibly none) enclosed between two quotations used as bit string
+   -- brackets, preceded by a base specifier.
+   -- BIT_STRING_LITERAL ::= BASE_SPECIFIER " [ BIT_VALUE ] "
+   -- BIT_VALUE ::= EXTENDED_DIGIT { [ UNDERLINE ] EXTENDED_DIGIT }
+   --
+   -- The current character must be a base specifier, followed by '"' or '%'.
+   -- The base must be valid.
+   procedure Scan_Bit_String
+   is
+      -- The base specifier.
+      Base_Len : Nat32 range 1 .. 4;
+      -- The quotation character (can be " or %).
+      Mark: Character;
+      -- Current character.
+      C : Character;
+      --  Current length.
+      Length : Nat32;
+      --  Digit value.
+      V : Natural;
+   begin
+      case Source (Pos) is
+         when 'x' | 'X' =>
+            Base_Len := 4;
+         when 'o' | 'O' =>
+            Base_Len := 3;
+         when 'b' | 'B' =>
+            Base_Len := 1;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Pos := Pos + 1;
+      Mark := Source (Pos);
+      if Mark /= Quotation and then Mark /= '%' then
+         raise Internal_Error;
+      end if;
+      Pos := Pos + 1;
+      Length := 0;
+      Current_Context.Str_Id := Str_Table.Start;
+      loop
+         << Again >> null;
+         C := Source (Pos);
+         Pos := Pos + 1;
+         exit when C = Mark;
+
+         -- LRM93 13.7
+         -- If the base specifier is 'B', the extended digits in the bit
+         -- value are restricted to 0 and 1.
+         -- If the base specifier is 'O', the extended digits int the bit
+         -- value are restricted to legal digits in the octal number
+         -- system, ie, the digits 0 through 7.
+         -- If the base specifier is 'X', the extended digits are all digits
+         -- together with the letters A through F.
+         case C is
+            when '0' .. '9' =>
+               V := Character'Pos (C) - Character'Pos ('0');
+            when 'A' .. 'F' =>
+               V := Character'Pos (C) - Character'Pos ('A') + 10;
+            when 'a' .. 'f' =>
+               V := Character'Pos (C) - Character'Pos ('a') + 10;
+            when '_' =>
+               if Source (Pos) = '_' then
+                  Error_Msg_Scan
+                    ("double underscore not allowed in a bit string");
+               end if;
+               if Source (Pos - 2) = Mark then
+                  Error_Msg_Scan
+                    ("underscore not allowed at the start of a bit string");
+               elsif Source (Pos) = Mark then
+                  Error_Msg_Scan
+                    ("underscore not allowed at the end of a bit string");
+               end if;
+               goto Again;
+            when '"' =>
+               pragma Assert (Mark = '%');
+               Error_Msg_Scan
+                 ("'""' cannot close a bit string opened by '%'");
+               exit;
+            when '%' =>
+               pragma Assert (Mark = '"');
+               Error_Msg_Scan
+                 ("'%' cannot close a bit string opened by '""'");
+               exit;
+            when others =>
+               Error_Msg_Scan ("bit string not terminated");
+               Pos := Pos - 1;
+               exit;
+         end case;
+
+         case Base_Len is
+            when 1 =>
+               if V > 1 then
+                  Error_Msg_Scan ("invalid character in a binary bit string");
+               end if;
+               Str_Table.Append (C);
+            when 2 =>
+               raise Internal_Error;
+            when 3 =>
+               if V > 7 then
+                  Error_Msg_Scan ("invalid character in a octal bit string");
+               end if;
+               for I in 1 .. 3 loop
+                  if (V / 4) = 1 then
+                     Str_Table.Append ('1');
+                  else
+                     Str_Table.Append ('0');
+                  end if;
+                  V := (V mod 4) * 2;
+               end loop;
+            when 4 =>
+               for I in 1 .. 4 loop
+                  if (V / 8) = 1 then
+                     Str_Table.Append ('1');
+                  else
+                     Str_Table.Append ('0');
+                  end if;
+                  V := (V mod 8) * 2;
+               end loop;
+         end case;
+         Length := Length + Base_Len;
+      end loop;
+
+      Str_Table.Finish;
+
+      if Length = 0 then
+         Error_Msg_Scan ("empty bit string is not allowed");
+      end if;
+      Current_Token := Tok_Bit_String;
+      Current_Context.Int64 := Iir_Int64 (Base_Len);
+      Current_Context.Str_Len := Length;
+   end Scan_Bit_String;
+
+   -- LRM93 13.3.1
+   -- Basic Identifiers
+   -- A basic identifier consists only of letters, digits, and underlines.
+   -- BASIC_IDENTIFIER ::= LETTER { [ UNDERLINE ] LETTER_OR_DIGIT }
+   -- LETTER_OR_DIGIT ::= LETTER | DIGIT
+   -- LETTER ::= UPPER_CASE_LETTER | LOWER_CASE_LETTER
+   --
+   -- NB: At the call of this procedure, the current character must be a legal
+   -- character for a basic identifier.
+   procedure Scan_Identifier
+   is
+      use Name_Table;
+      C : Character;
+      Len : Natural;
+   begin
+      -- This is an identifier or a key word.
+      Len := 0;
+      loop
+         -- source (pos) is correct.
+         -- LRM93 13.3.1
+         --   All characters if a basic identifier are signifiant, including
+         --   any underline character inserted between a letter or digit and
+         --   an adjacent letter or digit.
+         --   Basic identifiers differing only in the use of the corresponding
+         --   upper and lower case letters are considered as the same.
+         -- This is achieved by converting all upper case letters into
+         -- equivalent lower case letters.
+         -- The opposite (converting in lower case letters) is not possible,
+         -- because two characters have no upper-case equivalent.
+         C := Source (Pos);
+         case Characters_Kind (C) is
+            when Upper_Case_Letter =>
+               if Vhdl_Std = Vhdl_87 and C > 'Z' then
+                  Error_8bit;
+               end if;
+               Len := Len + 1;
+               Name_Buffer (Len) := Ada.Characters.Handling.To_Lower (C);
+            when Lower_Case_Letter | Digit =>
+               if Vhdl_Std = Vhdl_87 and C > 'z' then
+                  Error_8bit;
+               end if;
+               Len := Len + 1;
+               Name_Buffer (Len) := C;
+            when Special_Character =>
+               -- The current character is legal in an identifier.
+               if C = '_' then
+                  if Source (Pos + 1) = '_' then
+                     Error_Msg_Scan ("two underscores can't be consecutive");
+                  end if;
+                  Len := Len + 1;
+                  Name_Buffer (Len) := C;
+               else
+                  exit;
+               end if;
+            when others =>
+               exit;
+         end case;
+         Pos := Pos + 1;
+      end loop;
+
+      if Source (Pos - 1) = '_' then
+         if not Flag_Psl then
+            --  Some PSL reserved words finish with '_'.  This case is handled
+            --  later.
+            Error_Msg_Scan ("identifier cannot finish with '_'");
+         end if;
+         Pos := Pos - 1;
+         Len := Len - 1;
+         C := '_';
+      end if;
+
+      -- LRM93 13.2
+      -- At least one separator is required between an identifier or an
+      -- abstract literal and an adjacent identifier or abstract literal.
+      case Characters_Kind (C) is
+         when Digit
+           | Upper_Case_Letter
+           | Lower_Case_Letter =>
+            raise Internal_Error;
+         when Other_Special_Character =>
+            if Vhdl_Std /= Vhdl_87 and then C = '\' then
+               Error_Separator;
+            end if;
+         when Invalid
+           | Format_Effector
+           | Space_Character
+           | Special_Character =>
+            null;
+      end case;
+      Name_Length := Len;
+
+      -- Hash it.
+      Current_Context.Identifier := Name_Table.Get_Identifier;
+      if Current_Identifier in Std_Names.Name_Id_Keywords then
+         -- LRM93 13.9
+         --   The identifiers listed below are called reserved words and are
+         --   reserved for signifiances in the language.
+         -- IN: this is also achieved in packages std_names and tokens.
+         Current_Token := Token_Type'Val
+           (Token_Type'Pos (Tok_First_Keyword)
+              + Current_Identifier - Std_Names.Name_First_Keyword);
+         case Current_Identifier is
+            when Std_Names.Name_Id_AMS_Reserved_Words =>
+               if not AMS_Vhdl then
+                  if Flags.Warn_Reserved_Word then
+                     Warning_Msg_Scan
+                       ("using """ & Name_Buffer (1 .. Name_Length)
+                          & """ AMS-VHDL reserved word as an identifier");
+                  end if;
+                  Current_Token := Tok_Identifier;
+               end if;
+            when Std_Names.Name_Id_Vhdl00_Reserved_Words =>
+               if Vhdl_Std < Vhdl_00 then
+                  if Flags.Warn_Reserved_Word then
+                     Warning_Msg_Scan
+                       ("using """ & Name_Buffer (1 .. Name_Length)
+                          & """ vhdl00 reserved word as an identifier");
+                  end if;
+                  Current_Token := Tok_Identifier;
+               end if;
+            when Std_Names.Name_Id_Vhdl93_Reserved_Words =>
+               if Vhdl_Std = Vhdl_87 then
+                  if Flags.Warn_Reserved_Word then
+                     Warning_Msg_Scan
+                       ("using """ & Name_Buffer (1 .. Name_Length)
+                          & """ vhdl93 reserved word as a vhdl87 identifier");
+                     Warning_Msg_Scan
+                       ("(use option --std=93 to compile as vhdl93)");
+                  end if;
+                  Current_Token := Tok_Identifier;
+               end if;
+            when Std_Names.Name_Id_Vhdl87_Reserved_Words =>
+               null;
+            when others =>
+               raise Program_Error;
+         end case;
+      elsif Flag_Psl then
+         case Current_Identifier is
+            when Std_Names.Name_Clock =>
+               Current_Token := Tok_Psl_Clock;
+            when Std_Names.Name_Const =>
+               Current_Token := Tok_Psl_Const;
+            when Std_Names.Name_Boolean =>
+               Current_Token := Tok_Psl_Boolean;
+            when Std_Names.Name_Sequence =>
+               Current_Token := Tok_Psl_Sequence;
+            when Std_Names.Name_Property =>
+               Current_Token := Tok_Psl_Property;
+            when Std_Names.Name_Inf =>
+               Current_Token := Tok_Inf;
+            when Std_Names.Name_Within =>
+               Current_Token := Tok_Within;
+            when Std_Names.Name_Abort =>
+               Current_Token := Tok_Abort;
+            when Std_Names.Name_Before =>
+               Current_Token := Tok_Before;
+            when Std_Names.Name_Always =>
+               Current_Token := Tok_Always;
+            when Std_Names.Name_Never =>
+               Current_Token := Tok_Never;
+            when Std_Names.Name_Eventually =>
+               Current_Token := Tok_Eventually;
+            when Std_Names.Name_Next_A =>
+               Current_Token := Tok_Next_A;
+            when Std_Names.Name_Next_E =>
+               Current_Token := Tok_Next_E;
+            when Std_Names.Name_Next_Event =>
+               Current_Token := Tok_Next_Event;
+            when Std_Names.Name_Next_Event_A =>
+               Current_Token := Tok_Next_Event_A;
+            when Std_Names.Name_Next_Event_E =>
+               Current_Token := Tok_Next_Event_E;
+            when Std_Names.Name_Until =>
+               Current_Token := Tok_Until;
+            when others =>
+               Current_Token := Tok_Identifier;
+               if C = '_' then
+                  Error_Msg_Scan ("identifiers cannot finish with '_'");
+               end if;
+         end case;
+      else
+         Current_Token := Tok_Identifier;
+      end if;
+   end Scan_Identifier;
+
+   --  LRM93 13.3.2
+   --  EXTENDED_IDENTIFIER ::= \ GRAPHIC_CHARACTER { GRAPHIC_CHARACTER } \
+   --
+   -- Create an (extended) indentifier.
+   -- Extended identifiers are stored as they appear (leading and tailing
+   -- backslashes, doubling backslashes inside).
+   procedure Scan_Extended_Identifier
+   is
+      use Name_Table;
+   begin
+      -- LRM93 13.3.2
+      --   Moreover, every extended identifiers is distinct from any basic
+      --   identifier.
+      -- This is satisfied by storing '\' in the name table.
+      Name_Length := 1;
+      Name_Buffer (1) := '\';
+      loop
+         --  Next character.
+         Pos := Pos + 1;
+
+         if Source (Pos) = '\' then
+            -- LRM93 13.3.2
+            -- If a backslash is to be used as one of the graphic characters
+            -- of an extended literal, it must be doubled.
+            -- LRM93 13.3.2
+            -- (a doubled backslash couting as one character)
+            Name_Length := Name_Length + 1;
+            Name_Buffer (Name_Length) := '\';
+
+            Pos := Pos + 1;
+
+            exit when Source (Pos) /= '\';
+         end if;
+
+         -- source (pos) is correct.
+         case Characters_Kind (Source (Pos)) is
+            when Format_Effector =>
+               Error_Msg_Scan ("format effector in extended identifier");
+               exit;
+            when Graphic_Character =>
+               null;
+            when Invalid =>
+               Error_Msg_Scan ("invalid character in extended identifier");
+         end case;
+         Name_Length := Name_Length + 1;
+         -- LRM93 13.3.2
+         -- Extended identifiers differing only in the use of corresponding
+         -- upper and lower case letters are distinct.
+         Name_Buffer (Name_Length) := Source (Pos);
+      end loop;
+
+      if Name_Length <= 2 then
+         Error_Msg_Scan ("empty extended identifier is not allowed");
+      end if;
+
+      -- LRM93 13.2
+      -- At least one separator is required between an identifier or an
+      -- abstract literal and an adjacent identifier or abstract literal.
+      case Characters_Kind (Source (Pos)) is
+         when Digit
+           | Upper_Case_Letter
+           | Lower_Case_Letter =>
+            Error_Separator;
+         when Invalid
+           | Format_Effector
+           | Space_Character
+           | Special_Character
+           | Other_Special_Character =>
+            null;
+      end case;
+
+      -- Hash it.
+      Current_Context.Identifier := Name_Table.Get_Identifier;
+      Current_Token := Tok_Identifier;
+   end Scan_Extended_Identifier;
+
+   procedure Convert_Identifier
+   is
+      procedure Error_Bad is
+      begin
+         Error_Msg_Option ("bad character in identifier");
+      end Error_Bad;
+
+      procedure Error_8bit is
+      begin
+         Error_Msg_Option ("8 bits characters not allowed in vhdl87");
+      end Error_8bit;
+
+      use Name_Table;
+      C : Character;
+   begin
+      if Name_Length = 0 then
+         Error_Msg_Option ("identifier required");
+         return;
+      end if;
+
+      if Name_Buffer (1) = '\' then
+         --  Extended identifier.
+         if Vhdl_Std = Vhdl_87 then
+            Error_Msg_Option ("extended identifiers not allowed in vhdl87");
+            return;
+         end if;
+
+         if Name_Length < 3 then
+            Error_Msg_Option ("extended identifier is too short");
+            return;
+         end if;
+         if Name_Buffer (Name_Length) /= '\' then
+            Error_Msg_Option ("extended identifier must finish with a '\'");
+            return;
+         end if;
+         for I in 2 .. Name_Length - 1 loop
+            C := Name_Buffer (I);
+            case Characters_Kind (C) is
+               when Format_Effector =>
+                  Error_Msg_Option ("format effector in extended identifier");
+                  return;
+               when Graphic_Character =>
+                  if C = '\' then
+                     if Name_Buffer (I + 1) /= '\'
+                       or else I = Name_Length - 1
+                     then
+                        Error_Msg_Option ("anti-slash must be doubled "
+                                          & "in extended identifier");
+                        return;
+                     end if;
+                  end if;
+               when Invalid =>
+                  Error_Bad;
+            end case;
+         end loop;
+      else
+         --  Identifier
+         for I in 1 .. Name_Length loop
+            C := Name_Buffer (I);
+            case Characters_Kind (C) is
+               when Upper_Case_Letter =>
+                  if Vhdl_Std = Vhdl_87 and C > 'Z' then
+                     Error_8bit;
+                  end if;
+                  Name_Buffer (I) := Ada.Characters.Handling.To_Lower (C);
+               when Lower_Case_Letter | Digit =>
+                  if Vhdl_Std = Vhdl_87 and C > 'z' then
+                     Error_8bit;
+                  end if;
+               when Special_Character =>
+                  -- The current character is legal in an identifier.
+                  if C = '_' then
+                     if I = 1 then
+                        Error_Msg_Option
+                          ("identifier cannot start with an underscore");
+                        return;
+                     end if;
+                     if Name_Buffer (I - 1) = '_' then
+                        Error_Msg_Option
+                          ("two underscores can't be consecutive");
+                        return;
+                     end if;
+                     if I = Name_Length then
+                        Error_Msg_Option
+                          ("identifier cannot finish with an underscore");
+                        return;
+                     end if;
+                  else
+                     Error_Bad;
+                  end if;
+               when others =>
+                  Error_Bad;
+            end case;
+         end loop;
+      end if;
+   end Convert_Identifier;
+
+   --  Scan an identifier within a comment.  Only lower case letters are
+   --  allowed.
+   function Scan_Comment_Identifier return Boolean
+   is
+      use Name_Table;
+      Len : Natural;
+      C : Character;
+   begin
+      --  Skip spaces.
+      while Source (Pos) = ' ' or Source (Pos) = HT loop
+         Pos := Pos + 1;
+      end loop;
+
+      --  The identifier shall start with a lower case letter.
+      if Source (Pos) not in 'a' .. 'z' then
+         return False;
+      end if;
+
+      --  Scan the identifier (in lower cases).
+      Len := 0;
+      loop
+         C := Source (Pos);
+         exit when C not in 'a' .. 'z' and C /= '_';
+         Len := Len + 1;
+         Name_Buffer (Len) := C;
+         Pos := Pos + 1;
+      end loop;
+
+      --  Shall be followed by a space or a new line.
+      case C is
+         when ' ' | HT | LF | CR =>
+            null;
+         when others =>
+            return False;
+      end case;
+
+      Name_Length := Len;
+      return True;
+   end Scan_Comment_Identifier;
+
+   --  Scan tokens within a comment.  Return TRUE if Current_Token was set,
+   --  return FALSE to discard the comment (ie treat it like a real comment).
+   function Scan_Comment return Boolean
+   is
+      use Std_Names;
+      Id : Name_Id;
+   begin
+      if not Scan_Comment_Identifier then
+         return False;
+      end if;
+
+      -- Hash it.
+      Id := Name_Table.Get_Identifier;
+
+      case Id is
+         when Name_Psl =>
+            --  Scan first identifier after '-- psl'.
+            if not Scan_Comment_Identifier then
+               return False;
+            end if;
+            Id := Name_Table.Get_Identifier;
+            case Id is
+               when Name_Property =>
+                  Current_Token := Tok_Psl_Property;
+               when Name_Sequence =>
+                  Current_Token := Tok_Psl_Sequence;
+               when Name_Endpoint =>
+                  Current_Token := Tok_Psl_Endpoint;
+               when Name_Assert =>
+                  Current_Token := Tok_Psl_Assert;
+               when Name_Cover =>
+                  Current_Token := Tok_Psl_Cover;
+               when Name_Default =>
+                  Current_Token := Tok_Psl_Default;
+               when others =>
+                  return False;
+            end case;
+            Flag_Scan_In_Comment := True;
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Scan_Comment;
+
+   function Scan_Exclam_Mark return Boolean is
+   begin
+      if Source (Pos) = '!' then
+         Pos := Pos + 1;
+         return True;
+      else
+         return False;
+      end if;
+   end Scan_Exclam_Mark;
+
+   function Scan_Underscore return Boolean is
+   begin
+      if Source (Pos) = '_' then
+         Pos := Pos + 1;
+         return True;
+      else
+         return False;
+      end if;
+   end Scan_Underscore;
+
+   --  The Scan_Next_Line procedure must be called after each end-of-line to
+   --  register to next line number.  This is called by Scan_CR_Newline and
+   --  Scan_LF_Newline.
+   procedure Scan_Next_Line is
+   begin
+      Current_Context.Line_Number := Current_Context.Line_Number + 1;
+      Current_Context.Line_Pos := Pos;
+      File_Add_Line_Number
+        (Current_Context.Source_File, Current_Context.Line_Number, Pos);
+   end Scan_Next_Line;
+
+   --  Scan a CR end-of-line.
+   procedure Scan_CR_Newline is
+   begin
+      -- Accept CR or CR+LF as line separator.
+      if Source (Pos + 1) = LF then
+         Pos := Pos + 2;
+      else
+         Pos := Pos + 1;
+      end if;
+      Scan_Next_Line;
+   end Scan_CR_Newline;
+
+   --  Scan a LF end-of-line.
+   procedure Scan_LF_Newline is
+   begin
+      -- Accept LF or LF+CR as line separator.
+      if Source (Pos + 1) = CR then
+         Pos := Pos + 2;
+      else
+         Pos := Pos + 1;
+      end if;
+      Scan_Next_Line;
+   end Scan_LF_Newline;
+
+   -- Get a new token.
+   procedure Scan is
+   begin
+      if Current_Token /= Tok_Invalid then
+         Current_Context.Prev_Token := Current_Token;
+      end if;
+
+      << Again >> null;
+
+      --  Skip commonly used separators.
+      while Source(Pos) = ' ' or Source(Pos) = HT loop
+         Pos := Pos + 1;
+      end loop;
+
+      Current_Context.Token_Pos := Pos;
+      Current_Context.Identifier := Null_Identifier;
+
+      case Source (Pos) is
+         when HT | ' ' =>
+            --  Must have already been skipped just above.
+            raise Internal_Error;
+         when NBSP =>
+            if Vhdl_Std = Vhdl_87 then
+               Error_Msg_Scan ("NBSP character not allowed in vhdl87");
+            end if;
+            Pos := Pos + 1;
+            goto Again;
+         when VT | FF =>
+            Pos := Pos + 1;
+            goto Again;
+         when LF =>
+            Scan_LF_Newline;
+            if Flag_Newline then
+               Current_Token := Tok_Newline;
+               return;
+            end if;
+            goto Again;
+         when CR =>
+            Scan_CR_Newline;
+            if Flag_Newline then
+               Current_Token := Tok_Newline;
+               return;
+            end if;
+            goto Again;
+         when '-' =>
+            if Source (Pos + 1) = '-' then
+               -- This is a comment.
+               -- LRM93 13.8
+               --   A comment starts with two adjacent hyphens and extends up
+               --   to the end of the line.
+               --   A comment can appear on any line line of a VHDL
+               --   description.
+               --   The presence or absence of comments has no influence on
+               --   wether a description is legal or illegal.
+               --   Futhermore, comments do not influence the execution of a
+               --   simulation module; their sole purpose is the enlightenment
+               --   of the human reader.
+               -- GHDL note: As a consequence, an obfruscating comment
+               --  is out of purpose, and a warning could be reported :-)
+               Pos := Pos + 2;
+
+               --  Scan inside a comment.  So we just ignore the two dashes.
+               if Flag_Scan_In_Comment then
+                  goto Again;
+               end if;
+
+               --  Handle keywords in comment (PSL).
+               if Flag_Comment_Keyword
+                 and then Scan_Comment
+               then
+                  return;
+               end if;
+
+               --  LRM93 13.2
+               --  In any case, a sequence of one or more format
+               --  effectors other than horizontal tabulation must
+               --  cause at least one end of line.
+               while Source (Pos) /= CR and Source (Pos) /= LF and
+                 Source (Pos) /= VT and Source (Pos) /= FF and
+                 Source (Pos) /= Files_Map.EOT
+               loop
+                  if not Flags.Mb_Comment
+                    and then Characters_Kind (Source (Pos)) = Invalid
+                  then
+                     Error_Msg_Scan ("invalid character, even in a comment");
+                  end if;
+                  Pos := Pos + 1;
+               end loop;
+               if Flag_Comment then
+                  Current_Token := Tok_Comment;
+                  return;
+               end if;
+               goto Again;
+            elsif Flag_Psl and then Source (Pos + 1) = '>' then
+               Current_Token := Tok_Minus_Greater;
+               Pos := Pos + 2;
+               return;
+            else
+               Current_Token := Tok_Minus;
+               Pos := Pos + 1;
+               return;
+            end if;
+         when '+' =>
+            Current_Token := Tok_Plus;
+            Pos := Pos + 1;
+            return;
+         when '*' =>
+            if Source (Pos + 1) = '*' then
+               Current_Token := Tok_Double_Star;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Star;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '/' =>
+            if Source (Pos + 1) = '=' then
+               Current_Token := Tok_Not_Equal;
+               Pos := Pos + 2;
+            elsif Source (Pos + 1) = '*' then
+               --  LRM08 15.9 Comments
+               --  A delimited comment start with a solidus (slash) character
+               --  immediately followed by an asterisk character and extends up
+               --  to the first subsequent occurrence of an asterisk character
+               --  immediately followed by a solidus character.
+               if Vhdl_Std < Vhdl_08 then
+                  Error_Msg_Scan
+                    ("block comment are not allowed before vhdl 2008");
+               end if;
+
+               --  Skip '/*'.
+               Pos := Pos + 2;
+
+               loop
+                  case Source (Pos) is
+                     when '/' =>
+                        --  LRM08 15.9
+                        --  Moreover, an occurrence of a solidus character
+                        --  immediately followed by an asterisk character
+                        --  within a delimited comment is not interpreted as
+                        --  the start of a nested delimited comment.
+                        if Source (Pos + 1) = '*' then
+                           Warning_Msg_Scan
+                             ("'/*' found within a block comment");
+                        end if;
+                        Pos := Pos + 1;
+                     when '*' =>
+                        if Source (Pos + 1) = '/' then
+                           Pos := Pos + 2;
+                           exit;
+                        else
+                           Pos := Pos + 1;
+                        end if;
+                     when CR =>
+                        Scan_CR_Newline;
+                     when LF =>
+                        Scan_LF_Newline;
+                     when Files_Map.EOT =>
+                        if Pos >= Current_Context.File_Len then
+                           --  Point at the start of the comment.
+                           Error_Msg_Scan
+                             ("block comment not terminated at end of file",
+                              File_Pos_To_Location
+                                (Current_Context.Source_File,
+                                 Current_Context.Token_Pos));
+                           exit;
+                        end if;
+                        Pos := Pos + 1;
+                     when others =>
+                        Pos := Pos + 1;
+                  end case;
+               end loop;
+               if Flag_Comment then
+                  Current_Token := Tok_Comment;
+                  return;
+               end if;
+               goto Again;
+            else
+               Current_Token := Tok_Slash;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '(' =>
+            Current_Token := Tok_Left_Paren;
+            Pos := Pos + 1;
+            return;
+         when ')' =>
+            Current_Token := Tok_Right_Paren;
+            Pos := Pos + 1;
+            return;
+         when '|' =>
+            if Flag_Psl then
+               if Source (Pos + 1) = '|' then
+                  Current_Token := Tok_Bar_Bar;
+                  Pos := Pos + 2;
+               elsif Source (Pos + 1) = '-'
+                 and then Source (Pos + 2) = '>'
+               then
+                  Current_Token := Tok_Bar_Arrow;
+                  Pos := Pos + 3;
+               elsif Source (Pos + 1) = '='
+                 and then Source (Pos + 2) = '>'
+               then
+                  Current_Token := Tok_Bar_Double_Arrow;
+                  Pos := Pos + 3;
+               else
+                  Current_Token := Tok_Bar;
+                  Pos := Pos + 1;
+               end if;
+            else
+               Current_Token := Tok_Bar;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '!' =>
+            if Flag_Psl then
+               Current_Token := Tok_Exclam_Mark;
+            else
+               --  LRM93 13.10
+               --  A vertical line (|) can be replaced by an exclamation
+               --  mark (!)  where used as a delimiter.
+               Current_Token := Tok_Bar;
+            end if;
+            Pos := Pos + 1;
+            return;
+         when ':' =>
+            if Source (Pos + 1) = '=' then
+               Current_Token := Tok_Assign;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Colon;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when ';' =>
+            Current_Token := Tok_Semi_Colon;
+            Pos := Pos + 1;
+            return;
+         when ',' =>
+            Current_Token := Tok_Comma;
+            Pos := Pos + 1;
+            return;
+         when '.' =>
+            if Source (Pos + 1) = '.' then
+               --  Be Ada friendly...
+               Error_Msg_Scan ("'..' is invalid in vhdl, replaced by 'to'");
+               Current_Token := Tok_To;
+               Pos := Pos + 2;
+               return;
+            end if;
+            Current_Token := Tok_Dot;
+            Pos := Pos + 1;
+            return;
+         when '&' =>
+            if Flag_Psl and then Source (Pos + 1) = '&' then
+               Current_Token := Tok_And_And;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Ampersand;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '<' =>
+            if Source (Pos + 1) = '=' then
+               Current_Token := Tok_Less_Equal;
+               Pos := Pos + 2;
+            elsif Source (Pos + 1) = '>' then
+               Current_Token := Tok_Box;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Less;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '>' =>
+            if Source (Pos + 1) = '=' then
+               Current_Token := Tok_Greater_Equal;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Greater;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '=' =>
+            if Source (Pos + 1) = '=' then
+               if AMS_Vhdl then
+                  Current_Token := Tok_Equal_Equal;
+               else
+                  Error_Msg_Scan
+                    ("'==' is not the vhdl equality, replaced by '='");
+                  Current_Token := Tok_Equal;
+               end if;
+               Pos := Pos + 2;
+            elsif Source (Pos + 1) = '>' then
+               Current_Token := Tok_Double_Arrow;
+               Pos := Pos + 2;
+            else
+               Current_Token := Tok_Equal;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when ''' =>
+            -- Handle cases such as character'('a')
+            -- FIXME: what about f ()'length ? or .all'length
+            if Current_Context.Prev_Token /= Tok_Identifier
+              and then Current_Context.Prev_Token /= Tok_Character
+              and then Source (Pos + 2) = '''
+            then
+               -- LRM93 13.5
+               -- A character literal is formed by enclosing one of the 191
+               -- graphic character (...) between two apostrophe characters.
+               -- CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER '
+               if Characters_Kind (Source (Pos + 1)) not in Graphic_Character
+               then
+                  Error_Msg_Scan
+                    ("a character literal can only be a graphic character");
+               elsif Vhdl_Std = Vhdl_87
+                 and then Source (Pos + 1) > Character'Val (127)
+               then
+                  Error_8bit;
+               end if;
+               Current_Token := Tok_Character;
+               Current_Context.Identifier :=
+                 Name_Table.Get_Identifier (Source (Pos + 1));
+               Pos := Pos + 3;
+               return;
+            else
+               Current_Token := Tok_Tick;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when '0' .. '9' =>
+            Scan_Literal;
+
+            --  LRM 13.2
+            --  At least one separator is required between an identifier or
+            --  an abstract literal and an adjacent identifier or abstract
+            --  literal.
+            case Characters_Kind (Source (Pos)) is
+               when Digit =>
+                  raise Internal_Error;
+               when Upper_Case_Letter
+                 | Lower_Case_Letter =>
+                  --  Could call Error_Separator, but use a clearer message
+                  --  for this common case.
+                  --  Note: the term "unit name" is not correct here, since it
+                  --  can be any identifier or even a keyword; however it is
+                  --  probably the most common case (eg 10ns).
+                  Error_Msg_Scan
+                    ("space is required between number and unit name");
+               when Other_Special_Character =>
+                  if Vhdl_Std /= Vhdl_87 and then Source (Pos) = '\' then
+                     Error_Separator;
+                  end if;
+               when Invalid
+                 | Format_Effector
+                 | Space_Character
+                 | Special_Character =>
+                  null;
+            end case;
+            return;
+         when '#' =>
+            Error_Msg_Scan ("'#' is used for based literals and "
+                            & "must be preceded by a base");
+            -- Cannot easily continue.
+            raise Compilation_Error;
+         when Quotation | '%' =>
+            Scan_String;
+            return;
+         when '[' =>
+            if Flag_Psl then
+               if Source (Pos + 1) = '*' then
+                  Current_Token := Tok_Brack_Star;
+                  Pos := Pos + 2;
+               elsif Source (Pos + 1) = '+'
+                 and then Source (Pos + 2) = ']'
+               then
+                  Current_Token := Tok_Brack_Plus_Brack;
+                  Pos := Pos + 3;
+               elsif Source (Pos + 1) = '-'
+                 and then Source (Pos + 2) = '>'
+               then
+                  Current_Token := Tok_Brack_Arrow;
+                  Pos := Pos + 3;
+               elsif Source (Pos + 1) = '=' then
+                  Current_Token := Tok_Brack_Equal;
+                  Pos := Pos + 2;
+               else
+                  Current_Token := Tok_Left_Bracket;
+                  Pos := Pos + 1;
+               end if;
+            else
+               if Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Scan
+                    ("'[' is an invalid character in vhdl87, replaced by '('");
+                  Current_Token := Tok_Left_Paren;
+               else
+                  Current_Token := Tok_Left_Bracket;
+               end if;
+               Pos := Pos + 1;
+            end if;
+            return;
+         when ']' =>
+            if Vhdl_Std = Vhdl_87 and not Flag_Psl then
+               Error_Msg_Scan
+                 ("']' is an invalid character in vhdl87, replaced by ')'");
+               Current_Token := Tok_Right_Paren;
+            else
+               Current_Token := Tok_Right_Bracket;
+            end if;
+            Pos := Pos + 1;
+            return;
+         when '{' =>
+            if Flag_Psl then
+               Current_Token := Tok_Left_Curly;
+            else
+               Error_Msg_Scan ("'{' is an invalid character, replaced by '('");
+               Current_Token := Tok_Left_Paren;
+            end if;
+            Pos := Pos + 1;
+            return;
+         when '}' =>
+            if Flag_Psl then
+               Current_Token := Tok_Right_Curly;
+            else
+               Error_Msg_Scan ("'}' is an invalid character, replaced by ')'");
+               Current_Token := Tok_Right_Paren;
+            end if;
+            Pos := Pos + 1;
+            return;
+         when '\' =>
+            if Vhdl_Std = Vhdl_87 then
+               Error_Msg_Scan
+                 ("extended identifiers are not allowed in vhdl87");
+            end if;
+            Scan_Extended_Identifier;
+            return;
+         when '^' =>
+            Error_Msg_Scan ("'^' is not a VHDL operator, use 'xor'");
+            Pos := Pos + 1;
+            Current_Token := Tok_Xor;
+            return;
+         when '~' =>
+            Error_Msg_Scan ("'~' is not a VHDL operator, use 'not'");
+            Pos := Pos + 1;
+            Current_Token := Tok_Not;
+            return;
+         when '?' =>
+            if Vhdl_Std < Vhdl_08 then
+               Error_Msg_Scan ("'?' can only be used in strings or comments");
+               Pos := Pos + 1;
+               goto Again;
+            else
+               if Source (Pos + 1) = '<' then
+                  if Source (Pos + 2) = '=' then
+                     Current_Token := Tok_Match_Less_Equal;
+                     Pos := Pos + 3;
+                  else
+                     Current_Token := Tok_Match_Less;
+                     Pos := Pos + 2;
+                  end if;
+               elsif Source (Pos + 1) = '>' then
+                  if Source (Pos + 2) = '=' then
+                     Current_Token := Tok_Match_Greater_Equal;
+                     Pos := Pos + 3;
+                  else
+                     Current_Token := Tok_Match_Greater;
+                     Pos := Pos + 2;
+                  end if;
+               elsif Source (Pos + 1) = '?' then
+                  Current_Token := Tok_Condition;
+                  Pos := Pos + 2;
+               elsif Source (Pos + 1) = '=' then
+                  Current_Token := Tok_Match_Equal;
+                  Pos := Pos + 2;
+               elsif Source (Pos + 1) = '/'
+                 and then Source (Pos + 2) = '='
+               then
+                  Current_Token := Tok_Match_Not_Equal;
+                  Pos := Pos + 3;
+               else
+                  Error_Msg_Scan ("unknown matching operator");
+                  Pos := Pos + 1;
+                  goto Again;
+               end if;
+            end if;
+            return;
+         when '$' | '`'
+           | Inverted_Exclamation .. Inverted_Question
+           | Multiplication_Sign | Division_Sign =>
+            Error_Msg_Scan ("character """ & Source (Pos)
+                            & """ can only be used in strings or comments");
+            Pos := Pos + 1;
+            goto Again;
+         when '@' =>
+            if Flag_Psl then
+               Current_Token := Tok_Arobase;
+               Pos := Pos + 1;
+               return;
+            else
+               Error_Msg_Scan
+                 ("character """ & Source (Pos)
+                    & """ can only be used in strings or comments");
+               Pos := Pos + 1;
+               goto Again;
+            end if;
+         when '_' =>
+            Error_Msg_Scan ("an identifier can't start with '_'");
+            Pos := Pos + 1;
+            goto Again;
+         when 'B' | 'b' | 'O' | 'o' | 'X' | 'x' =>
+            if Source (Pos + 1) = Quotation or else Source (Pos + 1) = '%' then
+               -- LRM93 13.7
+               -- BASE_SPECIFIER ::= B | O | X
+               -- A letter in a bit string literal (either an extended digit or
+               -- the base specifier) can be written either in lower case or
+               -- in upper case, with the same meaning.
+               Scan_Bit_String;
+            else
+               Scan_Identifier;
+            end if;
+            return;
+         when 'A' | 'C' .. 'N' | 'P' .. 'W' | 'Y'| 'Z'
+           | 'a' | 'c' .. 'n' | 'p' .. 'w' | 'y'| 'z' =>
+            Scan_Identifier;
+            return;
+         when UC_A_Grave .. UC_O_Diaeresis
+           | UC_O_Oblique_Stroke .. UC_Icelandic_Thorn =>
+            if Vhdl_Std = Vhdl_87 then
+               Error_Msg_Scan
+                 ("upper case letters above 128 are not allowed in vhdl87");
+            end if;
+            Scan_Identifier;
+            return;
+         when LC_German_Sharp_S .. LC_O_Diaeresis
+           | LC_O_Oblique_Stroke .. LC_Y_Diaeresis =>
+            if Vhdl_Std = Vhdl_87 then
+               Error_Msg_Scan
+                 ("lower case letters above 128 are not allowed in vhdl87");
+            end if;
+            Scan_Identifier;
+            return;
+         when NUL .. ETX | ENQ .. BS | SO .. US | DEL .. APC =>
+            Error_Msg_Scan
+              ("control character that is not CR, LF, FF, HT or VT " &
+               "is not allowed");
+            Pos := Pos + 1;
+            goto Again;
+         when Files_Map.EOT =>
+            if Pos >= Current_Context.File_Len then
+               --  FIXME: should conditionnaly emit a warning if the file
+               --   is not terminated by an end of line.
+               Current_Token := Tok_Eof;
+            else
+               Error_Msg_Scan ("EOT is not allowed inside the file");
+               Pos := Pos + 1;
+               goto Again;
+            end if;
+            return;
+      end case;
+   end Scan;
+
+   function Get_Token_Location return Location_Type is
+   begin
+      return File_Pos_To_Location
+        (Current_Context.Source_File, Current_Context.Token_Pos);
+   end Get_Token_Location;
+end Scanner;
diff --git a/src/scanner.ads b/src/scanner.ads
new file mode 100644
index 000000000..ddc0d1819
--- /dev/null
+++ b/src/scanner.ads
@@ -0,0 +1,120 @@
+--  VHDL lexical scanner.
+--  Copyright (C) 2002 - 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Tokens; use Tokens;
+
+package Scanner is
+   -- Global variables
+   -- The token that was just scanned.
+   -- When the token was eaten, you can call invalidate_current_token to
+   -- set it to tok_invalid.
+   -- Current_token should not be written outside of scan package.
+   -- It can be replaced by a function call.
+   Current_Token: Token_Type := Tok_Invalid;
+
+   -- Simply set current_token to tok_invalid.
+   procedure Invalidate_Current_Token;
+   pragma Inline (Invalidate_Current_Token);
+
+   -- When CURRENT_TOKEN is an tok_identifier, tok_char or tok_string,
+   -- its name_id can be got via this function.
+   function Current_Identifier return Name_Id;
+   pragma Inline (Current_Identifier);
+
+   -- Get current string identifier and length.
+   function Current_String_Id return String_Id;
+   function Current_String_Length return Nat32;
+   pragma Inline (Current_String_Id);
+   pragma Inline (Current_String_Length);
+
+   -- Set Current_identifier to null_identifier.
+   -- Can be used to catch bugs.
+   procedure Invalidate_Current_Identifier;
+   pragma Inline (Invalidate_Current_Identifier);
+
+   -- When CURRENT_TOKEN is tok_integer, returns the value.
+   -- When CURRENT_TOKEN is tok_bit_string, returns the base.
+   function Current_Iir_Int64 return Iir_Int64;
+   pragma Inline (Current_Iir_Int64);
+
+   -- When CURRENT_TOKEN is tok_real, it returns the value.
+   function Current_Iir_Fp64 return Iir_Fp64;
+   pragma Inline (Current_Iir_Fp64);
+
+   -- Advances the lexical analyser.  Put a new token into current_token.
+   procedure Scan;
+
+   -- Initialize the scanner with file SOURCE_FILE.
+   procedure Set_File (Source_File : Source_File_Entry);
+
+   procedure Set_Current_Position (Position: Source_Ptr);
+
+   -- Finalize the scanner.
+   procedure Close_File;
+
+   --  If true comments are reported as a token.
+   Flag_Comment : Boolean := False;
+
+   --  If true newlines are reported as a token.
+   Flag_Newline : Boolean := False;
+
+   --  If true also scan PSL tokens.
+   Flag_Psl : Boolean := False;
+
+   --  If true handle PSL embedded in comments: '--  psl' is ignored.
+   Flag_Psl_Comment : Boolean := False;
+
+   --  If true, ignore '--'.  This is automatically set when Flag_Psl_Comment
+   --  is true and a starting PSL keyword has been identified.
+   --  Must be reset to false by the parser.
+   Flag_Scan_In_Comment : Boolean := False;
+
+   --  If true scan for keywords in comments.  Must be enabled if
+   --  Flag_Psl_Comment is true.
+   Flag_Comment_Keyword : Boolean := False;
+
+   --  If the next character is '!', eat it and return True, otherwise return
+   --  False (used by PSL).
+   function Scan_Exclam_Mark return Boolean;
+
+   --  If the next character is '_', eat it and return True, otherwise return
+   --  False (used by PSL).
+   function Scan_Underscore return Boolean;
+
+   -- Get the current location, or the location of the current token.
+   -- Since a token cannot spread over lines, file and line of the current
+   -- token are the same as those of the current position.
+   function Get_Current_File return Name_Id;
+   function Get_Current_Source_File return Source_File_Entry;
+   function Get_Current_Line return Natural;
+   function Get_Current_Column return Natural;
+   function Get_Token_Location return Location_Type;
+   function Get_Token_Column return Natural;
+   function Get_Token_Position return Source_Ptr;
+   function Get_Position return Source_Ptr;
+
+   --  Convert (canonicalize) an identifier stored in name_buffer/name_length.
+   --  Upper case letters are converted into lower case.
+   --  Lexical checks are performed.
+   --  This procedure is not used by Scan, but should be used for identifiers
+   --  given in the command line.
+   --  Errors are directly reported through error_msg_option.
+   --  Also, Vhdl_Std should be set.
+   procedure Convert_Identifier;
+
+end Scanner;
diff --git a/src/sem.adb b/src/sem.adb
new file mode 100644
index 000000000..e82bd72b7
--- /dev/null
+++ b/src/sem.adb
@@ -0,0 +1,2749 @@
+--  Semantic analysis pass.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Unchecked_Conversion;
+with Errorout; use Errorout;
+with Std_Package; use Std_Package;
+with Ieee.Std_Logic_1164;
+with Libraries;
+with Std_Names;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Expr; use Sem_Expr;
+with Sem_Names; use Sem_Names;
+with Sem_Specs; use Sem_Specs;
+with Sem_Decls; use Sem_Decls;
+with Sem_Assocs; use Sem_Assocs;
+with Sem_Inst;
+with Iirs_Utils; use Iirs_Utils;
+with Flags; use Flags;
+with Name_Table;
+with Str_Table;
+with Sem_Stmts; use Sem_Stmts;
+with Iir_Chains;
+with Xrefs; use Xrefs;
+
+package body Sem is
+   -- Forward declarations.
+   procedure Sem_Context_Clauses (Design_Unit: Iir_Design_Unit);
+   procedure Sem_Block_Configuration
+     (Block_Conf : Iir_Block_Configuration; Father: Iir);
+   procedure Sem_Component_Configuration
+     (Conf : Iir_Component_Configuration; Father : Iir);
+
+   procedure Add_Dependence (Unit : Iir)
+   is
+      Targ : constant Iir := Get_Current_Design_Unit;
+   begin
+      --  During normal analysis, there is a current design unit.  But not
+      --  during debugging outside of any context.
+      if Targ = Null_Iir then
+         return;
+      end if;
+
+      Add_Dependence (Targ, Unit);
+   end Add_Dependence;
+
+   --  LRM 1.1  Entity declaration.
+   procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration) is
+   begin
+      Xrefs.Xref_Decl (Entity);
+      Sem_Scopes.Add_Name (Entity);
+      Set_Visible_Flag (Entity, True);
+
+      Set_Is_Within_Flag (Entity, True);
+
+      --  LRM 10.1
+      --  1.  An entity declaration, together with a corresponding architecture
+      --      body.
+      Open_Declarative_Region;
+
+      -- Sem generics.
+      Sem_Interface_Chain (Get_Generic_Chain (Entity), Generic_Interface_List);
+
+      -- Sem ports.
+      Sem_Interface_Chain (Get_Port_Chain (Entity), Port_Interface_List);
+
+      --  Entity declarative part and concurrent statements.
+      Sem_Block (Entity, True);
+
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Entity, False);
+   end Sem_Entity_Declaration;
+
+   --  Get the entity unit for LIBRARY_UNIT (an architecture or a
+   --  configuration declaration).
+   --  Return NULL_IIR in case of error (not found, bad library).
+   function Sem_Entity_Name (Library_Unit : Iir) return Iir
+   is
+      Name : Iir;
+      Library : Iir_Library_Declaration;
+      Entity : Iir;
+   begin
+      --  Get the library of architecture/configuration.
+      Library := Get_Library
+        (Get_Design_File (Get_Design_Unit (Library_Unit)));
+
+      --  Resolve the name.
+
+      Name := Get_Entity_Name (Library_Unit);
+      if Get_Kind (Name) = Iir_Kind_Simple_Name then
+         --  LRM93 10.1 Declarative Region
+         --  LRM08 12.1 Declarative Region
+         --  a) An entity declaration, tohether with a corresponding
+         --     architecture body.
+         --
+         --  GHDL: simple name needs to be handled specially.  Because
+         --  architecture body is in the declarative region of its entity,
+         --  the entity name is directly visible.  But we cannot really use
+         --  that rule as is, as we don't know which is the entity.
+         Entity := Libraries.Load_Primary_Unit
+           (Library, Get_Identifier (Name), Library_Unit);
+         if Entity = Null_Iir then
+            Error_Msg_Sem ("entity " & Disp_Node (Name) & " was not analysed",
+                           Library_Unit);
+            return Null_Iir;
+         end if;
+         Entity := Get_Library_Unit (Entity);
+         Set_Named_Entity (Name, Entity);
+         Xrefs.Xref_Ref (Name, Entity);
+      else
+         --  Certainly an expanded name.  Use the standard name analysis.
+         Name := Sem_Denoting_Name (Name);
+         Set_Entity_Name (Library_Unit, Name);
+         Entity := Get_Named_Entity (Name);
+      end if;
+
+      if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then
+         Error_Class_Match (Name, "entity");
+         return Null_Iir;
+      end if;
+
+      --  LRM 1.2 Architecture bodies
+      --  For a given design entity, both the entity declaration and the
+      --  associated architecture body must reside in the same library.
+
+      --  LRM 1.3 Configuration Declarations
+      --  For a configuration of a given design entity, both the
+      --  configuration declaration and the corresponding entity
+      --  declaration must reside in the same library.
+      if Get_Library (Get_Design_File (Get_Design_Unit (Entity))) /= Library
+      then
+         Error_Msg_Sem
+           (Disp_Node (Entity) & " does not reside in "
+              & Disp_Node (Library), Library_Unit);
+         return Null_Iir;
+      end if;
+
+      return Entity;
+   end Sem_Entity_Name;
+
+   --  LRM 1.2  Architecture bodies.
+   procedure Sem_Architecture_Body (Arch: Iir_Architecture_Body)
+   is
+      Entity_Unit : Iir_Design_Unit;
+      Entity_Library : Iir_Entity_Declaration;
+   begin
+      Xrefs.Xref_Decl (Arch);
+      -- First, find the entity.
+      Entity_Library := Sem_Entity_Name (Arch);
+      if Entity_Library = Null_Iir then
+         return;
+      end if;
+      Entity_Unit := Get_Design_Unit (Entity_Library);
+
+      --  LRM93 11.4
+      --   In each case, the second unit depends on the first unit.
+      --  GHDL: an architecture depends on its entity.
+      Add_Dependence (Entity_Unit);
+
+      Add_Context_Clauses (Entity_Unit);
+
+      Set_Is_Within_Flag (Arch, True);
+      Set_Is_Within_Flag (Entity_Library, True);
+
+      --  Makes the entity name visible.
+      --  FIXME: quote LRM.
+      Sem_Scopes.Add_Name
+        (Entity_Library, Get_Identifier (Entity_Library), False);
+
+      --  LRM 10.1 Declarative Region
+      --  1. An entity declaration, together with a corresponding architecture
+      --     body.
+      Open_Declarative_Region;
+      Sem_Scopes.Add_Entity_Declarations (Entity_Library);
+
+      --  LRM02 1.2  Architecture bodies
+      --  For the purpose of interpreting the scope and visibility of the
+      --  identifier (see 10.2 and 10.3), the declaration of the identifier is
+      --  considered to occur after the final declarative item of the entity
+      --  declarative part of the corresponding entity declaration.
+      --
+      --  FIXME: before VHDL-02, an architecture is not a declaration.
+      Sem_Scopes.Add_Name (Arch, Get_Identifier (Arch), True);
+      Set_Visible_Flag (Arch, True);
+
+      --  LRM02 10.1  Declarative region
+      --  The declarative region associated with an architecture body is
+      --  considered to occur immediatly within the declarative region
+      --  associated with the entity declaration corresponding to the given
+      --  architecture body.
+      if Vhdl_Std >= Vhdl_02 then
+         Open_Declarative_Region;
+      end if;
+      Sem_Block (Arch, True);
+      if Vhdl_Std >= Vhdl_02 then
+         Close_Declarative_Region;
+      end if;
+
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Arch, False);
+      Set_Is_Within_Flag (Entity_Library, False);
+   end Sem_Architecture_Body;
+
+   --  Return the real resolver used for (sub) object OBJ.
+   --  Return NULL_IIR if none.
+   function Get_Resolver (Obj : Iir) return Iir
+   is
+      Obj_Type : Iir;
+      Res : Iir;
+   begin
+      case Get_Kind (Obj) is
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_Element =>
+            Res := Get_Resolver (Get_Prefix (Obj));
+            if Res /= Null_Iir then
+               return Res;
+            end if;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when Iir_Kind_Object_Alias_Declaration =>
+            return Get_Resolver (Get_Name (Obj));
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return Get_Resolver (Get_Named_Entity (Obj));
+         when others =>
+            Error_Kind ("get_resolved", Obj);
+      end case;
+
+      Obj_Type := Get_Type (Obj);
+      if Get_Kind (Obj_Type) in Iir_Kinds_Subtype_Definition then
+         return Get_Resolution_Indication (Obj_Type);
+      else
+         return Null_Iir;
+      end if;
+   end Get_Resolver;
+
+   --  Return TRUE iff the actual of ASSOC can be the formal.
+   --  ASSOC must be an association_element_by_expression.
+   function Can_Collapse_Signals (Assoc : Iir; Formal : Iir) return Boolean
+   is
+      Actual : Iir;
+      Actual_Res : Iir;
+      Formal_Res : Iir;
+      Formal_Base : Iir;
+      Actual_Base : Iir;
+   begin
+      --  If there is a conversion, signals types are not necessarily
+      --  the same, and sharing is not possible.
+      --  FIXME: optimize type conversions
+      --    (unsigned <-> signed <-> std_ulogic_vector <-> ...)
+      if Get_In_Conversion (Assoc) /= Null_Iir
+        or else Get_Out_Conversion (Assoc) /= Null_Iir
+      then
+         return False;
+      end if;
+
+      --  Here we may assume formal and actual have the same type and the
+      --  same lengths.  This is caught at elaboration time.
+
+      Actual := Name_To_Object (Get_Actual (Assoc));
+      if Actual = Null_Iir then
+         --  This is an expression.
+         return False;
+      end if;
+
+      Formal_Base := Get_Object_Prefix (Formal);
+      Actual_Base := Get_Object_Prefix (Actual);
+
+      --  If the formal is of mode IN, then it has no driving value, and its
+      --  effective value is the effective value of the actual.
+      --  Always collapse in this case.
+      if Get_Mode (Formal_Base) = Iir_In_Mode then
+         return True;
+      end if;
+
+      --  Otherwise, these rules are applied:
+      --
+      --  In this table, E means element, S means signal.
+      --                 Er means the element is resolved,
+      --                 Sr means the signal is resolved (at the signal level).
+      --
+      --                            Actual
+      --               | E,S   | Er,S  | E,Sr  | Er,Sr |
+      --         ------+-------+-------+-------+-------+
+      --         E,S   |collap | no(3) | no(3) | no(3) |
+      --         ------+-------+-------+-------+-------+
+      --         Er,S  | no(1) |if same| no(2) | no(2) |
+      --  Formal ------+-------+-------+-------+-------+
+      --         E,Sr  | no(1) | no(2) |if same| no(4) |
+      --         ------+-------+-------+-------+-------+
+      --         Er,Sr | no(1) | no(2) | no(4) |if same|
+      --         ------+-------+-------+-------+-------+
+      --
+      --  Notes: (1): formal may have several sources.
+      --         (2): resolver is not the same.
+      --         (3): this prevents to catch several sources error in instance.
+      --         (4): resolver is not the same, because the types are not the
+      --              same.
+      --
+      --  Furthermore, signals cannot be collapsed if the kind (none, bus or
+      --  register) is not the same.
+      --
+      --  Default value:  default value is the effective value.
+
+      --  Resolution function.
+      Actual_Res := Get_Resolver (Actual);
+      Formal_Res := Get_Resolver (Formal);
+
+      --  If the resolutions are not the same, signals cannot be collapsed.
+      if Actual_Res /= Formal_Res then
+         return False;
+      end if;
+
+      --  If neither the actual nor the formal is resolved, then collapsing is
+      --  possible.
+      --  (this is case ES/ES).
+      if Actual_Res = Null_Iir and Formal_Res = Null_Iir then
+         return True;
+      end if;
+
+      --  If the formal can have sources and is guarded, but the actual is
+      --  not guarded (or has not the same kind of guard), signals cannot
+      --  be collapsed.
+      if Get_Signal_Kind (Formal_Base) /= Get_Signal_Kind (Actual_Base) then
+         return False;
+      end if;
+
+      return True;
+   end Can_Collapse_Signals;
+
+   --  INTER_PARENT contains generics interfaces;
+   --  ASSOC_PARENT constains generic aspects.
+   function Sem_Generic_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir) return Boolean
+   is
+      El : Iir;
+      Match : Boolean;
+      Assoc_Chain : Iir;
+      Inter_Chain : Iir;
+      Miss : Missing_Type;
+   begin
+      --  LRM08 6.5.6.2 Generic clauses
+      --  If no such actual is specified for a given formal generic constant
+      --  (either because the formal generic is unassociated or because the
+      --  actual is open), and if a default expression is specified for that
+      --  generic, the value of this expression is the value of the generic.
+      --  It is an error if no actual is specified for a given formal generic
+      --  constant and no default expression is present in the corresponding
+      --  interface element.
+
+      --  Note: CHECK_MATCH argument of sem_subprogram_arguments must be
+      --   true if parent is a component instantiation.
+      case Get_Kind (Assoc_Parent) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            --  LRM 9.6 Component Instantiation Statement
+            --  Each local generic (or subelement or slice thereof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+            --  ...
+            --  Each local port (or subelement or slice therof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+
+            --  GHDL: for a direct instantiation, follow rules of
+            --  LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
+            if Flags.Vhdl_Std = Vhdl_87
+              or else Get_Kind (Inter_Parent) = Iir_Kind_Entity_Declaration
+            then
+               Miss := Missing_Generic;
+            else
+               Miss := Missing_Allowed;
+            end if;
+         when Iir_Kind_Binding_Indication =>
+            --  LRM 5.2.1.2  Generic map and port map aspects
+            Miss := Missing_Allowed;
+         when Iir_Kind_Block_Header =>
+            Miss := Missing_Generic;
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            --  LRM08 4.9
+            --  Each formal generic (or member thereof) shall be associated
+            --  at most once.
+            Miss := Missing_Generic;
+         when others =>
+            Error_Kind ("sem_generic_association_list", Assoc_Parent);
+      end case;
+
+      --  The generics
+      Inter_Chain := Get_Generic_Chain (Inter_Parent);
+      Assoc_Chain := Get_Generic_Map_Aspect_Chain (Assoc_Parent);
+
+      --  Extract non-object associations, as the actual cannot be analyzed
+      --  as an expression.
+      Assoc_Chain := Extract_Non_Object_Association (Assoc_Chain, Inter_Chain);
+      Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+
+      if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
+         return False;
+      end if;
+
+      Sem_Association_Chain
+        (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match);
+      Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+      if not Match then
+         return False;
+      end if;
+
+      --  LRM 5.2.1.2   Generic map and port map aspects
+      --  An actual associated with a formal generic map aspect must be an
+      --  expression or the reserved word open;
+      El := Assoc_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Association_Element_By_Expression =>
+               Check_Read (Get_Actual (El));
+            when Iir_Kind_Association_Element_Open
+              | Iir_Kind_Association_Element_By_Individual
+              | Iir_Kind_Association_Element_Package =>
+               null;
+            when others =>
+               Error_Kind ("sem_generic_map_association_chain(1)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      return True;
+   end Sem_Generic_Association_Chain;
+
+   procedure Sem_Generic_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      Res : Boolean;
+      pragma Unreferenced (Res);
+   begin
+      Res := Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
+   end Sem_Generic_Association_Chain;
+
+   --  INTER_PARENT contains ports interfaces;
+   --  ASSOC_PARENT constains ports map aspects.
+   procedure Sem_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      El : Iir;
+      Actual : Iir;
+      Prefix : Iir;
+      Object : Iir;
+      Match : Boolean;
+      Assoc_Chain : Iir;
+      Miss : Missing_Type;
+      Inter : Iir;
+      Formal : Iir;
+      Formal_Base : Iir;
+   begin
+      --  Note: CHECK_MATCH argument of sem_subprogram_arguments must be
+      --   true if parent is a component instantiation.
+      case Get_Kind (Assoc_Parent) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            --  LRM 9.6 Component Instantiation Statement
+            --  Each local generic (or subelement or slice thereof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+            --  ...
+            --  Each local port (or subelement or slice therof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+
+            --  GHDL: for a direct instantiation, follow rules of
+            --  LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
+            if Flags.Vhdl_Std = Vhdl_87
+              or else Get_Kind (Inter_Parent) = Iir_Kind_Entity_Declaration
+            then
+               Miss := Missing_Port;
+            else
+               Miss := Missing_Allowed;
+            end if;
+         when Iir_Kind_Binding_Indication =>
+            --  LRM 5.2.1.2  Generic map and port map aspects
+            Miss := Missing_Allowed;
+         when Iir_Kind_Block_Header =>
+            --  FIXME: it is possible to have port unassociated ?
+            Miss := Missing_Port;
+         when others =>
+            Error_Kind ("sem_port_association_list", Assoc_Parent);
+      end case;
+
+      --  The ports
+      Assoc_Chain := Get_Port_Map_Aspect_Chain (Assoc_Parent);
+      if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
+         return;
+      end if;
+      Sem_Association_Chain (Get_Port_Chain (Inter_Parent), Assoc_Chain,
+                             True, Miss, Assoc_Parent, Match);
+      Set_Port_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+      if not Match then
+         return;
+      end if;
+
+      --  LRM 5.2.1.2  Generic map and port map aspects
+      --  [...]; an actual associated with a formal port in a port map aspect
+      --  must be a signal, an expression, or the reserved word open.
+      --
+      --  Certain restriction apply to the actual associated with a formal in
+      --  a port map aspect; these restrictions are described in 1.1.1.2
+
+      --  LRM93 1.1.1.2
+      --  The actual, if a port or signal, must be denoted by a static name.
+      --  The actual, if an expression, must be a globally static expression.
+      El := Assoc_Chain;
+      Inter := Get_Port_Chain (Inter_Parent);
+      while El /= Null_Iir loop
+         Formal := Get_Formal (El);
+
+         if Formal = Null_Iir then
+            --  No formal: use association by position.
+            Formal := Inter;
+            Formal_Base := Inter;
+            Inter := Get_Chain (Inter);
+         else
+            Inter := Null_Iir;
+            Formal_Base := Get_Association_Interface (El);
+         end if;
+
+         if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then
+            Actual := Get_Actual (El);
+            --  There has been an error, exit from the loop.
+            exit when Actual = Null_Iir;
+            Object := Name_To_Object (Actual);
+            if Object = Null_Iir then
+               Prefix := Actual;
+            else
+               Prefix := Get_Object_Prefix (Object);
+            end if;
+            case Get_Kind (Prefix) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Interface_Signal_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration
+                 | Iir_Kinds_Signal_Attribute =>
+                  --  Port or signal.
+                  Set_Collapse_Signal_Flag
+                    (El, Can_Collapse_Signals (El, Formal));
+                  if Get_Name_Staticness (Object) < Globally then
+                     Error_Msg_Sem ("actual must be a static name", Actual);
+                  end if;
+                  if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration
+                  then
+                     declare
+                        P : Boolean;
+                        pragma Unreferenced (P);
+                     begin
+                        P := Check_Port_Association_Restriction
+                          (Formal_Base, Prefix, El);
+                     end;
+                  end if;
+               when others =>
+                  --  Expression.
+                  Set_Collapse_Signal_Flag (El, False);
+
+                  --  If there is an IN conversion, re-integrate it into
+                  --  the actual.
+                  declare
+                     In_Conv : Iir;
+                  begin
+                     In_Conv := Get_In_Conversion (El);
+                     if In_Conv /= Null_Iir then
+                        Set_In_Conversion (El, Null_Iir);
+                        Set_Expr_Staticness
+                          (In_Conv, Get_Expr_Staticness (Actual));
+                        Actual := In_Conv;
+                        Set_Actual (El, Actual);
+                     end if;
+                  end;
+                  if Flags.Vhdl_Std >= Vhdl_93c then
+                     --  LRM93 1.1.1.2 Ports
+                     --  Moreover, the ports of a block may be associated
+                     --  with an expression, in order to provide these ports
+                     --  with constant driving values; such ports must be
+                     --  of mode in.
+                     if Get_Mode (Formal_Base) /= Iir_In_Mode then
+                        Error_Msg_Sem ("only 'in' ports may be associated "
+                                       & "with expression", El);
+                     end if;
+
+                     --  LRM93 1.1.1.2 Ports
+                     --  The actual, if an expression, must be a globally
+                     --  static expression.
+                     if Get_Expr_Staticness (Actual) < Globally then
+                        Error_Msg_Sem
+                          ("actual expression must be globally static",
+                           Actual);
+                     end if;
+                  else
+                     Error_Msg_Sem
+                       ("cannot associate ports with expression in vhdl87",
+                        El);
+                  end if;
+            end case;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+   end Sem_Port_Association_Chain;
+
+   --  INTER_PARENT contains generics and ports interfaces;
+   --  ASSOC_PARENT constains generics and ports map aspects.
+   procedure Sem_Generic_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      Res : Boolean;
+      pragma Unreferenced (Res);
+   begin
+      Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
+      Sem_Port_Association_Chain (Inter_Parent, Assoc_Parent);
+   end Sem_Generic_Port_Association_Chain;
+
+   --  LRM 1.3  Configuration Declarations.
+   procedure Sem_Configuration_Declaration (Decl: Iir)
+   is
+      Entity: Iir_Entity_Declaration;
+      Entity_Unit : Iir_Design_Unit;
+   begin
+      Xref_Decl (Decl);
+
+      --  LRM 1.3
+      --  The entity name identifies the name of the entity declaration that
+      --  defines the design entity at the apex of the design hierarchy.
+      Entity := Sem_Entity_Name (Decl);
+      if Entity = Null_Iir then
+         return;
+      end if;
+      Entity_Unit := Get_Design_Unit (Entity);
+
+      --  LRM 11.4
+      --  A primary unit whose name is referenced within a given design unit
+      --  must be analyzed prior to the analysis of the given design unit.
+      Add_Dependence (Entity_Unit);
+
+      Sem_Scopes.Add_Name (Decl);
+
+      Set_Visible_Flag (Decl, True);
+
+      --  LRM 10.1 Declarative Region
+      --  2.  A configuration declaration.
+      Open_Declarative_Region;
+
+      --  LRM93 10.2
+      --  In addition to the above rules, the scope of any declaration that
+      --  includes the end of the declarative part of a given block (wether
+      --  it be an external block defined by a design entity or an internal
+      --  block defined by a block statement) extends into a configuration
+      --  declaration that configures the given block.
+      Add_Context_Clauses (Entity_Unit);
+      Sem_Scopes.Add_Entity_Declarations (Entity);
+
+      Sem_Declaration_Chain (Decl);
+      --  GHDL: no need to check for missing subprogram bodies, since they are
+      --  not allowed in configuration declarations.
+
+      Sem_Block_Configuration (Get_Block_Configuration (Decl), Decl);
+      Close_Declarative_Region;
+   end Sem_Configuration_Declaration;
+
+   --  LRM 1.3.1  Block Configuration.
+   --  FATHER is the block_configuration, configuration_declaration,
+   --  component_configuration containing the block_configuration BLOCK_CONF.
+   procedure Sem_Block_Configuration
+     (Block_Conf : Iir_Block_Configuration; Father: Iir)
+   is
+      El : Iir;
+      Block : Iir;
+   begin
+      case Get_Kind (Father) is
+         when Iir_Kind_Configuration_Declaration =>
+            --  LRM93 1.3.1
+            --  If a block configuration appears immediately within a
+            --  configuration declaration, then the block specification of that
+            --  block configuration must be an architecture name, and that
+            --  architecture name must denote a design entity body whose
+            --  interface is defined by the entity declaration denoted by the
+            --  entity name of the enclosing configuration declaration.
+            declare
+               Block_Spec : Iir;
+               Arch : Iir_Architecture_Body;
+               Design: Iir_Design_Unit;
+            begin
+               Block_Spec := Get_Block_Specification (Block_Conf);
+               --  FIXME: handle selected name.
+               if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+                  Error_Msg_Sem ("architecture name expected", Block_Spec);
+                  return;
+               end if;
+               --  LRM 10.3 rule b)
+               --  For an architecture body associated with a given entity
+               --  declaration: at the place of the block specification in a
+               --  block configuration for an external block whose interface
+               --  is defined by that entity declaration.
+               Design := Libraries.Load_Secondary_Unit
+                 (Get_Design_Unit (Get_Entity (Father)),
+                  Get_Identifier (Block_Spec),
+                  Block_Conf);
+               if Design = Null_Iir then
+                  Error_Msg_Sem
+                    ("no architecture '" & Image_Identifier (Block_Spec) & "'",
+                     Block_Conf);
+                  return;
+               end if;
+               Arch := Get_Library_Unit (Design);
+               Xref_Ref (Block_Spec, Arch);
+               Free_Iir (Block_Spec);
+               Set_Block_Specification (Block_Conf, Arch);
+               Block := Arch;
+               Add_Dependence (Design);
+            end;
+
+         when Iir_Kind_Component_Configuration =>
+            --  LRM93 1.3.1
+            --  If a block configuration appears immediately within a component
+            --  configuration, then the corresponding components must be
+            --  fully bound, the block specification of that block
+            --  configuration must be an architecture name, and that
+            --  architecture name must denote the same architecture body as
+            --  that to which the corresponding components are bound.
+            declare
+               Block_Spec : Iir;
+               Arch : Iir_Architecture_Body;
+               Design: Iir_Design_Unit;
+               Entity_Aspect : Iir;
+               Comp_Arch : Iir;
+            begin
+               Entity_Aspect :=
+                 Get_Entity_Aspect (Get_Binding_Indication (Father));
+               if Entity_Aspect = Null_Iir or else
+                 Get_Kind (Entity_Aspect) /= Iir_Kind_Entity_Aspect_Entity
+               then
+                  Error_Msg_Sem ("corresponding component not fully bound",
+                                 Block_Conf);
+               end if;
+
+               Block_Spec := Get_Block_Specification (Block_Conf);
+               --  FIXME: handle selected name.
+               if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+                  Error_Msg_Sem ("architecture name expected", Block_Spec);
+                  return;
+               end if;
+
+               Comp_Arch := Get_Architecture (Entity_Aspect);
+               if Comp_Arch /= Null_Iir then
+                  if Get_Kind (Comp_Arch) /= Iir_Kind_Simple_Name then
+                     raise Internal_Error;
+                  end if;
+                  if Get_Identifier (Comp_Arch) /= Get_Identifier (Block_Spec)
+                  then
+                     Error_Msg_Sem
+                       ("block specification name is different from "
+                        & "component architecture name", Block_Spec);
+                     return;
+                  end if;
+               end if;
+
+               Design := Libraries.Load_Secondary_Unit
+                 (Get_Design_Unit (Get_Entity (Entity_Aspect)),
+                  Get_Identifier (Block_Spec),
+                  Block_Conf);
+               if Design = Null_Iir then
+                  Error_Msg_Sem
+                    ("no architecture '" & Image_Identifier (Block_Spec) & "'",
+                     Block_Conf);
+                  return;
+               end if;
+               Arch := Get_Library_Unit (Design);
+               Xref_Ref (Block_Spec, Arch);
+               Free_Iir (Block_Spec);
+               Set_Block_Specification (Block_Conf, Arch);
+               Block := Arch;
+            end;
+
+         when Iir_Kind_Block_Configuration =>
+            --  LRM93 1.3.1
+            --  If a block configuration appears immediately within another
+            --  block configuration, then the block specification of the
+            --  contained block configuration must be a block statement or
+            --  generate statement label, and the label must denote a block
+            --  statement or generate statement that is contained immediatly
+            --  within the block denoted by the block specification of the
+            --  containing block configuration.
+            declare
+               Block_Spec : Iir;
+               Block_Name : Iir;
+               Block_Stmts : Iir;
+               Block_Spec_Kind : Iir_Kind;
+               Prev : Iir_Block_Configuration;
+            begin
+               Block_Spec := Get_Block_Specification (Block_Conf);
+               --  Remember the kind of BLOCK_SPEC, since the node can be free
+               --  by find_declaration if it is a simple name.
+               Block_Spec_Kind := Get_Kind (Block_Spec);
+               case Block_Spec_Kind is
+                  when Iir_Kind_Simple_Name =>
+                     Block_Name := Block_Spec;
+                  when Iir_Kind_Parenthesis_Name =>
+                     Block_Name := Get_Prefix (Block_Spec);
+                  when Iir_Kind_Slice_Name =>
+                     Block_Name := Get_Prefix (Block_Spec);
+                  when others =>
+                     Error_Msg_Sem ("label expected", Block_Spec);
+                     return;
+               end case;
+               Block_Name := Sem_Denoting_Name (Block_Name);
+               Block := Get_Named_Entity (Block_Name);
+               case Get_Kind (Block) is
+                  when Iir_Kind_Block_Statement =>
+                     if Block_Spec_Kind /= Iir_Kind_Simple_Name then
+                        Error_Msg_Sem
+                          ("label does not denote a generate statement",
+                           Block_Spec);
+                     end if;
+                     Prev := Get_Block_Block_Configuration (Block);
+                     if Prev /= Null_Iir then
+                        Error_Msg_Sem
+                          (Disp_Node (Block) & " was already configured at "
+                           & Disp_Location (Prev),
+                           Block_Conf);
+                        return;
+                     end if;
+                     Set_Block_Block_Configuration (Block, Block_Conf);
+                  when Iir_Kind_Generate_Statement =>
+                     if Block_Spec_Kind /= Iir_Kind_Simple_Name
+                       and then Get_Kind (Get_Generation_Scheme (Block))
+                       /= Iir_Kind_Iterator_Declaration
+                     then
+                        --  LRM93 1.3
+                        --  If the block specification of a block configuration
+                        --  contains a generate statement label, and if this
+                        --  label contains an index specification, then it is
+                        --  an error if the generate statement denoted by the
+                        --  label does not have a generation scheme including
+                        --  the reserved word for.
+                        Error_Msg_Sem ("generate statement does not has a for",
+                                       Block_Spec);
+                        return;
+                     end if;
+                     Set_Prev_Block_Configuration
+                       (Block_Conf, Get_Generate_Block_Configuration (Block));
+                     Set_Generate_Block_Configuration (Block, Block_Conf);
+                  when others =>
+                     Error_Msg_Sem ("block statement label expected",
+                                    Block_Conf);
+                     return;
+               end case;
+               Block_Stmts := Get_Concurrent_Statement_Chain
+                 (Get_Block_From_Block_Specification
+                  (Get_Block_Specification (Father)));
+               if not Is_In_Chain (Block_Stmts, Block) then
+                  Error_Msg_Sem
+                    ("label does not denotes an inner block statement",
+                     Block_Conf);
+                  return;
+               end if;
+
+               if Block_Spec_Kind = Iir_Kind_Parenthesis_Name then
+                  Block_Spec := Sem_Index_Specification
+                    (Block_Spec, Get_Type (Get_Generation_Scheme (Block)));
+                  if Block_Spec /= Null_Iir then
+                     Set_Prefix (Block_Spec, Block_Name);
+                     Set_Block_Specification (Block_Conf, Block_Spec);
+                     Block_Spec_Kind := Get_Kind (Block_Spec);
+                  end if;
+               end if;
+
+               case Block_Spec_Kind is
+                  when Iir_Kind_Simple_Name =>
+                     Set_Block_Specification (Block_Conf, Block_Name);
+                  when Iir_Kind_Indexed_Name
+                    | Iir_Kind_Slice_Name =>
+                     null;
+                  when Iir_Kind_Parenthesis_Name =>
+                     null;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            end;
+
+         when others =>
+            Error_Kind ("sem_block_configuration", Father);
+      end case;
+
+      --  LRM93 §10.1
+      --  10. A block configuration
+      Sem_Scopes.Open_Scope_Extension;
+
+      --  LRM 10.3
+      --  In addition, any declaration that is directly visible at the end of
+      --  the declarative part of a given block is directly visible in a block
+      --  configuration that configure the given block.  This rule holds unless
+      --  a use clause that makes a homograph of the declaration potentially
+      --  visible (see 10.4) appears in the corresponding configuration
+      --  declaration, and if the scope of that use clause encompasses all or
+      --  part of those configuration items.  If such a use clase appears, then
+      --  the declaration will be directly visible within the corresponding
+      --  configuration items, except at hose places that fall within the scope
+      --  of the additional use clause.  At such places, neither name will be
+      --  directly visible.
+      --  FIXME: handle use clauses.
+      Sem_Scopes.Extend_Scope_Of_Block_Declarations (Block);
+
+      declare
+         El : Iir;
+      begin
+         El := Get_Declaration_Chain (Block_Conf);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Use_Clause =>
+                  Sem_Use_Clause (El);
+               when others =>
+                  --  Parse checks there are only use clauses.
+                  raise Internal_Error;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end;
+
+      --  VHDL 87: do not remove configuration specification in generate stmts.
+      Clear_Instantiation_Configuration (Block, False);
+
+      El := Get_Configuration_Item_Chain (Block_Conf);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Block_Configuration =>
+               Sem_Block_Configuration (El, Block_Conf);
+            when Iir_Kind_Component_Configuration =>
+               Sem_Component_Configuration (El, Block_Conf);
+            when others =>
+               Error_Kind ("sem_block_configuration(2)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      Sem_Scopes.Close_Scope_Extension;
+   end Sem_Block_Configuration;
+
+   --  LRM 1.3.2
+   procedure Sem_Component_Configuration
+     (Conf : Iir_Component_Configuration; Father : Iir)
+   is
+      Block : Iir;
+      Configured_Block : Iir;
+      Binding : Iir;
+      Entity : Iir_Design_Unit;
+      Comp : Iir_Component_Declaration;
+      Primary_Entity_Aspect : Iir;
+   begin
+      --  LRM 10.1 Declarative Region
+      --  11. A component configuration.
+      Open_Declarative_Region;
+
+      --  LRM93 §10.2
+      --  If a component configuration appears as a configuration item
+      --  immediatly within a block configuration that configures a given
+      --  block, and the scope of a given declaration includes the end of the
+      --  declarative part of that block, then the scope of the given
+      --  declaration extends from the beginning to the end of the
+      --  declarative region associated with the given component configuration.
+      -- GHDL: this is for labels of component instantiation statements, and
+      -- for local ports and generics of the component.
+      if Get_Kind (Father) = Iir_Kind_Block_Configuration then
+         Configured_Block := Get_Block_Specification (Father);
+         if Get_Kind (Configured_Block) = Iir_Kind_Design_Unit then
+            raise Internal_Error;
+         end if;
+         Configured_Block :=
+           Get_Block_From_Block_Specification (Configured_Block);
+         Sem_Scopes.Extend_Scope_Of_Block_Declarations (Configured_Block);
+      else
+         --  Can a component configuration not be just inside a block
+         --  configuration ?
+         raise Internal_Error;
+      end if;
+      --  FIXME: this is wrong (all declarations should be considered).
+      Sem_Component_Specification
+        (Configured_Block, Conf, Primary_Entity_Aspect);
+
+      Comp := Get_Named_Entity (Get_Component_Name (Conf));
+      if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+         --  There has been an error in sem_component_specification.
+         --  Leave here.
+         Close_Declarative_Region;
+         return;
+      end if;
+
+      --  FIXME: (todo)
+      --  If a given component instance is unbound in the corresponding block,
+      --  then any explicit component configuration for that instance that does
+      --  not contain an explicit binding indication will contain an implicit,
+      --  default binding indication (see 5.2.2).  Similarly, if a given
+      --  component instance is unbound in the corresponding block, then any
+      --  implicit component configuration for that instance will contain an
+      --  implicit, default binding indication.
+      Open_Declarative_Region;
+      Sem_Scopes.Add_Component_Declarations (Comp);
+      Binding := Get_Binding_Indication (Conf);
+      if Binding /= Null_Iir then
+         Sem_Binding_Indication (Binding, Comp, Conf, Primary_Entity_Aspect);
+
+         if Primary_Entity_Aspect /= Null_Iir then
+            --  LRM93 5.2.1  Binding Indication
+            --  It is an error if a formal port appears in the port map aspect
+            --  of the incremental binding indication and it is a formal
+            --  port that is associated with an actual other than OPEN in one
+            --  of the primary binding indications.
+            declare
+               Inst : Iir;
+               Primary_Binding : Iir;
+               F_Chain : Iir;
+               F_El, S_El : Iir;
+               Formal : Iir;
+            begin
+               Inst := Get_Concurrent_Statement_Chain (Configured_Block);
+               while Inst /= Null_Iir loop
+                  if Get_Kind (Inst)
+                    = Iir_Kind_Component_Instantiation_Statement
+                    and then Get_Component_Configuration (Inst) = Conf
+                  then
+                     --  Check here.
+                     Primary_Binding := Get_Binding_Indication
+                       (Get_Configuration_Specification (Inst));
+                     F_Chain := Get_Port_Map_Aspect_Chain (Primary_Binding);
+                     S_El := Get_Port_Map_Aspect_Chain (Binding);
+                     while S_El /= Null_Iir loop
+                        --  Find S_EL formal in F_CHAIN.
+                        Formal := Get_Association_Interface (S_El);
+                        F_El := F_Chain;
+                        while F_El /= Null_Iir loop
+                           exit when Get_Association_Interface (F_El) = Formal;
+                           F_El := Get_Chain (F_El);
+                        end loop;
+                        if F_El /= Null_Iir
+                          and then Get_Kind (F_El)
+                          /= Iir_Kind_Association_Element_Open
+                        then
+                           Error_Msg_Sem
+                             (Disp_Node (Formal)
+                              & " already associated in primary binding",
+                              S_El);
+                        end if;
+                        S_El := Get_Chain (S_El);
+                     end loop;
+                  end if;
+                  Inst := Get_Chain (Inst);
+               end loop;
+            end;
+         end if;
+      elsif Primary_Entity_Aspect = Null_Iir then
+         --  LRM93 5.2.1
+         --  If the generic map aspect or port map aspect of a primary binding
+         --  indication is not present, then the default rules as described
+         --  in 5.2.2 apply.
+
+         --  Create a default binding indication.
+         Entity := Get_Visible_Entity_Declaration (Comp);
+         Binding := Sem_Create_Default_Binding_Indication
+           (Comp, Entity, Conf, False);
+
+         if Binding /= Null_Iir then
+            --  Remap to defaults.
+            Set_Default_Entity_Aspect (Binding, Get_Entity_Aspect (Binding));
+            Set_Entity_Aspect (Binding, Null_Iir);
+
+            Set_Default_Generic_Map_Aspect_Chain
+              (Binding, Get_Generic_Map_Aspect_Chain (Binding));
+            Set_Generic_Map_Aspect_Chain (Binding, Null_Iir);
+
+            Set_Default_Port_Map_Aspect_Chain
+              (Binding, Get_Port_Map_Aspect_Chain (Binding));
+            Set_Port_Map_Aspect_Chain (Binding, Null_Iir);
+
+            Set_Binding_Indication (Conf, Binding);
+         end if;
+      end if;
+      Close_Declarative_Region;
+
+      --  External block.
+      Block := Get_Block_Configuration (Conf);
+      if Block /= Null_Iir and then Binding /= Null_Iir then
+         Sem_Block_Configuration (Block, Conf);
+      end if;
+      Close_Declarative_Region;
+   end Sem_Component_Configuration;
+
+   function Are_Trees_Chain_Equal (Left, Right : Iir) return Boolean
+   is
+      El_Left, El_Right : Iir;
+   begin
+      if Left = Right then
+         return True;
+      end if;
+      El_Left := Left;
+      El_Right := Right;
+      loop
+         if El_Left = Null_Iir and El_Right = Null_Iir then
+            return True;
+         end if;
+         if El_Left = Null_Iir or El_Right = Null_Iir then
+            return False;
+         end if;
+         if not Are_Trees_Equal (El_Left, El_Right) then
+            return False;
+         end if;
+         El_Left := Get_Chain (El_Left);
+         El_Right := Get_Chain (El_Right);
+      end loop;
+   end Are_Trees_Chain_Equal;
+
+   --  Return TRUE iff LEFT and RIGHT are (in depth) equal.
+   --  This corresponds to conformance rules, LRM93 2.7
+   function Are_Trees_Equal (Left, Right : Iir) return Boolean
+   is
+      El_Left, El_Right : Iir;
+   begin
+      --  Short-cut to speed up.
+      if Left = Right then
+         return True;
+      end if;
+
+      --  Handle null_iir.
+      if Left = Null_Iir or Right = Null_Iir then
+         --  Note: LEFT *xor* RIGHT is null_iir.
+         return False;
+      end if;
+
+      --  LRM 2.7  Conformance Rules
+      --  A simple name can be replaced by an expanded name in which this
+      --  simple name is the selector, if and only if at both places the
+      --  meaning of the simple name is given by the same declaration.
+      case Get_Kind (Left) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            case Get_Kind (Right) is
+               when Iir_Kind_Simple_Name
+                 | Iir_Kind_Selected_Name =>
+                  return Are_Trees_Equal (Get_Named_Entity (Left),
+                                          Get_Named_Entity (Right));
+               when others =>
+                  return False;
+            end case;
+         when others =>
+            null;
+      end case;
+
+      --  If nodes are not of the same kind, then they are not equals!
+      if Get_Kind (Left) /= Get_Kind (Right) then
+         return False;
+      end if;
+
+      case Get_Kind (Left) is
+         when Iir_Kinds_Procedure_Declaration =>
+            return Are_Trees_Chain_Equal
+              (Get_Interface_Declaration_Chain (Left),
+               Get_Interface_Declaration_Chain (Right));
+         when Iir_Kinds_Function_Declaration =>
+            if not Are_Trees_Equal (Get_Return_Type (Left),
+                                    Get_Return_Type (Right))
+            then
+               return False;
+            end if;
+            if Get_Pure_Flag (Left) /= Get_Pure_Flag (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Chain_Equal
+              (Get_Interface_Declaration_Chain (Left),
+               Get_Interface_Declaration_Chain (Right))
+            then
+               return False;
+            end if;
+            return True;
+         when Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            if Get_Identifier (Left) /= Get_Identifier (Right) then
+               return False;
+            end if;
+            if Get_Lexical_Layout (Left) /= Get_Lexical_Layout (Right)
+              or else Get_Mode (Left) /= Get_Mode (Right)
+            then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then
+               return False;
+            end if;
+            El_Left := Get_Default_Value (Left);
+            El_Right := Get_Default_Value (Right);
+            if (El_Left = Null_Iir) xor (El_Right = Null_Iir)  then
+               return False;
+            end if;
+            if El_Left /= Null_Iir
+              and then Are_Trees_Equal (El_Left, El_Right) = False
+            then
+               return False;
+            end if;
+            return True;
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            if Get_Base_Type (Left) /= Get_Base_Type (Right) then
+               return False;
+            end if;
+            if Get_Type_Declarator (Left) /= Get_Type_Declarator (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Resolution_Indication (Left),
+                                    Get_Resolution_Indication (Right))
+            then
+               return False;
+            end if;
+            if Are_Trees_Equal (Get_Range_Constraint (Left),
+                                Get_Range_Constraint (Right)) = False
+            then
+               return False;
+            end if;
+            return True;
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Get_Base_Type (Left) /= Get_Base_Type (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Resolution_Indication (Left),
+                                    Get_Resolution_Indication (Right))
+            then
+               return False;
+            end if;
+            declare
+               L_Left, L_Right : Iir_List;
+            begin
+               L_Left := Get_Index_Subtype_List (Left);
+               L_Right := Get_Index_Subtype_List (Right);
+               for I in Natural loop
+                  El_Left := Get_Nth_Element (L_Left, I);
+                  El_Right := Get_Nth_Element (L_Right, I);
+                  exit when El_Left = Null_Iir;
+                  if not Are_Trees_Equal (El_Left, El_Right) then
+                     return False;
+                  end if;
+               end loop;
+            end;
+            return True;
+         when Iir_Kind_Record_Subtype_Definition =>
+            if Get_Base_Type (Left) /= Get_Base_Type (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Resolution_Indication (Left),
+                                    Get_Resolution_Indication (Right))
+            then
+               return False;
+            end if;
+            declare
+               L_Left, L_Right : Iir_List;
+            begin
+               L_Left := Get_Elements_Declaration_List (Left);
+               L_Right := Get_Elements_Declaration_List (Right);
+               for I in Natural loop
+                  El_Left := Get_Nth_Element (L_Left, I);
+                  El_Right := Get_Nth_Element (L_Right, I);
+                  exit when El_Left = Null_Iir;
+                  if not Are_Trees_Equal (El_Left, El_Right) then
+                     return False;
+                  end if;
+               end loop;
+            end;
+            return True;
+
+         when Iir_Kind_Integer_Literal =>
+            if Get_Value (Left) /= Get_Value (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Enumeration_Literal =>
+            if Get_Enum_Pos (Left) /= Get_Enum_Pos (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Physical_Int_Literal =>
+            if Get_Value (Left) /= Get_Value (Right)
+              or else not Are_Trees_Equal (Get_Unit_Name (Left),
+                                           Get_Unit_Name (Right))
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Physical_Fp_Literal =>
+            if Get_Fp_Value (Left) /= Get_Fp_Value (Right)
+              or else Get_Unit_Name (Left) /= Get_Unit_Name (Right)
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Floating_Point_Literal =>
+            if Get_Fp_Value (Left) /= Get_Fp_Value (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+
+         when Iir_Kinds_Dyadic_Operator =>
+            return Are_Trees_Equal (Get_Left (Left), Get_Left (Right))
+              and then Are_Trees_Equal (Get_Right (Left), Get_Right (Right));
+         when Iir_Kinds_Monadic_Operator =>
+            return Are_Trees_Equal (Get_Operand (Left), Get_Operand (Right));
+
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_File_Type_Definition =>
+            return Left = Right;
+
+         when Iir_Kind_Range_Expression =>
+            if Get_Type (Left) /= Get_Type (Right)
+              or else Get_Direction (Left) /= Get_Direction (Right)
+            then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Left_Limit (Left),
+                                    Get_Left_Limit (Right))
+              or else not Are_Trees_Equal (Get_Right_Limit (Left),
+                                           Get_Right_Limit (Right))
+            then
+               return False;
+            end if;
+            return True;
+
+         when Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute =>
+            return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right));
+
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            if Get_Kind (Left) = Iir_Kind_Bit_String_Literal
+              and then Get_Bit_String_Base (Left)
+              /= Get_Bit_String_Base (Right)
+            then
+               return False;
+            end if;
+            declare
+               use Str_Table;
+               Len : Nat32;
+               L_Ptr : String_Fat_Acc;
+               R_Ptr : String_Fat_Acc;
+            begin
+               Len := Get_String_Length (Left);
+               if Get_String_Length (Right) /= Len then
+                  return False;
+               end if;
+               L_Ptr := Get_String_Fat_Acc (Get_String_Id (Left));
+               R_Ptr := Get_String_Fat_Acc (Get_String_Id (Right));
+               for I in 1 .. Len loop
+                  if L_Ptr (I) /= R_Ptr (I) then
+                     return False;
+                  end if;
+               end loop;
+               return True;
+            end;
+
+         when Iir_Kind_Aggregate =>
+            if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then
+               return False;
+            end if;
+            declare
+               El_L, El_R : Iir;
+            begin
+               El_L := Get_Association_Choices_Chain (Left);
+               El_R := Get_Association_Choices_Chain (Right);
+               loop
+                  exit when El_L = Null_Iir and El_R = Null_Iir;
+                  if not Are_Trees_Equal (El_L, El_R) then
+                     return False;
+                  end if;
+                  El_L := Get_Chain (El_L);
+                  El_R := Get_Chain (El_R);
+               end loop;
+               return True;
+            end;
+
+         when Iir_Kind_Choice_By_None
+              | Iir_Kind_Choice_By_Others =>
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Name =>
+            if not Are_Trees_Equal (Get_Choice_Name (Left),
+                                    Get_Choice_Name (Right))
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Expression =>
+            if not Are_Trees_Equal (Get_Choice_Expression (Left),
+                                    Get_Choice_Expression (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Range =>
+            if not Are_Trees_Equal (Get_Choice_Range (Left),
+                                    Get_Choice_Range (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Character_Literal =>
+            return Are_Trees_Equal (Get_Named_Entity (Left),
+                                    Get_Named_Entity (Right));
+         when others =>
+            Error_Kind ("are_trees_equal", Left);
+      end case;
+   end Are_Trees_Equal;
+
+   --  LRM 2.7  Conformance Rules.
+   procedure Check_Conformance_Rules (Subprg, Spec: Iir) is
+   begin
+      if not Are_Trees_Equal (Subprg, Spec) then
+         --  FIXME: should explain why it does not conform ?
+         Error_Msg_Sem ("body of " & Disp_Node (Subprg)
+                          & " does not conform with specification at "
+                          & Disp_Location (Spec), Subprg);
+      end if;
+   end Check_Conformance_Rules;
+
+   -- Return the specification corresponding to a declaration DECL, or
+   -- null_Iir if none.
+   -- FIXME: respect rules of LRM93 2.7
+   function Find_Subprogram_Specification (Decl: Iir) return Iir
+   is
+      Interpretation : Name_Interpretation_Type;
+      Decl1: Iir;
+      Hash : Iir_Int32;
+      Kind : Iir_Kind;
+   begin
+      Hash := Get_Subprogram_Hash (Decl);
+      Interpretation := Get_Interpretation (Get_Identifier (Decl));
+      while Valid_Interpretation (Interpretation) loop
+         if not Is_In_Current_Declarative_Region (Interpretation) then
+            --  The declaration does not belong to the current declarative
+            --  region, neither will the following one.  So, we do not found
+            --  it.
+            return Null_Iir;
+         end if;
+         Decl1 := Get_Declaration (Interpretation);
+         Kind := Get_Kind (Decl1);
+         --  Should be sure DECL1 and DECL belongs to the same declarative
+         --  region, ie DECL1 was not made visible via a USE clause.
+         --
+         --  Also, only check for explicitly subprograms (and not
+         --  implicit one).
+         if (Kind = Iir_Kind_Function_Declaration
+             or Kind = Iir_Kind_Procedure_Declaration)
+           and then not Is_Potentially_Visible (Interpretation)
+           and then Get_Subprogram_Hash (Decl1) = Hash
+           and then Is_Same_Profile (Decl, Decl1)
+         then
+            return Decl1;
+         end if;
+         Interpretation := Get_Next_Interpretation (Interpretation);
+      end loop;
+      return Null_Iir;
+   end Find_Subprogram_Specification;
+
+   procedure Set_Subprogram_Overload_Number (Decl : Iir)
+   is
+      Id : constant Name_Id := Get_Identifier (Decl);
+      Inter : Name_Interpretation_Type;
+      Prev : Iir;
+      Num : Iir_Int32;
+   begin
+      Inter := Get_Interpretation (Id);
+      while Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      loop
+         --  There is a previous declaration with the same name in the
+         --  current declarative region.
+         Prev := Get_Declaration (Inter);
+         case Get_Kind (Prev) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               --  The previous declaration is a user subprogram.
+               Num := Get_Overload_Number (Prev) + 1;
+               if Num = 1
+                 and then Get_Parent (Prev) = Get_Parent (Decl)
+               then
+                  --  The previous was not (yet) overloaded.  Mark it as
+                  --  overloaded.
+                  --  Do not mark it if it is not in the same declarative part.
+                  --  (ie, do not change a subprogram declaration in the
+                  --   package while analyzing the body).
+                  Set_Overload_Number (Prev, 1);
+                  Num := 2;
+               end if;
+               Set_Overload_Number (Decl, Num);
+               return;
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               --  Implicit declarations aren't taken into account (as they
+               --  are mangled differently).
+               Inter := Get_Next_Interpretation (Inter);
+            when Iir_Kind_Enumeration_Literal =>
+               --  Enumeration literal are ignored for overload number.
+               Inter := Get_Next_Interpretation (Inter);
+            when others =>
+               --  An error ?
+               Set_Overload_Number (Decl, 0);
+               return;
+         end case;
+      end loop;
+      --  No previous declaration in the current declarative region.
+      Set_Overload_Number (Decl, 0);
+   end Set_Subprogram_Overload_Number;
+
+   --  Check requirements on number of interfaces for subprogram specification
+   --  SUBPRG.  Requirements only concern operators, and are defined in
+   --  LRM 2.3.1
+   procedure Check_Operator_Requirements (Id : Name_Id; Subprg : Iir)
+   is
+      use Std_Names;
+
+      Nbr_Interfaces : Natural;
+      Is_Method : Boolean;
+   begin
+      Nbr_Interfaces := Iir_Chains.Get_Chain_Length
+        (Get_Interface_Declaration_Chain (Subprg));
+
+      --  For vhdl-02, the protected variable is an implicit parameter.
+      if Flags.Vhdl_Std >= Vhdl_02
+        and then Is_Subprogram_Method (Subprg)
+      then
+         Nbr_Interfaces := Nbr_Interfaces + 1;
+      else
+         Is_Method := False;
+      end if;
+
+      case Id is
+         when Name_Abs
+           | Name_Not =>
+            --  LRM93 2.3.1
+            --  The subprogram specification of a unary operator must have a
+            --  single parameter.
+
+            --  LRM02 2.3.1
+            --  ..., unless the subprogram specification is a method (see
+            --  3.5.1) of a protected type.  In this latter case, the
+            --  subprogram specification must have no parameters.
+            if Nbr_Interfaces = 1 then
+               return;
+            end if;
+            Error_Msg_Sem ("unary operator must have a single parameter",
+                           Subprg);
+         when Name_Mod
+           | Name_Rem
+           | Name_Op_Mul
+           | Name_Op_Div
+           | Name_Relational_Operators
+           | Name_Op_Concatenation
+           | Name_Shift_Operators
+           | Name_Op_Exp =>
+            --  LRM93 2.3.1
+            --  The subprogram specification of a binary operator must have
+            --  two parameters.
+
+            --  LRM02 2.3.1
+            --  ..., unless the subprogram specification is a method of a
+            --  protected type, in which case, the subprogram specification
+            --  must have a single parameter.
+            if Nbr_Interfaces = 2 then
+               return;
+            end if;
+            Error_Msg_Sem
+              ("binary operators must have two parameters", Subprg);
+         when Name_Logical_Operators
+           | Name_Xnor =>
+            --  LRM08 4.5.2 Operator overloading
+            --  For each of the "+", "-", "and", "or", "xor", "nand", "nor"
+            --  and "xnor", overloading is allowed both as a unary operator
+            --  and as a binary operator.
+            if Nbr_Interfaces = 2 then
+               return;
+            end if;
+            if Nbr_Interfaces = 1 then
+               if Vhdl_Std >= Vhdl_08 then
+                  return;
+               end if;
+               Error_Msg_Sem
+                 ("logical operators must have two parameters before vhdl08",
+                  Subprg);
+            else
+               Error_Msg_Sem
+                 ("logical operators must have two parameters", Subprg);
+            end if;
+         when Name_Op_Plus
+           | Name_Op_Minus =>
+            --  LRM93 2.3.1
+            --  For each of the operators "+" and "-", overloading is allowed
+            --  both as a unary operator and as a binary operator.
+            if Nbr_Interfaces in 1 .. 2 then
+               return;
+            end if;
+            Error_Msg_Sem
+              ("""+"" and ""-"" operators must have 1 or 2 parameters",
+               Subprg);
+         when others =>
+            return;
+      end case;
+      if Is_Method then
+         Error_Msg_Sem
+           (" (the protected object is an implicit parameter of methods)",
+            Subprg);
+      end if;
+   end Check_Operator_Requirements;
+
+   procedure Compute_Subprogram_Hash (Subprg : Iir)
+   is
+      type Hash_Type is mod 2**32;
+      function To_Hash is new Ada.Unchecked_Conversion
+        (Source => Iir, Target => Hash_Type);
+      function To_Int32 is new Ada.Unchecked_Conversion
+        (Source => Hash_Type, Target => Iir_Int32);
+
+      Kind : Iir_Kind;
+      Hash : Hash_Type;
+      Sig : Hash_Type;
+      Inter : Iir;
+      Itype : Iir;
+   begin
+      Kind := Get_Kind (Subprg);
+      if Kind in Iir_Kinds_Function_Declaration
+        or else Kind = Iir_Kind_Enumeration_Literal
+      then
+         Itype := Get_Base_Type (Get_Return_Type (Subprg));
+         Hash := To_Hash (Itype);
+         Sig := 8;
+      else
+         Sig := 1;
+         Hash := 0;
+      end if;
+
+      if Kind /= Iir_Kind_Enumeration_Literal then
+         Inter := Get_Interface_Declaration_Chain (Subprg);
+         while Inter /= Null_Iir loop
+            Itype := Get_Base_Type (Get_Type (Inter));
+            Sig := Sig + 1;
+            Hash := Hash * 7 + To_Hash (Itype);
+            Hash := Hash + Hash / 2**28;
+            Inter := Get_Chain (Inter);
+         end loop;
+      end if;
+      Set_Subprogram_Hash (Subprg, To_Int32 (Hash + Sig));
+   end Compute_Subprogram_Hash;
+
+   --  LRM 2.1  Subprogram Declarations.
+   procedure Sem_Subprogram_Declaration (Subprg: Iir)
+   is
+      Spec: Iir;
+      Interface_Chain : Iir;
+      Subprg_Body : Iir;
+      Return_Type : Iir;
+   begin
+      --  Set depth.
+      declare
+         Parent : constant Iir := Get_Parent (Subprg);
+      begin
+         case Get_Kind (Parent) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               raise Internal_Error;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               Set_Subprogram_Depth
+                 (Subprg,
+                  Get_Subprogram_Depth
+                  (Get_Subprogram_Specification (Parent)) + 1);
+            when others =>
+               Set_Subprogram_Depth (Subprg, 0);
+         end case;
+      end;
+
+      --  LRM 10.1 Declarative Region
+      --  3. A subprogram declaration, together with the corresponding
+      --     subprogram body.
+      Open_Declarative_Region;
+
+      --  Sem interfaces.
+      Interface_Chain := Get_Interface_Declaration_Chain (Subprg);
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            Sem_Interface_Chain
+              (Interface_Chain, Function_Parameter_Interface_List);
+            Return_Type := Get_Return_Type_Mark (Subprg);
+            Return_Type := Sem_Type_Mark (Return_Type);
+            Set_Return_Type_Mark (Subprg, Return_Type);
+            Set_Return_Type (Subprg, Get_Type (Return_Type));
+            Set_All_Sensitized_State (Subprg, Unknown);
+         when Iir_Kind_Procedure_Declaration =>
+            Sem_Interface_Chain
+              (Interface_Chain, Procedure_Parameter_Interface_List);
+            --  Unless the body is analyzed, the procedure purity is unknown.
+            Set_Purity_State (Subprg, Unknown);
+            --  Check if the procedure is passive.
+            Set_Passive_Flag (Subprg, True);
+            Set_All_Sensitized_State (Subprg, Unknown);
+            declare
+               Inter : Iir;
+            begin
+               Inter := Interface_Chain;
+               while Inter /= Null_Iir loop
+                  if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration
+                    and then Get_Mode (Inter) /= Iir_In_Mode
+                  then
+                     --  There is a driver for this signal interface.
+                     Set_Passive_Flag (Subprg, False);
+                     exit;
+                  end if;
+                  Inter := Get_Chain (Inter);
+               end loop;
+            end;
+         when others =>
+            Error_Kind ("sem_subprogram_declaration", Subprg);
+      end case;
+
+      Check_Operator_Requirements (Get_Identifier (Subprg), Subprg);
+
+      Compute_Subprogram_Hash (Subprg);
+
+      --  The specification has been semantized, close the declarative region
+      --  now.
+      Close_Declarative_Region;
+
+      --  Look if there is an associated body (the next node).
+      Subprg_Body := Get_Chain (Subprg);
+      if Subprg_Body /= Null_Iir
+        and then (Get_Kind (Subprg_Body) = Iir_Kind_Function_Body
+                  or else Get_Kind (Subprg_Body) = Iir_Kind_Procedure_Body)
+      then
+         Spec := Find_Subprogram_Specification (Subprg);
+      else
+         Spec := Null_Iir;
+      end if;
+
+      if Spec /= Null_Iir then
+         -- SUBPRG is the body of the specification SPEC.
+         Check_Conformance_Rules (Subprg, Spec);
+         Xref_Body (Subprg, Spec);
+         Set_Subprogram_Body (Subprg, Subprg_Body);
+         Set_Subprogram_Specification (Subprg_Body, Spec);
+         Set_Subprogram_Body (Spec, Subprg_Body);
+      else
+         --  Forward declaration or specification followed by body.
+         Set_Subprogram_Overload_Number (Subprg);
+         Sem_Scopes.Add_Name (Subprg);
+         Name_Visible (Subprg);
+         Xref_Decl (Subprg);
+      end if;
+   end Sem_Subprogram_Declaration;
+
+   procedure Add_Analysis_Checks_List (El : Iir)
+   is
+      Design : constant Iir := Get_Current_Design_Unit;
+      List : Iir_List;
+   begin
+      List := Get_Analysis_Checks_List (Design);
+      if List = Null_Iir_List then
+         List := Create_Iir_List;
+         Set_Analysis_Checks_List (Design, List);
+      end if;
+      Add_Element (List, El);
+   end Add_Analysis_Checks_List;
+
+   procedure Sem_Subprogram_Body (Subprg : Iir)
+   is
+      Spec : Iir;
+      El : Iir;
+   begin
+      Spec := Get_Subprogram_Specification (Subprg);
+      Set_Impure_Depth (Subprg, Iir_Depth_Pure);
+
+      --  LRM 10.1  Declarative regions
+      --  3.  A subprogram declaration, together with the corresponding
+      --     subprogram body.
+      Open_Declarative_Region;
+      Set_Is_Within_Flag (Spec, True);
+
+      -- Add the interface names into the current declarative region.
+      El := Get_Interface_Declaration_Chain (Spec);
+      while El /= Null_Iir loop
+         Add_Name (El, Get_Identifier (El), False);
+         if Get_Kind (El) = Iir_Kind_Interface_Signal_Declaration then
+            Set_Has_Active_Flag (El, False);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      Sem_Sequential_Statements (Spec, Subprg);
+
+      Set_Is_Within_Flag (Spec, False);
+      Close_Declarative_Region;
+
+      case Get_Kind (Spec) is
+         when Iir_Kind_Procedure_Declaration =>
+            --  Update purity state of procedure if there are no callees.
+            case Get_Purity_State (Spec) is
+               when Pure
+                 | Maybe_Impure =>
+                  --  We can't know this yet.
+                  raise Internal_Error;
+               when Impure =>
+                  null;
+               when Unknown =>
+                  if Get_Callees_List (Subprg) = Null_Iir_List then
+                     --  Since there are no callees, purity state can
+                     --  be updated.
+                     if Get_Impure_Depth (Subprg) = Iir_Depth_Pure then
+                        Set_Purity_State (Spec, Pure);
+                     else
+                        Set_Purity_State (Spec, Maybe_Impure);
+                     end if;
+                  end if;
+            end case;
+
+            --  Update wait state if the state of all callees is known.
+            if Get_Wait_State (Spec) = Unknown then
+               declare
+                  Callees : Iir_List;
+                  Callee : Iir;
+                  State : Tri_State_Type;
+               begin
+                  Callees := Get_Callees_List (Subprg);
+                  --  Per default, has no wait.
+                  Set_Wait_State (Spec, False);
+                  if Callees /= Null_Iir_List then
+                     for I in Natural loop
+                        Callee := Get_Nth_Element (Callees, I);
+                        exit when Callee = Null_Iir;
+                        case Get_Kind (Callee) is
+                           when Iir_Kinds_Function_Declaration =>
+                              null;
+                           when Iir_Kind_Procedure_Declaration =>
+                              State := Get_Wait_State (Callee);
+                              case State is
+                                 when False =>
+                                    null;
+                                 when Unknown =>
+                                    --  Yet unknown, but can be TRUE.
+                                    Set_Wait_State (Spec, Unknown);
+                                 when True =>
+                                    --  Can this happen ?
+                                    raise Internal_Error;
+                                    --Set_Wait_State (Spec, True);
+                                    --exit;
+                              end case;
+                           when Iir_Kind_Implicit_Procedure_Declaration =>
+                              null;
+                           when others =>
+                              Error_Kind ("sem_subprogram_body(2)", Callee);
+                        end case;
+                     end loop;
+                  end if;
+               end;
+            end if;
+
+            --  Set All_Sensitized_State in trivial cases.
+            if Get_All_Sensitized_State (Spec) = Unknown
+              and then Get_Callees_List (Subprg) = Null_Iir_List
+            then
+               Set_All_Sensitized_State (Spec, No_Signal);
+            end if;
+
+            --  Do not add to Analysis_Check_List as procedures can't
+            --  generate purity/wait/all-sensitized errors by themselves.
+
+         when Iir_Kind_Function_Declaration =>
+            if Get_Callees_List (Subprg) /= Null_Iir_List then
+               --  Purity calls to be checked later.
+               --  No wait statements in procedures called.
+               Add_Analysis_Checks_List (Spec);
+            end if;
+         when others =>
+            Error_Kind ("sem_subprogram_body", Spec);
+      end case;
+   end Sem_Subprogram_Body;
+
+   --  Status of Update_And_Check_Pure_Wait.
+   type Update_Pure_Status is
+     (
+      --  The purity/wait/all-sensitized are computed and known.
+      Update_Pure_Done,
+      --  A missing body prevents from computing the purity/wait/all-sensitized
+      Update_Pure_Missing,
+      --  Purity/wait/all-sensitized is unknown (recursion).
+      Update_Pure_Unknown
+     );
+
+   function Update_And_Check_Pure_Wait (Subprg : Iir) return Update_Pure_Status
+   is
+      procedure Error_Wait (Caller : Iir; Callee : Iir) is
+      begin
+         Error_Msg_Sem
+           (Disp_Node (Caller) & " must not contain wait statement, but calls",
+            Caller);
+         Error_Msg_Sem
+           (Disp_Node (Callee) & " which has (indirectly) a wait statement",
+            Callee);
+      end Error_Wait;
+
+      --  Kind of subprg.
+      type Caller_Kind is (K_Function, K_Process, K_Procedure);
+      Kind : Caller_Kind;
+
+      Callees_List : Iir_List;
+      Callees_List_Holder : Iir;
+      Callee : Iir;
+      Callee_Orig : Iir;
+      Callee_Bod : Iir;
+      Subprg_Depth : Iir_Int32;
+      Subprg_Bod : Iir;
+      --  Current purity depth of SUBPRG.
+      Depth : Iir_Int32;
+      Depth_Callee : Iir_Int32;
+      Has_Wait_Errors : Boolean := False;
+      Npos : Natural;
+      Res, Res1 : Update_Pure_Status;
+   begin
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            Kind := K_Function;
+            Subprg_Bod := Get_Subprogram_Body (Subprg);
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            Callees_List_Holder := Subprg_Bod;
+            if Get_Pure_Flag (Subprg) then
+               Depth := Iir_Depth_Pure;
+            else
+               Depth := Iir_Depth_Impure;
+            end if;
+
+         when Iir_Kind_Procedure_Declaration =>
+            Kind := K_Procedure;
+            Subprg_Bod := Get_Subprogram_Body (Subprg);
+            if Get_Purity_State (Subprg) = Impure
+              and then Get_Wait_State (Subprg) /= Unknown
+              and then Get_All_Sensitized_State (Subprg) /= Unknown
+            then
+               --  No need to go further.
+               if Get_All_Sensitized_State (Subprg) = No_Signal
+                 or else Vhdl_Std < Vhdl_08
+               then
+                  Callees_List := Get_Callees_List (Subprg_Bod);
+                  Destroy_Iir_List (Callees_List);
+                  Set_Callees_List (Subprg_Bod, Null_Iir_List);
+               end if;
+               return Update_Pure_Done;
+            end if;
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            Depth := Get_Impure_Depth (Subprg_Bod);
+            Callees_List_Holder := Subprg_Bod;
+
+         when Iir_Kind_Sensitized_Process_Statement =>
+            Kind := K_Process;
+            Subprg_Bod := Null_Iir;
+            Subprg_Depth := Iir_Depth_Top;
+            Depth := Iir_Depth_Impure;
+            Callees_List_Holder := Subprg;
+
+         when others =>
+            Error_Kind ("update_and_check_pure_wait(1)", Subprg);
+      end case;
+
+      --  If the subprogram has no callee list, there is nothing to do.
+      Callees_List := Get_Callees_List (Callees_List_Holder);
+      if Callees_List = Null_Iir_List then
+         --  There are two reasons why a callees_list is null:
+         --  * either because SUBPRG does not call any procedure
+         --    in this case, the status are already known and we should have
+         --    returned in the above case.
+         --  * or because of a recursion
+         --    in this case the status are still unknown here.
+         return Update_Pure_Unknown;
+      end if;
+
+      --  By default we don't know the status.
+      Res := Update_Pure_Unknown;
+
+      --  This subprogram is being considered.
+      --  To avoid infinite loop, suppress its callees list.
+      Set_Callees_List (Callees_List_Holder, Null_Iir_List);
+
+      --  First loop: check without recursion.
+      --  Second loop: recurse if necessary.
+      for J in 0 .. 1 loop
+         Npos := 0;
+         for I in Natural loop
+            Callee := Get_Nth_Element (Callees_List, I);
+            exit when Callee = Null_Iir;
+
+            --  Note:
+            --  Pure functions should not be in the list.
+            --  Impure functions must have directly set Purity_State.
+
+            --  Check pure.
+            Callee_Bod := Get_Subprogram_Body (Callee);
+
+            if Callee_Bod = Null_Iir then
+               --  The body of subprograms may not be set for instances.
+               --  Use the body from the generic (if any).
+               Callee_Orig := Sem_Inst.Get_Origin (Callee);
+               if Callee_Orig /= Null_Iir then
+                  Callee_Bod := Get_Subprogram_Body (Callee_Orig);
+                  Set_Subprogram_Body (Callee, Callee_Bod);
+               end if;
+            end if;
+
+            if Callee_Bod = Null_Iir then
+               --  No body yet for the subprogram called.
+               --  Nothing can be extracted from it, postpone the checks until
+               --  elaboration.
+               Res := Update_Pure_Missing;
+            else
+               --  Second loop: recurse if a state is not known.
+               if J = 1
+                 and then
+                 ((Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
+                     and then Get_Purity_State (Callee) = Unknown)
+                  or else Get_Wait_State (Callee) = Unknown
+                  or else Get_All_Sensitized_State (Callee) = Unknown)
+               then
+                  Res1 := Update_And_Check_Pure_Wait (Callee);
+                  if Res1 = Update_Pure_Missing then
+                     Res := Update_Pure_Missing;
+                  end if;
+               end if;
+
+               --  Check purity only if the subprogram is not impure.
+               if Depth /= Iir_Depth_Impure then
+                  Depth_Callee := Get_Impure_Depth (Callee_Bod);
+
+                  --  Check purity depth.
+                  if Depth_Callee < Subprg_Depth then
+                     --  The call is an impure call because it calls an outer
+                     --   subprogram (or an impure subprogram).
+                     --  FIXME: check the compare.
+                     Depth_Callee := Iir_Depth_Impure;
+                     if Kind = K_Function then
+                        --  FIXME: report call location
+                        Error_Pure (Subprg_Bod, Callee, Null_Iir);
+                     end if;
+                  end if;
+
+                  --  Update purity depth.
+                  if Depth_Callee < Depth then
+                     Depth := Depth_Callee;
+                     if Kind = K_Procedure then
+                        --  Update for recursivity.
+                        Set_Impure_Depth (Subprg_Bod, Depth);
+                        if Depth = Iir_Depth_Impure then
+                           Set_Purity_State (Subprg, Impure);
+                        end if;
+                     end if;
+                  end if;
+               end if;
+            end if;
+
+            --  Check wait.
+            if Has_Wait_Errors = False
+              and then Get_Wait_State (Callee) = True
+            then
+               if Kind = K_Procedure then
+                  Set_Wait_State (Subprg, True);
+               else
+                  Error_Wait (Subprg, Callee);
+                  Has_Wait_Errors := True;
+               end if;
+            end if;
+
+            if Get_All_Sensitized_State (Callee) = Invalid_Signal then
+               case Kind is
+                  when K_Function | K_Procedure =>
+                     Set_All_Sensitized_State (Subprg, Invalid_Signal);
+                  when K_Process =>
+                     --  LRM08 11.3
+                     --
+                     --  It is an error if a process statement with the
+                     --  reserved word ALL as its process sensitivity list
+                     --  is the parent of a subprogram declared in a design
+                     --  unit other than that containing the process statement
+                     --  and the subprogram reads an explicitly declared
+                     --  signal that is not a formal signal parameter or
+                     --  member of a formal signal parameter of the
+                     --  subprogram or of any of its parents.  Similarly,
+                     --  it is an error if such subprogram reads an implicit
+                     --  signal whose explicit ancestor is not a formal signal
+                     --  parameter or member of a formal parameter of
+                     --  the subprogram or of any of its parents.
+                     Error_Msg_Sem
+                       ("all-sensitized " & Disp_Node (Subprg)
+                          & " can't call " & Disp_Node (Callee), Subprg);
+                     Error_Msg_Sem
+                       (" (as this subprogram reads (indirectly) a signal)",
+                        Subprg);
+               end case;
+            end if;
+
+            --  Keep in list.
+            if Callee_Bod = Null_Iir
+              or else
+              (Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
+                 and then Get_Purity_State (Callee) = Unknown
+                 and then Depth /= Iir_Depth_Impure)
+              or else
+              (Get_Wait_State (Callee) = Unknown
+                 and then (Kind /= K_Procedure
+                             or else Get_Wait_State (Subprg) = Unknown))
+              or else
+              (Vhdl_Std >= Vhdl_08
+                 and then
+                 (Get_All_Sensitized_State (Callee) = Unknown
+                    or else Get_All_Sensitized_State (Callee) = Read_Signal))
+            then
+               Replace_Nth_Element (Callees_List, Npos, Callee);
+               Npos := Npos + 1;
+            end if;
+         end loop;
+
+         --  End of callee loop.
+         if Npos = 0 then
+            Destroy_Iir_List (Callees_List);
+            Callees_List := Null_Iir_List;
+            if Kind = K_Procedure then
+               if Get_Purity_State (Subprg) = Unknown then
+                  Set_Purity_State (Subprg, Maybe_Impure);
+               end if;
+               if Get_Wait_State (Subprg) = Unknown then
+                  Set_Wait_State (Subprg, False);
+               end if;
+            end if;
+            if Kind = K_Procedure or Kind = K_Function then
+               if Get_All_Sensitized_State (Subprg) = Unknown then
+                  Set_All_Sensitized_State (Subprg, No_Signal);
+               end if;
+            end if;
+            Res := Update_Pure_Done;
+            exit;
+         else
+            Set_Nbr_Elements (Callees_List, Npos);
+         end if;
+      end loop;
+
+      Set_Callees_List (Callees_List_Holder, Callees_List);
+
+      return Res;
+   end Update_And_Check_Pure_Wait;
+
+   --  Check pure/wait/all-sensitized issues for SUBPRG (subprogram or
+   --  process).  Return False if the analysis is incomplete (and must
+   --  be deferred).
+   function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean
+   is
+      Res : Update_Pure_Status;
+   begin
+      Res := Update_And_Check_Pure_Wait (Subprg);
+      case Res is
+         when Update_Pure_Done =>
+            return True;
+         when Update_Pure_Missing =>
+            return False;
+         when Update_Pure_Unknown =>
+            --  The purity/wait is unknown, but all callee were walked.
+            --  This means there are recursive calls but without violations.
+            if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+               if Get_Purity_State (Subprg) = Unknown then
+                  Set_Purity_State (Subprg, Maybe_Impure);
+               end if;
+               if Get_Wait_State (Subprg) = Unknown then
+                  Set_Wait_State (Subprg, False);
+               end if;
+            end if;
+            if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
+               if Get_All_Sensitized_State (Subprg) = Unknown then
+                  Set_All_Sensitized_State (Subprg, No_Signal);
+               end if;
+            end if;
+            return True;
+      end case;
+   end Root_Update_And_Check_Pure_Wait;
+
+   procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
+                                       Emit_Warnings : Boolean)
+   is
+      List : Iir_List := Get_Analysis_Checks_List (Unit);
+      El : Iir;
+      Npos : Natural;
+      Keep : Boolean;
+      Callees : Iir_List;
+      Callee : Iir;
+   begin
+      if List = Null_Iir_List then
+         --  Return now if there is nothing to check.
+         return;
+      end if;
+
+      Npos := 0;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Keep := False;
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Declaration =>
+               --  FIXME: remove from list if fully tested ?
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
+                  if Emit_Warnings then
+                     Callees := Get_Callees_List (El);
+                     pragma Assert (Callees /= Null_Iir_List);
+                     Warning_Msg_Sem
+                       ("can't assert that all calls in " & Disp_Node (El)
+                        & " are pure or have not wait; "
+                        & "will be checked at elaboration", El);
+                     Callee := Get_Nth_Element (Callees, 0);
+                     --  FIXME: could improve this message by displaying the
+                     --  chain of calls until the first subprograms in
+                     --  unknown state.
+                     Warning_Msg_Sem
+                       ("(first such call is to " & Disp_Node (Callee) & ")",
+                        Callee);
+                  end if;
+               end if;
+            when Iir_Kind_Sensitized_Process_Statement =>
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
+                  if Emit_Warnings then
+                     Warning_Msg_Sem
+                       ("can't assert that " & Disp_Node (El)
+                        & " has not wait; will be checked at elaboration", El);
+                  end if;
+               end if;
+            when others =>
+               Error_Kind ("sem_analysis_checks_list", El);
+         end case;
+         if Keep then
+            Replace_Nth_Element (List, Npos, El);
+            Npos := Npos + 1;
+         end if;
+      end loop;
+      if Npos = 0 then
+         Destroy_Iir_List (List);
+         Set_Analysis_Checks_List (Unit, Null_Iir_List);
+      else
+         Set_Nbr_Elements (List, Npos);
+      end if;
+   end Sem_Analysis_Checks_List;
+
+   -- Return true if package declaration DECL needs a body.
+   -- Ie, it contains subprogram specification or deferred constants.
+   function Package_Need_Body_P (Decl: Iir_Package_Declaration)
+     return Boolean
+   is
+      El: Iir;
+      Def : Iir;
+   begin
+      El := Get_Declaration_Chain (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               return True;
+            when Iir_Kind_Constant_Declaration =>
+               if Get_Default_Value (El) = Null_Iir then
+                  return True;
+               end if;
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Object_Alias_Declaration
+              | Iir_Kind_Non_Object_Alias_Declaration
+              | Iir_Kind_Group_Template_Declaration
+              | Iir_Kind_Group_Declaration =>
+               null;
+            when Iir_Kind_Type_Declaration =>
+               Def := Get_Type_Definition (El);
+               if Def /= Null_Iir
+                 and then Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
+               then
+                  return True;
+               end if;
+            when Iir_Kind_Anonymous_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               null;
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               null;
+            when Iir_Kind_Attribute_Declaration
+              | Iir_Kind_Attribute_Specification =>
+               null;
+            when Iir_Kind_Disconnection_Specification =>
+               null;
+            when Iir_Kind_Use_Clause =>
+               null;
+            when Iir_Kind_Component_Declaration =>
+               null;
+            when Iir_Kind_Protected_Type_Body =>
+               null;
+            when Iir_Kind_Nature_Declaration
+              | Iir_Kind_Subnature_Declaration =>
+               null;
+            when Iir_Kind_Terminal_Declaration =>
+               null;
+            when others =>
+               Error_Kind ("package_need_body_p", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      return False;
+   end Package_Need_Body_P;
+
+   --  LRM 2.5  Package Declarations.
+   procedure Sem_Package_Declaration (Decl: Iir_Package_Declaration)
+   is
+      Unit : Iir_Design_Unit;
+      Implicit : Implicit_Signal_Declaration_Type;
+      Header : constant Iir := Get_Package_Header (Decl);
+   begin
+      Unit := Get_Design_Unit (Decl);
+      Sem_Scopes.Add_Name (Decl);
+      Set_Visible_Flag (Decl, True);
+      Xref_Decl (Decl);
+
+      --  Identify IEEE.Std_Logic_1164 for VHDL08.
+      if Get_Identifier (Decl) = Std_Names.Name_Std_Logic_1164
+        and then (Get_Identifier (Get_Library (Get_Design_File (Unit)))
+                    = Std_Names.Name_Ieee)
+      then
+         Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Decl;
+      end if;
+
+      --  LRM93 10.1 Declarative Region
+      --  4. A package declaration, together with the corresponding
+      --     body (if any).
+      Open_Declarative_Region;
+
+      Push_Signals_Declarative_Part (Implicit, Decl);
+
+      if Header /= Null_Iir then
+         Sem_Interface_Chain
+           (Get_Generic_Chain (Header), Generic_Interface_List);
+         if Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir then
+            --  FIXME: todo
+            raise Internal_Error;
+         end if;
+      end if;
+
+      Sem_Declaration_Chain (Decl);
+      --  GHDL: subprogram bodies appear in package body.
+
+      Pop_Signals_Declarative_Part (Implicit);
+      Close_Declarative_Region;
+      Set_Need_Body (Decl, Package_Need_Body_P (Decl));
+   end Sem_Package_Declaration;
+
+   --  LRM 2.6  Package Bodies.
+   procedure Sem_Package_Body (Decl: Iir)
+   is
+      Package_Ident: Name_Id;
+      Design_Unit: Iir_Design_Unit;
+      Package_Decl: Iir;
+   begin
+      -- First, find the package declaration.
+      Package_Ident := Get_Identifier (Decl);
+      Design_Unit := Libraries.Load_Primary_Unit
+        (Get_Library (Get_Design_File (Get_Current_Design_Unit)),
+         Package_Ident, Decl);
+      if Design_Unit = Null_Iir then
+         Error_Msg_Sem ("package '" & Name_Table.Image (Package_Ident)
+                        & "' was not analysed",
+                        Decl);
+         return;
+      end if;
+      Package_Decl := Get_Library_Unit (Design_Unit);
+      if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
+         Error_Msg_Sem
+           ("primary unit '" & Name_Table.Image (Package_Ident)
+            & "' is not a package", Decl);
+         return;
+      end if;
+
+      --  Emit a warning is a body is not necessary.
+      if not Get_Need_Body (Package_Decl) then
+         Warning_Msg_Sem
+           (Disp_Node (Package_Decl) & " does not require a body", Decl);
+      end if;
+
+      Set_Package (Decl, Package_Decl);
+      Xref_Body (Decl, Package_Decl);
+      Set_Package_Body (Package_Decl, Decl);
+      Add_Dependence (Design_Unit);
+
+      Add_Name (Design_Unit);
+
+      --  Add the context clauses from the primary unit.
+      Add_Context_Clauses (Design_Unit);
+
+      --  LRM93 10.1 Declarative Region
+      --  4. A package declaration, together with the corresponding
+      --     body (if any).
+      Open_Declarative_Region;
+
+      Sem_Scopes.Add_Package_Declarations (Package_Decl);
+
+      Sem_Declaration_Chain (Decl);
+      Check_Full_Declaration (Decl, Decl);
+      Check_Full_Declaration (Package_Decl, Decl);
+
+      Close_Declarative_Region;
+   end Sem_Package_Body;
+
+   function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir
+   is
+      Name : Iir;
+      Pkg : Iir;
+   begin
+      Name := Sem_Denoting_Name (Get_Uninstantiated_Package_Name (Decl));
+      Set_Uninstantiated_Package_Name (Decl, Name);
+      Pkg := Get_Named_Entity (Name);
+      if Get_Kind (Pkg) /= Iir_Kind_Package_Declaration then
+         Error_Class_Match (Name, "package");
+
+         --  What could be done ?
+         return Null_Iir;
+      elsif not Is_Uninstantiated_Package (Pkg) then
+         Error_Msg_Sem
+           (Disp_Node (Pkg) & " is not an uninstantiated package", Name);
+
+         --  What could be done ?
+         return Null_Iir;
+      end if;
+
+      return Pkg;
+   end Sem_Uninstantiated_Package_Name;
+
+   --  LRM08 4.9  Package Instantiation Declaration
+   procedure Sem_Package_Instantiation_Declaration (Decl : Iir)
+   is
+      Hdr : Iir;
+      Pkg : Iir;
+      Bod : Iir_Design_Unit;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Set_Visible_Flag (Decl, True);
+      Xref_Decl (Decl);
+
+      --  LRM08 4.9
+      --  The uninstantiated package name shall denote an uninstantiated
+      --  package declared in a package declaration.
+      Pkg := Sem_Uninstantiated_Package_Name (Decl);
+      if Pkg = Null_Iir then
+         --  What could be done ?
+         return;
+      end if;
+
+      --  LRM08 4.9
+      --  The generic map aspect, if present, optionally associates a single
+      --  actual with each formal generic (or member thereof) in the
+      --  corresponding package declaration.  Each formal generic (or member
+      --  thereof) shall be associated at most once.
+
+      --  GHDL: the generics are first instantiated (ie copied) and then
+      --  the actuals are associated with the instantiated formal.
+      --  FIXME: do it in Instantiate_Package_Declaration ?
+      Hdr := Get_Package_Header (Pkg);
+      if Sem_Generic_Association_Chain (Hdr, Decl) then
+         Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg);
+      else
+         --  FIXME: stop analysis here ?
+         null;
+      end if;
+
+      --  FIXME: unless the parent is a package declaration library unit, the
+      --  design unit depends on the body.
+      Bod := Libraries.Load_Secondary_Unit
+        (Get_Design_Unit (Pkg), Null_Identifier, Decl);
+      if Bod /= Null_Iir then
+         Add_Dependence (Bod);
+      end if;
+   end Sem_Package_Instantiation_Declaration;
+
+   --  LRM 10.4  Use Clauses.
+   procedure Sem_Use_Clause (Clauses: Iir_Use_Clause)
+   is
+      Clause : Iir_Use_Clause;
+      Name: Iir;
+      Prefix: Iir;
+      Name_Prefix : Iir;
+   begin
+      Clause := Clauses;
+      loop
+         --  LRM93 10.4
+         --  A use clause achieves direct visibility of declarations that are
+         --  visible by selection.
+         --  Each selected name is a use clause identifies one or more
+         --  declarations that will potentialy become directly visible.
+
+         Name := Get_Selected_Name (Clause);
+         case Get_Kind (Name) is
+            when Iir_Kind_Selected_By_All_Name
+              | Iir_Kind_Selected_Name =>
+               Name_Prefix := Get_Prefix (Name);
+            when others =>
+               Error_Msg_Sem ("use clause allows only selected name", Name);
+               return;
+         end case;
+
+         Name_Prefix := Sem_Denoting_Name (Name_Prefix);
+         Set_Prefix (Name, Name_Prefix);
+         Prefix := Get_Named_Entity (Name_Prefix);
+         if Is_Error (Prefix) then
+            --  FIXME: continue with the clauses
+            return;
+         end if;
+
+         --  LRM 10.4 Use Clauses
+         --
+         --  If the suffix of the selected name is [...], then the
+         --  selected name identifies only the declaration(s) of that
+         --  [...] contained within the package or library denoted by
+         --  the prefix of the selected name.
+         --
+         --  If the suffix is the reserved word ALL, then the selected name
+         --  identifies all declarations that are contained within the package
+         --  or library denoted by the prefix of the selected name.
+         --
+         --  GHDL: therefore, the suffix must be either a package or a library.
+         case Get_Kind (Prefix) is
+            when Iir_Kind_Library_Declaration =>
+               null;
+            when Iir_Kind_Package_Instantiation_Declaration
+              | Iir_Kind_Interface_Package_Declaration =>
+               null;
+            when Iir_Kind_Package_Declaration =>
+               --  LRM08 12.4 Use clauses
+               --  It is an error if the prefix of a selected name in a use
+               --  clause denotes an uninstantiated package.
+               if Is_Uninstantiated_Package (Prefix) then
+                  Error_Msg_Sem
+                    ("use of uninstantiated package is not allowed",
+                     Name_Prefix);
+                  return;
+               end if;
+            when others =>
+               Error_Msg_Sem
+                 ("prefix must designate a package or a library", Prefix);
+               return;
+         end case;
+
+         case Get_Kind (Name) is
+            when Iir_Kind_Selected_Name =>
+               Sem_Name (Name);
+               case Get_Kind (Get_Named_Entity (Name)) is
+                  when Iir_Kind_Error =>
+                     --  Continue in case of error.
+                     null;
+                  when Iir_Kind_Overload_List =>
+                     --  Analyze is correct as is.
+                     null;
+                  when others =>
+                     Name := Finish_Sem_Name (Name);
+                     Set_Selected_Name (Clause, Name);
+               end case;
+            when Iir_Kind_Selected_By_All_Name =>
+               null;
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         Clause := Get_Use_Clause_Chain (Clause);
+         exit when Clause = Null_Iir;
+      end loop;
+
+      --  LRM 10.4
+      --  For each use clause, there is a certain region of text called the
+      --  scope of the use clause.  This region starts immediatly after the
+      --  use clause.
+      Sem_Scopes.Add_Use_Clause (Clauses);
+   end Sem_Use_Clause;
+
+   --  LRM 11.2  Design Libraries.
+   procedure Sem_Library_Clause (Decl: Iir_Library_Clause)
+   is
+      Ident : Name_Id;
+      Lib: Iir;
+   begin
+      --  GHDL: 'redeclaration' is handled in sem_scopes.
+
+      Ident := Get_Identifier (Decl);
+      Lib := Libraries.Get_Library (Ident, Get_Location (Decl));
+      if Lib = Null_Iir then
+         Error_Msg_Sem
+           ("no resource library """ & Name_Table.Image (Ident) & """", Decl);
+      else
+         Set_Library_Declaration (Decl, Lib);
+         Sem_Scopes.Add_Name (Lib, Ident, False);
+         Set_Visible_Flag (Lib, True);
+         Xref_Ref (Decl, Lib);
+      end if;
+   end Sem_Library_Clause;
+
+   --  LRM 11.3  Context Clauses.
+   procedure Sem_Context_Clauses (Design_Unit: Iir_Design_Unit)
+   is
+      El: Iir;
+   begin
+      El := Get_Context_Items (Design_Unit);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Use_Clause =>
+               Sem_Use_Clause (El);
+            when Iir_Kind_Library_Clause =>
+               Sem_Library_Clause (El);
+            when others =>
+               Error_Kind ("sem_context_clauses", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Sem_Context_Clauses;
+
+   -- Access to the current design unit.  This is set, saved, restored, cleared
+   -- by the procedure semantic.
+   Current_Design_Unit: Iir_Design_Unit := Null_Iir;
+
+   function Get_Current_Design_Unit return Iir_Design_Unit is
+   begin
+      return Current_Design_Unit;
+   end Get_Current_Design_Unit;
+
+   --  LRM 11.1  Design units.
+   procedure Semantic (Design_Unit: Iir_Design_Unit)
+   is
+      El: Iir;
+      Old_Design_Unit: Iir_Design_Unit;
+      Implicit : Implicit_Signal_Declaration_Type;
+   begin
+      --  Sanity check: can analyze either previously analyzed unit or just
+      --  parsed unit.
+      case Get_Date (Design_Unit) is
+         when Date_Parsed =>
+            Set_Date (Design_Unit, Date_Analyzing);
+         when Date_Valid =>
+            null;
+         when Date_Obsolete =>
+            --  This happens only when design files are added into the library
+            --  and keeping obsolete units (eg: to pretty print a file).
+            Set_Date (Design_Unit, Date_Analyzing);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      -- Save and set current_design_unit.
+      Old_Design_Unit := Current_Design_Unit;
+      Current_Design_Unit := Design_Unit;
+      Push_Signals_Declarative_Part (Implicit, Null_Iir);
+
+      --  Be sure the name table is empty.
+      --  It is empty at start-up, or saved before recursing.
+      pragma Debug (Name_Table.Assert_No_Infos);
+
+      --  LRM02 10.1 Declarative Region.
+      --  In addition to the above declarative region, there is a root
+      --  declarative region, not associated with a portion of the text of the
+      --  description, but encompassing any given primary unit.  At the
+      --  beginning of the analysis of a given primary unit, there are no
+      --  declarations whose scopes (see 10.2) are within the root declarative
+      --  region.  Moreover, the root declarative region associated with any
+      --  given secondary unit is the root declarative region of the
+      --  corresponding primary unit.
+      --  GHDL: for any revision of VHDL, a root declarative region is created,
+      --    due to reasons given by LCS 3 (VHDL Issue # 1028).
+      Open_Declarative_Region;
+
+      -- Set_Dependence_List (Design_Unit,
+--                            Create_Iir (Iir_Kind_Design_Unit_List));
+
+      --  LRM 11.2
+      --  Every design unit is assumed to contain the following implicit
+      --  context items as part of its context clause:
+      --    library STD, WORK; use STD.STANDARD.all;
+      Sem_Scopes.Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False);
+      Sem_Scopes.Add_Name (Get_Library (Get_Design_File (Design_Unit)),
+                           Std_Names.Name_Work,
+                           False);
+      Sem_Scopes.Use_All_Names (Standard_Package);
+      if Get_Dependence_List (Design_Unit) = Null_Iir_List then
+         Set_Dependence_List (Design_Unit, Create_Iir_List);
+      end if;
+      Add_Dependence (Std_Standard_Unit);
+
+      -- Semantic on context clauses.
+      Sem_Context_Clauses (Design_Unit);
+
+      -- semantic on the library unit.
+      El := Get_Library_Unit (Design_Unit);
+      case Get_Kind (El) is
+         when Iir_Kind_Entity_Declaration =>
+            Sem_Entity_Declaration (El);
+         when Iir_Kind_Architecture_Body =>
+            Sem_Architecture_Body (El);
+         when Iir_Kind_Package_Declaration =>
+            Sem_Package_Declaration (El);
+         when Iir_Kind_Package_Body =>
+            Sem_Package_Body (El);
+         when Iir_Kind_Configuration_Declaration =>
+            Sem_Configuration_Declaration (El);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Sem_Package_Instantiation_Declaration (El);
+         when others =>
+            Error_Kind ("semantic", El);
+      end case;
+
+      Close_Declarative_Region;
+
+      if Get_Date (Design_Unit) = Date_Analyzing then
+         Set_Date (Design_Unit, Date_Analyzed);
+      end if;
+
+      if Get_Analysis_Checks_List (Design_Unit) /= Null_Iir_List then
+         Sem_Analysis_Checks_List (Design_Unit, False);
+      end if;
+
+      -- Restore current_design_unit.
+      Current_Design_Unit := Old_Design_Unit;
+      Pop_Signals_Declarative_Part (Implicit);
+   end Semantic;
+end Sem;
diff --git a/src/sem.ads b/src/sem.ads
new file mode 100644
index 000000000..5586483a1
--- /dev/null
+++ b/src/sem.ads
@@ -0,0 +1,82 @@
+--  Semantic analysis pass.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+with Types; use Types;
+
+package Sem is
+   --  Semantic analysis for chapters 1, 2, 10 (uses clauses) and 11.
+
+   -- Do the semantic analysis of design unit DESIGN_UNIT.
+   -- Also add a few node or change some nodes, when for exemple an
+   -- identifier is changed into an access to the type.
+   procedure Semantic (Design_Unit: Iir_Design_Unit);
+
+   -- Get the current design unit, ie, the parameter of the procedure semantic.
+   function Get_Current_Design_Unit return Iir_Design_Unit;
+
+   --  Makes the current design unit depends on UNIT.
+   --  UNIT must be either an entity_aspect or a design_unit.
+   procedure Add_Dependence (Unit : Iir);
+
+   --  Add EL in the current design unit list of items to be checked later.
+   procedure Add_Analysis_Checks_List (El : Iir);
+
+   --  INTER_PARENT contains generics and ports interfaces;
+   --  ASSOC_PARENT constains generics and ports map aspects.
+   procedure Sem_Generic_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir);
+
+   --  Return TRUE iff the actual of ASSOC can be the formal FORMAL.
+   --  ASSOC must be an association_element_by_expression.
+   function Can_Collapse_Signals (Assoc : Iir; Formal : Iir) return Boolean;
+
+   --  Return TRUE iff LEFT and RIGHT are (in depth) equal.
+   --  This corresponds to conformance rules, LRM 2.7
+   function Are_Trees_Equal (Left, Right : Iir) return Boolean;
+
+   --  Check requirements on number of interfaces for subprogram specification
+   --  SUBPRG for a symbol operator ID.  Requirements only concern operators,
+   --  and are defined in LRM 2.3.1.
+   --  If ID is not an operator name, this subprogram does no checks.
+   --  ID might be different from the identifier of SUBPRG when non object
+   --  aliases are checked.
+   procedure Check_Operator_Requirements (Id : Name_Id; Subprg : Iir);
+
+   --  Semantize an use clause.
+   --  This may adds use clauses to the chain.
+   procedure Sem_Use_Clause (Clauses : Iir_Use_Clause);
+
+   --  Compute and set the hash profile of a subprogram or enumeration clause.
+   procedure Compute_Subprogram_Hash (Subprg : Iir);
+
+   --  LRM 2.1  Subprogram Declarations.
+   procedure Sem_Subprogram_Declaration (Subprg: Iir);
+
+   --  LRM 2.2  Subprogram Bodies.
+   procedure Sem_Subprogram_Body (Subprg: Iir);
+
+   --  Do late analysis checks (pure rules).
+   procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
+                                       Emit_Warnings : Boolean);
+
+   --  Analyze the uninstantiated package name of DECL, and return the
+   --  package declaration.  Return Null_Iir if the name doesn't denote an
+   --  uninstantiated package.
+   function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir;
+
+end Sem;
diff --git a/src/sem_assocs.adb b/src/sem_assocs.adb
new file mode 100644
index 000000000..96e660875
--- /dev/null
+++ b/src/sem_assocs.adb
@@ -0,0 +1,1903 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Evaluation; use Evaluation;
+with Errorout; use Errorout;
+with Flags; use Flags;
+with Types; use Types;
+with Iirs_Utils; use Iirs_Utils;
+with Sem_Names; use Sem_Names;
+with Sem_Expr; use Sem_Expr;
+with Iir_Chains; use Iir_Chains;
+with Xrefs;
+
+package body Sem_Assocs is
+   function Rewrite_Non_Object_Association (Assoc : Iir; Inter : Iir)
+                                           return Iir
+   is
+      N_Assoc : Iir;
+   begin
+      case Get_Kind (Inter) is
+         when Iir_Kind_Interface_Package_Declaration =>
+            N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package);
+         when others =>
+            Error_Kind ("rewrite_non_object_association", Inter);
+      end case;
+      Location_Copy (N_Assoc, Assoc);
+      Set_Formal (N_Assoc, Get_Formal (Assoc));
+      Set_Actual (N_Assoc, Get_Actual (Assoc));
+      Set_Chain (N_Assoc, Get_Chain (Assoc));
+      Set_Associated_Interface (N_Assoc, Inter);
+      Set_Whole_Association_Flag (N_Assoc, True);
+      Free_Iir (Assoc);
+      return N_Assoc;
+   end Rewrite_Non_Object_Association;
+
+   function Extract_Non_Object_Association
+     (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir
+   is
+      Inter : Iir;
+      Assoc : Iir;
+      --  N_Assoc : Iir;
+      Prev_Assoc : Iir;
+      Formal : Iir;
+      Res : Iir;
+   begin
+      Inter := Inter_Chain;
+      Assoc := Assoc_Chain;
+      Prev_Assoc := Null_Iir;
+      Res := Null_Iir;
+
+      --  Common case: only objects in interfaces.
+      while Inter /= Null_Iir loop
+         exit when Get_Kind (Inter)
+           not in Iir_Kinds_Interface_Object_Declaration;
+         Inter := Get_Chain (Inter);
+      end loop;
+      if Inter = Null_Iir then
+         return Assoc_Chain;
+      end if;
+
+      loop
+         --  Don't try to detect errors.
+         if Assoc = Null_Iir then
+            return Res;
+         end if;
+
+         Formal := Get_Formal (Assoc);
+         if Formal = Null_Iir then
+            --  Positional association.
+
+            if Inter = Null_Iir then
+               --  But after a named one.  Be silent on that error.
+               null;
+            elsif Get_Kind (Inter)
+              not in Iir_Kinds_Interface_Object_Declaration
+            then
+               Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
+            end if;
+         else
+            if Get_Kind (Formal) = Iir_Kind_Simple_Name then
+               --  A candidate.  Search the corresponding interface.
+               Inter := Find_Name_In_Chain
+                 (Inter_Chain, Get_Identifier (Formal));
+               if Inter /= Null_Iir
+                 and then
+                 Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration
+               then
+                  Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
+               end if;
+            end if;
+
+            --  No more association by position.
+            Inter := Null_Iir;
+         end if;
+
+         if Prev_Assoc = Null_Iir then
+            Res := Assoc;
+         else
+            Set_Chain (Prev_Assoc, Assoc);
+         end if;
+         Prev_Assoc := Assoc;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Extract_Non_Object_Association;
+
+   --  Semantize all arguments of ASSOC_CHAIN
+   --  Return TRUE if no error.
+   function Sem_Actual_Of_Association_Chain (Assoc_Chain : Iir)
+     return Boolean
+   is
+      Has_Named : Boolean;
+      Ok : Boolean;
+      Assoc : Iir;
+      Res : Iir;
+      Formal : Iir;
+   begin
+      -- Semantize all arguments
+      -- OK is false if there is an error during semantic of one of the
+      -- argument, but continue semantisation.
+      Has_Named := False;
+      Ok := True;
+      Assoc := Assoc_Chain;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         if Formal /= Null_Iir then
+            Has_Named := True;
+            --  FIXME: check FORMAL is well composed.
+         elsif Has_Named then
+            --  FIXME: do the check in parser.
+            Error_Msg_Sem ("positional argument after named argument", Assoc);
+            Ok := False;
+         end if;
+         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
+            Res := Sem_Expression_Ov (Get_Actual (Assoc), Null_Iir);
+            if Res = Null_Iir then
+               Ok := False;
+            else
+               Set_Actual (Assoc, Res);
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      return Ok;
+   end Sem_Actual_Of_Association_Chain;
+
+   procedure Check_Parameter_Association_Restriction
+     (Inter : Iir; Base_Actual : Iir; Loc : Iir)
+   is
+      Act_Mode : Iir_Mode;
+      For_Mode : Iir_Mode;
+   begin
+      Act_Mode := Get_Mode (Base_Actual);
+      For_Mode := Get_Mode (Inter);
+      case Get_Mode (Inter) is
+         when Iir_In_Mode =>
+            if Act_Mode in Iir_In_Modes or Act_Mode = Iir_Buffer_Mode then
+               return;
+            end if;
+         when Iir_Out_Mode =>
+            --  FIXME: should buffer also be accepted ?
+            if Act_Mode in Iir_Out_Modes or Act_Mode = Iir_Buffer_Mode then
+               return;
+            end if;
+         when Iir_Inout_Mode =>
+            if Act_Mode = Iir_Inout_Mode then
+               return;
+            end if;
+         when others =>
+            Error_Kind ("check_parameter_association_restriction", Inter);
+      end case;
+      Error_Msg_Sem
+        ("cannot associate an " & Get_Mode_Name (Act_Mode)
+         & " object with " & Get_Mode_Name (For_Mode) & " "
+         & Disp_Node (Inter), Loc);
+   end Check_Parameter_Association_Restriction;
+
+   procedure Check_Subprogram_Associations
+     (Inter_Chain : Iir; Assoc_Chain : Iir)
+   is
+      Assoc : Iir;
+      Formal : Iir;
+      Formal_Inter : Iir;
+      Actual : Iir;
+      Prefix : Iir;
+      Object : Iir;
+      Inter : Iir;
+   begin
+      Assoc := Assoc_Chain;
+      Inter := Inter_Chain;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         if Formal = Null_Iir then
+            --  Association by position.
+            Formal_Inter := Inter;
+            Inter := Get_Chain (Inter);
+         else
+            --  Association by name.
+            Formal_Inter := Get_Association_Interface (Assoc);
+            Inter := Null_Iir;
+         end if;
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               if Get_Default_Value (Formal_Inter) = Null_Iir then
+                  Error_Msg_Sem
+                    ("no parameter for " & Disp_Node (Formal_Inter), Assoc);
+               end if;
+            when Iir_Kind_Association_Element_By_Expression =>
+               Actual := Get_Actual (Assoc);
+               Object := Name_To_Object (Actual);
+               if Object /= Null_Iir then
+                  Prefix := Get_Object_Prefix (Object);
+               else
+                  Prefix := Actual;
+               end if;
+
+               case Get_Kind (Formal_Inter) is
+                  when Iir_Kind_Interface_Signal_Declaration =>
+                     --  LRM93 2.1.1
+                     --  In a subprogram call, the actual designator
+                     --  associated with a formal parameter of class
+                     --  signal must be a signal.
+                     case Get_Kind (Prefix) is
+                        when Iir_Kind_Interface_Signal_Declaration
+                          | Iir_Kind_Signal_Declaration
+                          | Iir_Kind_Guard_Signal_Declaration
+                          | Iir_Kinds_Signal_Attribute =>
+                           --  LRM93 2.1.1.2
+                           --  If an actual signal is associated with
+                           --  a signal parameter of any mode, the actual
+                           --  must be denoted by a static signal name.
+                           if Get_Name_Staticness (Object) < Globally then
+                              Error_Msg_Sem
+                                ("actual signal must be a static name",
+                                 Actual);
+                           else
+                              --  Inherit has_active_flag.
+                              Set_Has_Active_Flag
+                                (Prefix, Get_Has_Active_Flag (Formal_Inter));
+                           end if;
+                        when others =>
+                           Error_Msg_Sem
+                             ("signal parameter requires a signal expression",
+                              Assoc);
+                     end case;
+
+                     case Get_Kind (Prefix) is
+                        when Iir_Kind_Interface_Signal_Declaration =>
+                           Check_Parameter_Association_Restriction
+                             (Formal_Inter, Prefix, Assoc);
+                        when Iir_Kind_Guard_Signal_Declaration =>
+                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
+                              Error_Msg_Sem
+                                ("cannot associate a guard signal with "
+                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
+                                 & " " & Disp_Node (Formal_Inter), Assoc);
+                           end if;
+                        when Iir_Kinds_Signal_Attribute =>
+                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
+                              Error_Msg_Sem
+                                ("cannot associate a signal attribute with "
+                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
+                                 & " " & Disp_Node (Formal_Inter), Assoc);
+                           end if;
+                        when others =>
+                           null;
+                     end case;
+
+                     --  LRM 2.1.1.2  Signal parameters
+                     --  It is an error if a conversion function or type
+                     --  conversion appears in either the formal part or the
+                     --  actual part of an association element that associates
+                     --  an actual signal with a formal signal parameter.
+                     if Get_In_Conversion (Assoc) /= Null_Iir
+                       or Get_Out_Conversion (Assoc) /= Null_Iir
+                     then
+                        Error_Msg_Sem ("conversion are not allowed for "
+                                       & "signal parameters", Assoc);
+                     end if;
+                  when Iir_Kind_Interface_Variable_Declaration =>
+                     --  LRM93 2.1.1
+                     --  The actual designator associated with a formal of
+                     --  class variable must be a variable.
+                     case Get_Kind (Prefix) is
+                        when Iir_Kind_Interface_Variable_Declaration =>
+                           Check_Parameter_Association_Restriction
+                             (Formal_Inter, Prefix, Assoc);
+                        when Iir_Kind_Variable_Declaration
+                          | Iir_Kind_Dereference
+                          | Iir_Kind_Implicit_Dereference =>
+                           null;
+                        when Iir_Kind_Interface_File_Declaration
+                          | Iir_Kind_File_Declaration =>
+                           --  LRM87 4.3.1.4
+                           --  Such an object is a member of the variable
+                           --  class of objects;
+                           if Flags.Vhdl_Std >= Vhdl_93 then
+                              Error_Msg_Sem ("in vhdl93, variable parameter "
+                                             & "cannot be a file", Assoc);
+                           end if;
+                        when others =>
+                           Error_Msg_Sem
+                             ("variable parameter must be a variable", Assoc);
+                     end case;
+                  when Iir_Kind_Interface_File_Declaration =>
+                     --  LRM93 2.1.1
+                     --  The actual designator associated with a formal
+                     --  of class file must be a file.
+                     case Get_Kind (Prefix) is
+                        when Iir_Kind_Interface_File_Declaration
+                          | Iir_Kind_File_Declaration =>
+                           null;
+                        when Iir_Kind_Variable_Declaration
+                          | Iir_Kind_Interface_Variable_Declaration =>
+                           if Flags.Vhdl_Std >= Vhdl_93 then
+                              Error_Msg_Sem ("in vhdl93, file parameter "
+                                             & "must be a file", Assoc);
+                           end if;
+                        when others =>
+                           Error_Msg_Sem
+                             ("file parameter must be a file", Assoc);
+                     end case;
+
+                     --  LRM 2.1.1.3  File parameters
+                     --  It is an error if an association element associates
+                     --  an actual with a formal parameter of a file type and
+                     --  that association element contains a conversion
+                     --  function or type conversion.
+                     if Get_In_Conversion (Assoc) /= Null_Iir
+                       or Get_Out_Conversion (Assoc) /= Null_Iir
+                     then
+                        Error_Msg_Sem ("conversion are not allowed for "
+                                       & "file parameters", Assoc);
+                     end if;
+                  when Iir_Kind_Interface_Constant_Declaration =>
+                     --  LRM93 2.1.1
+                     --  The actual designator associated with a formal of
+                     --  class constant must be an expression.
+                     Check_Read (Actual);
+                  when others =>
+                     Error_Kind
+                       ("check_subprogram_association(3)", Formal_Inter);
+               end case;
+            when Iir_Kind_Association_Element_By_Individual =>
+               null;
+            when others =>
+               Error_Kind ("check_subprogram_associations", Assoc);
+         end case;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Check_Subprogram_Associations;
+
+   --  Assocs_Right_Map (FORMAL_MODE, ACTUAL_MODE) is true iff it is allowed
+   --  to associate a formal port of mode FORMAL_MODE with an actual port of
+   --  mode ACTUAL_MODE.
+   subtype Iir_Known_Mode is Iir_Mode range Iir_Linkage_Mode .. Iir_In_Mode;
+   type Assocs_Right_Map is array (Iir_Known_Mode, Iir_Known_Mode) of Boolean;
+
+   Vhdl93_Assocs_Map : constant Assocs_Right_Map :=
+     (Iir_Linkage_Mode => (others => True),
+      Iir_Buffer_Mode => (Iir_Buffer_Mode => True, others => False),
+      Iir_Out_Mode => (Iir_Out_Mode | Iir_Inout_Mode => True,
+                       others => False),
+      Iir_Inout_Mode => (Iir_Inout_Mode => True,
+                         others => False),
+      Iir_In_Mode => (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
+                      others => False));
+
+   Vhdl02_Assocs_Map : constant Assocs_Right_Map :=
+     (Iir_Linkage_Mode => (others => True),
+      Iir_Buffer_Mode => (Iir_Out_Mode | Iir_Inout_Mode
+                          | Iir_Buffer_Mode => True,
+                          others => False),
+      Iir_Out_Mode => (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
+                       others => False),
+      Iir_Inout_Mode => (Iir_Inout_Mode | Iir_Buffer_Mode => True,
+                         others => False),
+      Iir_In_Mode => (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
+                      others => False));
+
+   --  Check for restrictions in LRM 1.1.1.2
+   --  Return FALSE in case of error.
+   function Check_Port_Association_Restriction
+     (Formal : Iir_Interface_Signal_Declaration;
+      Actual : Iir_Interface_Signal_Declaration;
+      Assoc : Iir)
+     return Boolean
+   is
+      Fmode : constant Iir_Mode := Get_Mode (Formal);
+      Amode : constant Iir_Mode := Get_Mode (Actual);
+   begin
+      pragma Assert (Fmode /= Iir_Unknown_Mode);
+      pragma Assert (Amode /= Iir_Unknown_Mode);
+
+      if Flags.Vhdl_Std < Vhdl_02 then
+         if Vhdl93_Assocs_Map (Fmode, Amode) then
+            return True;
+         end if;
+      else
+         if Vhdl02_Assocs_Map (Fmode, Amode) then
+            return True;
+         end if;
+      end if;
+
+      if Assoc /= Null_Iir then
+         Error_Msg_Sem
+           ("cannot associate " & Get_Mode_Name (Fmode) & " "
+              & Disp_Node (Formal) & " with actual port of mode "
+              & Get_Mode_Name (Amode), Assoc);
+      end if;
+      return False;
+   end Check_Port_Association_Restriction;
+
+   --  Handle indexed name
+   --  FORMAL is the formal name to be handled.
+   --  SUB_ASSOC is an association_by_individual in which the formal will be
+   --   inserted.
+   --  Update SUB_ASSOC so that it designates FORMAL.
+   procedure Add_Individual_Assoc_Indexed_Name
+     (Sub_Assoc : in out Iir; Formal : Iir)
+   is
+      Choice : Iir;
+      Last_Choice : Iir;
+      Index_List : Iir_List;
+      Index : Iir;
+      Nbr : Natural;
+   begin
+      --  Find element.
+      Index_List := Get_Index_List (Formal);
+      Nbr := Get_Nbr_Elements (Index_List);
+      for I in 0 .. Nbr - 1 loop
+         Index := Get_Nth_Element (Index_List, I);
+
+         --  Evaluate index.
+         Index := Eval_Expr (Index);
+         Replace_Nth_Element (Index_List, I, Index);
+
+         --  Find index in choice list.
+         Last_Choice := Null_Iir;
+         Choice := Get_Individual_Association_Chain (Sub_Assoc);
+         while Choice /= Null_Iir loop
+            case Get_Kind (Choice) is
+               when Iir_Kind_Choice_By_Expression =>
+                  if Eval_Pos (Get_Choice_Expression (Choice))
+                    = Eval_Pos (Index)
+                  then
+                     goto Found;
+                  end if;
+               when Iir_Kind_Choice_By_Range =>
+                  declare
+                     Choice_Range : constant Iir := Get_Choice_Range (Choice);
+                  begin
+                     if Get_Expr_Staticness (Choice_Range) = Locally
+                       and then
+                       Eval_Int_In_Range (Eval_Pos (Index), Choice_Range)
+                     then
+                        --  FIXME: overlap.
+                        raise Internal_Error;
+                     end if;
+                  end;
+               when others =>
+                  Error_Kind ("add_individual_assoc_index_name", Choice);
+            end case;
+            Last_Choice := Choice;
+            Choice := Get_Chain (Choice);
+         end loop;
+
+         --  If not found, append it.
+         Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
+         Set_Choice_Expression (Choice, Index);
+         Location_Copy (Choice, Formal);
+         if Last_Choice = Null_Iir then
+            Set_Individual_Association_Chain (Sub_Assoc, Choice);
+         else
+            Set_Chain (Last_Choice, Choice);
+         end if;
+
+         << Found >> null;
+
+         if I < Nbr - 1 then
+            Sub_Assoc := Get_Associated_Expr (Choice);
+            if Sub_Assoc = Null_Iir then
+               Sub_Assoc := Create_Iir
+                 (Iir_Kind_Association_Element_By_Individual);
+               Location_Copy (Sub_Assoc, Index);
+               Set_Associated_Expr (Choice, Sub_Assoc);
+            end if;
+         else
+            Sub_Assoc := Choice;
+         end if;
+      end loop;
+   end Add_Individual_Assoc_Indexed_Name;
+
+   procedure Add_Individual_Assoc_Slice_Name
+     (Sub_Assoc : in out Iir; Formal : Iir)
+   is
+      Choice : Iir;
+      Index : Iir;
+   begin
+      --  FIXME: handle cases such as param(5 to 6)(5)
+
+      --  Find element.
+      Index := Get_Suffix (Formal);
+
+      --  Evaluate index.
+      if Get_Expr_Staticness (Index) = Locally then
+         Index := Eval_Range (Index);
+         Set_Suffix (Formal, Index);
+      end if;
+
+      Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+      Location_Copy (Choice, Formal);
+      Set_Choice_Range (Choice, Index);
+      Set_Chain (Choice, Get_Individual_Association_Chain (Sub_Assoc));
+      Set_Individual_Association_Chain (Sub_Assoc, Choice);
+
+      Sub_Assoc := Choice;
+   end Add_Individual_Assoc_Slice_Name;
+
+   procedure Add_Individual_Assoc_Selected_Name
+     (Sub_Assoc : in out Iir; Formal : Iir)
+   is
+      Choice : Iir;
+   begin
+      Choice := Create_Iir (Iir_Kind_Choice_By_Name);
+      Location_Copy (Choice, Formal);
+      Set_Choice_Name (Choice, Get_Selected_Element (Formal));
+      Set_Chain (Choice, Get_Individual_Association_Chain (Sub_Assoc));
+      Set_Individual_Association_Chain (Sub_Assoc, Choice);
+
+      Sub_Assoc := Choice;
+   end Add_Individual_Assoc_Selected_Name;
+
+   procedure Add_Individual_Association_1 (Iassoc : in out Iir; Formal : Iir)
+   is
+      Sub : Iir;
+      Formal_Object : Iir;
+   begin
+      --  Recurse.
+      Formal_Object := Name_To_Object (Formal);
+      case Get_Kind (Formal_Object) is
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_Element =>
+            Add_Individual_Association_1 (Iassoc, Get_Prefix (Formal_Object));
+         when Iir_Kinds_Interface_Object_Declaration =>
+            return;
+         when others =>
+            Error_Kind ("add_individual_association_1", Formal);
+      end case;
+
+      case Get_Kind (Iassoc) is
+         when Iir_Kind_Association_Element_By_Individual =>
+            null;
+         when Iir_Kind_Choice_By_Expression =>
+            Sub := Get_Associated_Expr (Iassoc);
+            if Sub = Null_Iir then
+               Sub := Create_Iir (Iir_Kind_Association_Element_By_Individual);
+               Location_Copy (Sub, Formal);
+               Set_Formal (Sub, Iassoc);
+               Set_Associated_Expr (Iassoc, Sub);
+               Iassoc := Sub;
+            else
+               case Get_Kind (Sub) is
+                  when Iir_Kind_Association_Element_By_Individual =>
+                     Iassoc := Sub;
+                  when others =>
+                     Error_Msg_Sem
+                       ("individual association of "
+                        & Disp_Node (Get_Association_Interface (Iassoc))
+                        & " conflicts with that at " & Disp_Location (Sub),
+                        Formal);
+                     return;
+               end case;
+            end if;
+         when others =>
+            Error_Kind ("add_individual_association_1(2)", Iassoc);
+      end case;
+
+      case Get_Kind (Formal_Object) is
+         when Iir_Kind_Indexed_Name =>
+            Add_Individual_Assoc_Indexed_Name (Iassoc, Formal_Object);
+         when Iir_Kind_Slice_Name =>
+            Add_Individual_Assoc_Slice_Name (Iassoc, Formal_Object);
+         when Iir_Kind_Selected_Element =>
+            Add_Individual_Assoc_Selected_Name (Iassoc, Formal_Object);
+         when others =>
+            Error_Kind ("add_individual_association_1(3)", Formal);
+      end case;
+   end Add_Individual_Association_1;
+
+   --  Insert ASSOC into the tree of individual assoc rooted by IASSOC.
+   procedure Add_Individual_Association (Iassoc : Iir; Assoc : Iir)
+   is
+      Formal : Iir;
+      Iass : Iir;
+      Prev : Iir;
+   begin
+      Formal := Get_Formal (Assoc);
+      Iass := Iassoc;
+      Add_Individual_Association_1 (Iass, Formal);
+      Prev := Get_Associated_Expr (Iass);
+      if Prev /= Null_Iir then
+         Error_Msg_Sem ("individual association of "
+                        & Disp_Node (Get_Association_Interface (Assoc))
+                        & " conflicts with that at " & Disp_Location (Prev),
+                        Assoc);
+      else
+         Set_Associated_Expr (Iass, Assoc);
+      end if;
+   end Add_Individual_Association;
+
+   procedure Finish_Individual_Assoc_Array_Subtype
+     (Assoc : Iir; Atype : Iir; Dim : Positive)
+   is
+      Index_Tlist : constant Iir_List := Get_Index_Subtype_List (Atype);
+      Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist);
+      Index_Type : Iir;
+      Low, High : Iir;
+      Chain : Iir;
+      El : Iir;
+   begin
+      Index_Type := Get_Nth_Element (Index_Tlist, Dim - 1);
+      Chain := Get_Individual_Association_Chain (Assoc);
+      Sem_Choices_Range
+        (Chain, Index_Type, False, False, Get_Location (Assoc), Low, High);
+      Set_Individual_Association_Chain (Assoc, Chain);
+      if Dim < Nbr_Dims then
+         El := Chain;
+         while El /= Null_Iir loop
+            pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Expression);
+            Finish_Individual_Assoc_Array_Subtype
+              (Get_Associated_Expr (El), Atype, Dim + 1);
+            El := Get_Chain (El);
+         end loop;
+      end if;
+   end Finish_Individual_Assoc_Array_Subtype;
+
+   procedure Finish_Individual_Assoc_Array
+     (Actual : Iir; Assoc : Iir; Dim : Natural)
+   is
+      Actual_Type : Iir;
+      Actual_Index : Iir;
+      Base_Type : Iir;
+      Base_Index : Iir;
+      Low, High : Iir;
+      Chain : Iir;
+   begin
+      Actual_Type := Get_Actual_Type (Actual);
+      Actual_Index := Get_Nth_Element (Get_Index_Subtype_List (Actual_Type),
+                                       Dim - 1);
+      if Actual_Index /= Null_Iir then
+         Base_Index := Actual_Index;
+      else
+         Base_Type := Get_Base_Type (Actual_Type);
+         Base_Index := Get_Index_Type (Base_Type, Dim - 1);
+      end if;
+      Chain := Get_Individual_Association_Chain (Assoc);
+      Sem_Choices_Range
+        (Chain, Base_Index, True, False, Get_Location (Assoc), Low, High);
+      Set_Individual_Association_Chain (Assoc, Chain);
+      if Actual_Index = Null_Iir then
+         declare
+            Index_Constraint : Iir;
+            Index_Subtype_Constraint : Iir;
+         begin
+            --  Create an index subtype.
+            case Get_Kind (Base_Index) is
+               when Iir_Kind_Integer_Subtype_Definition =>
+                  Actual_Index :=
+                    Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+               when Iir_Kind_Enumeration_Type_Definition
+                 | Iir_Kind_Enumeration_Subtype_Definition =>
+                  Actual_Index :=
+                    Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               when others =>
+                  Error_Kind ("finish_individual_assoc_array", Base_Index);
+            end case;
+            Location_Copy (Actual_Index, Actual);
+            Set_Base_Type (Actual_Index, Get_Base_Type (Base_Index));
+            Index_Constraint := Get_Range_Constraint (Base_Index);
+
+            Index_Subtype_Constraint := Create_Iir (Iir_Kind_Range_Expression);
+            Location_Copy (Index_Subtype_Constraint, Actual);
+            Set_Range_Constraint (Actual_Index, Index_Subtype_Constraint);
+            Set_Type_Staticness (Actual_Index, Locally);
+            Set_Direction (Index_Subtype_Constraint,
+                           Get_Direction (Index_Constraint));
+
+            case Get_Direction (Index_Constraint) is
+               when Iir_To =>
+                  Set_Left_Limit (Index_Subtype_Constraint, Low);
+                  Set_Right_Limit (Index_Subtype_Constraint, High);
+               when Iir_Downto =>
+                  Set_Left_Limit (Index_Subtype_Constraint, High);
+                  Set_Right_Limit (Index_Subtype_Constraint, Low);
+            end case;
+            Set_Expr_Staticness (Index_Subtype_Constraint, Locally);
+            Append_Element (Get_Index_Subtype_List (Actual_Type),
+                            Actual_Index);
+         end;
+      else
+         declare
+            Act_High, Act_Low : Iir;
+         begin
+            Get_Low_High_Limit (Get_Range_Constraint (Actual_Type),
+                                Act_Low, Act_High);
+            if Eval_Pos (Act_Low) /= Eval_Pos (Low)
+              or Eval_Pos (Act_High) /= Eval_Pos (High)
+            then
+               Error_Msg_Sem ("indexes of individual association mismatch",
+                              Assoc);
+            end if;
+         end;
+      end if;
+   end Finish_Individual_Assoc_Array;
+
+   procedure Finish_Individual_Assoc_Record (Assoc : Iir; Atype : Iir)
+   is
+      Base_Type : constant Iir_Record_Type_Definition := Get_Base_Type (Atype);
+      El_List : constant Iir_List := Get_Elements_Declaration_List (Base_Type);
+      Matches : Iir_Array (0 .. Get_Nbr_Elements (El_List) - 1);
+      Ch : Iir;
+      Pos : Natural;
+      Rec_El : Iir;
+   begin
+      Matches := (others => Null_Iir);
+      Ch := Get_Individual_Association_Chain (Assoc);
+      while Ch /= Null_Iir loop
+         Rec_El := Get_Choice_Name (Ch);
+         Pos := Natural (Get_Element_Position (Rec_El));
+         if Matches (Pos) /= Null_Iir then
+            Error_Msg_Sem ("individual " & Disp_Node (Rec_El)
+                           & " already associated at "
+                           & Disp_Location (Matches (Pos)), Ch);
+         else
+            Matches (Pos) := Ch;
+         end if;
+         Ch := Get_Chain (Ch);
+      end loop;
+      for I in Matches'Range loop
+         Rec_El := Get_Nth_Element (El_List, I);
+         if Matches (I) = Null_Iir then
+            Error_Msg_Sem (Disp_Node (Rec_El) & " not associated", Assoc);
+         end if;
+      end loop;
+      Set_Actual_Type (Assoc, Atype);
+   end Finish_Individual_Assoc_Record;
+
+   --  Called by sem_individual_association to finish the semantization of
+   --  individual association ASSOC.
+   procedure Finish_Individual_Association (Assoc : Iir)
+   is
+      Formal : Iir;
+      Atype : Iir;
+   begin
+      --  Guard.
+      if Assoc = Null_Iir then
+         return;
+      end if;
+
+      Formal := Get_Association_Interface (Assoc);
+      Atype := Get_Type (Formal);
+
+      case Get_Kind (Atype) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            Finish_Individual_Assoc_Array_Subtype (Assoc, Atype, 1);
+            Set_Actual_Type (Assoc, Atype);
+         when Iir_Kind_Array_Type_Definition =>
+            Atype := Create_Array_Subtype (Atype, Get_Location (Assoc));
+            Set_Index_Constraint_Flag (Atype, True);
+            Set_Constraint_State (Atype, Fully_Constrained);
+            Set_Actual_Type (Assoc, Atype);
+            Finish_Individual_Assoc_Array (Assoc, Assoc, 1);
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            Finish_Individual_Assoc_Record (Assoc, Atype);
+         when others =>
+            Error_Kind ("finish_individual_association", Atype);
+      end case;
+   end Finish_Individual_Association;
+
+   --  Sem individual associations of ASSOCS:
+   --  Add an Iir_Kind_Association_Element_By_Individual before each
+   --  group of individual association for the same formal, and call
+   --  Finish_Individual_Association with each of these added nodes.
+   procedure Sem_Individual_Association (Assoc_Chain : in out Iir)
+   is
+      Assoc : Iir;
+      Prev_Assoc : Iir;
+      Iassoc : Iir_Association_Element_By_Individual;
+      Cur_Iface : Iir;
+      Formal : Iir;
+   begin
+      Iassoc := Null_Iir;
+      Cur_Iface := Null_Iir;
+      Prev_Assoc := Null_Iir;
+      Assoc := Assoc_Chain;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         if Formal /= Null_Iir then
+            Formal := Get_Object_Prefix (Formal);
+         end if;
+         if Formal = Null_Iir or else Formal /= Cur_Iface then
+            --  New formal name, sem the current assoc.
+            Finish_Individual_Association (Iassoc);
+            Cur_Iface := Formal;
+            Iassoc := Null_Iir;
+         end if;
+         if Get_Whole_Association_Flag (Assoc) = False then
+            --  New individual association.
+            if Iassoc = Null_Iir then
+               Iassoc :=
+                 Create_Iir (Iir_Kind_Association_Element_By_Individual);
+               Location_Copy (Iassoc, Assoc);
+               if Cur_Iface = Null_Iir then
+                  raise Internal_Error;
+               end if;
+               Set_Formal (Iassoc, Cur_Iface);
+               --  Insert IASSOC.
+               if Prev_Assoc = Null_Iir then
+                  Assoc_Chain := Iassoc;
+               else
+                  Set_Chain (Prev_Assoc, Iassoc);
+               end if;
+               Set_Chain (Iassoc, Assoc);
+            end if;
+            Add_Individual_Association (Iassoc, Assoc);
+         end if;
+         Prev_Assoc := Assoc;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      --  There is maybe a remaining iassoc.
+      Finish_Individual_Association (Iassoc);
+   end Sem_Individual_Association;
+
+   function Is_Conversion_Function (Assoc_Chain : Iir) return Boolean
+   is
+   begin
+      --  [...] whose single parameter of the function [...]
+      if not Is_Chain_Length_One (Assoc_Chain) then
+         return False;
+      end if;
+      if Get_Kind (Assoc_Chain) /= Iir_Kind_Association_Element_By_Expression
+      then
+         return False;
+      end if;
+      --  FIXME: unfortunatly, the formal may already be set with the
+      --  interface.
+--       if Get_Formal (Assoc_Chain) /= Null_Iir then
+--          return Null_Iir;
+--       end if;
+      return True;
+   end Is_Conversion_Function;
+
+   function Is_Expanded_Name (Name : Iir) return Boolean
+   is
+      Pfx : Iir;
+   begin
+      Pfx := Name;
+      loop
+         case Get_Kind (Pfx) is
+            when Iir_Kind_Simple_Name =>
+               return True;
+            when Iir_Kind_Selected_Name =>
+               Pfx := Get_Prefix (Pfx);
+            when others =>
+               return False;
+         end case;
+      end loop;
+   end Is_Expanded_Name;
+
+   function Extract_Type_Of_Conversions (Convs : Iir) return Iir
+   is
+      --  Return TRUE iff FUNC is valid as a conversion function/type.
+      function Extract_Type_Of_Conversion (Func : Iir) return Iir is
+      begin
+         case Get_Kind (Func) is
+            when Iir_Kinds_Function_Declaration =>
+               if Is_Chain_Length_One (Get_Interface_Declaration_Chain (Func))
+               then
+                  return Get_Type (Func);
+               else
+                  return Null_Iir;
+               end if;
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  return Null_Iir;
+               end if;
+               return Get_Type (Func);
+            when others =>
+               return Null_Iir;
+         end case;
+      end Extract_Type_Of_Conversion;
+
+      Res_List : Iir_List;
+      Ov_List : Iir_List;
+      El : Iir;
+      Conv_Type : Iir;
+   begin
+      if not Is_Overload_List (Convs) then
+         return Extract_Type_Of_Conversion (Convs);
+      else
+         Ov_List := Get_Overload_List (Convs);
+         Res_List := Create_Iir_List;
+         for I in Natural loop
+            El := Get_Nth_Element (Ov_List, I);
+            exit when El = Null_Iir;
+            Conv_Type := Extract_Type_Of_Conversion (El);
+            if Conv_Type /= Null_Iir then
+               Add_Element (Res_List, Conv_Type);
+            end if;
+         end loop;
+         return Simplify_Overload_List (Res_List);
+      end if;
+   end Extract_Type_Of_Conversions;
+
+   --  ASSOC is an association element not semantized and whose formal is a
+   --  parenthesis name.  Try to extract a conversion function/type.  In case
+   --  of success, return a new association element.  In case of failure,
+   --  return NULL_IIR.
+   function Sem_Formal_Conversion (Assoc : Iir) return Iir
+   is
+      Formal : constant Iir := Get_Formal (Assoc);
+      Assoc_Chain : constant Iir := Get_Association_Chain (Formal);
+      Res : Iir;
+      Conv : Iir;
+      Name : Iir;
+      Conv_Func : Iir;
+      Conv_Type : Iir;
+   begin
+      --  Nothing to do if the formal isn't a conversion.
+      if not Is_Conversion_Function (Assoc_Chain) then
+         return Null_Iir;
+      end if;
+
+      --  Both the conversion function and the formal name must be names.
+      Conv := Get_Prefix (Formal);
+      --  FIXME: what about operator names (such as "not").
+      if Get_Kind (Conv) /= Iir_Kind_Simple_Name
+        and then not Is_Expanded_Name (Conv)
+      then
+         return Null_Iir;
+      end if;
+      Name := Get_Actual (Assoc_Chain);
+      if Get_Kind (Name) not in Iir_Kinds_Name then
+         return Null_Iir;
+      end if;
+
+      Sem_Name_Soft (Conv);
+      Conv_Func := Get_Named_Entity (Conv);
+      if Get_Kind (Conv_Func) = Iir_Kind_Error then
+         Conv_Type := Null_Iir;
+      else
+         Conv_Type := Extract_Type_Of_Conversions (Conv_Func);
+      end if;
+      if Conv_Type = Null_Iir then
+         Sem_Name_Clean (Conv);
+         return Null_Iir;
+      end if;
+      Set_Type (Conv, Conv_Type);
+
+      --  Create a new association with a conversion function.
+      Res := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+      Set_Out_Conversion (Res, Conv);
+      Set_Formal (Res, Name);
+      Set_Actual (Res, Get_Actual (Assoc));
+      return Res;
+   end Sem_Formal_Conversion;
+
+   --  NAME is the formal name of an association, without any conversion
+   --  function or type.
+   --  Try to semantize NAME with INTERFACE.
+   --  In case of success, set PREFIX to the most prefix of NAME and NAME_TYPE
+   --  to the type of NAME.
+   --  In case of failure, set NAME_TYPE to NULL_IIR.
+   procedure Sem_Formal_Name (Name : Iir;
+                              Inter : Iir;
+                              Prefix : out Iir;
+                              Name_Type : out Iir)
+   is
+      Base_Type : Iir;
+      Rec_El : Iir;
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name =>
+            if Get_Identifier (Name) = Get_Identifier (Inter) then
+               Prefix := Name;
+               Name_Type := Get_Type (Inter);
+            else
+               Name_Type := Null_Iir;
+            end if;
+            return;
+         when Iir_Kind_Selected_Name =>
+            Sem_Formal_Name (Get_Prefix (Name), Inter, Prefix, Name_Type);
+            if Name_Type = Null_Iir then
+               return;
+            end if;
+            Base_Type := Get_Base_Type (Name_Type);
+            if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
+               Name_Type := Null_Iir;
+               return;
+            end if;
+            Rec_El := Find_Name_In_List
+              (Get_Elements_Declaration_List (Base_Type),
+               Get_Identifier (Name));
+            if Rec_El = Null_Iir then
+               Name_Type := Null_Iir;
+               return;
+            end if;
+            Name_Type := Get_Type (Rec_El);
+            return;
+         when Iir_Kind_Parenthesis_Name =>
+            --  More difficult: slice or indexed array.
+            Sem_Formal_Name (Get_Prefix (Name), Inter, Prefix, Name_Type);
+            if Name_Type = Null_Iir then
+               return;
+            end if;
+            Base_Type := Get_Base_Type (Name_Type);
+            if Get_Kind (Base_Type) /= Iir_Kind_Array_Type_Definition then
+               Name_Type := Null_Iir;
+               return;
+            end if;
+            declare
+               Chain : Iir;
+               Index_List : Iir_List;
+               Idx : Iir;
+            begin
+               Chain := Get_Association_Chain (Name);
+               Index_List := Get_Index_Subtype_List (Base_Type);
+               --  Check for matching length.
+               if Get_Chain_Length (Chain) /= Get_Nbr_Elements (Index_List)
+               then
+                  Name_Type := Null_Iir;
+                  return;
+               end if;
+               if Get_Kind (Chain)
+                 /= Iir_Kind_Association_Element_By_Expression
+               then
+                  Name_Type := Null_Iir;
+                  return;
+               end if;
+               Idx := Get_Actual (Chain);
+               if (not Is_Chain_Length_One (Chain))
+                 or else (Get_Kind (Idx) /= Iir_Kind_Range_Expression
+                          and then not Is_Range_Attribute_Name (Idx))
+               --  FIXME: what about subtype !
+               then
+                  --  Indexed name.
+                  Name_Type := Get_Element_Subtype (Base_Type);
+                  return;
+               end if;
+               --  Slice.
+               return;
+            end;
+         when others =>
+            Error_Kind ("sem_formal_name", Name);
+      end case;
+   end Sem_Formal_Name;
+
+   --  Return a type or a list of types for a formal expression FORMAL
+   --   corresponding to INTERFACE.  Possible cases are:
+   --  * FORMAL is the simple name with the same identifier as INTERFACE,
+   --    FORMAL_TYPE is set to the type of INTERFACE and CONV_TYPE is set
+   --    to NULL_IIR.
+   --  * FORMAL is a selected, indexed or slice name whose extreme prefix is
+   --    a simple name with the same identifier as INTERFACE, FORMAL_TYPE
+   --    is set to the type of the name, and CONV_TYPE is set to NULL_IIR.
+   --  * FORMAL is a function call, whose only argument is an
+   --    association_element_by_expression, whose actual is a name
+   --    whose prefix is the same identifier as INTERFACE (note, since FORMAL
+   --    is not semantized, this is parenthesis name), CONV_TYPE is set to
+   --    the type or list of type of return type of conversion functions and
+   --    FORMAL_TYPE is set to the type of the name.
+   --  * otherwise, FORMAL cannot match INTERFACE and both FORMAL_TYPE and
+   --    CONV_TYPE are set to NULL_IIR.
+   --  If FINISH is true, the simple name is replaced by INTERFACE.
+
+   type Param_Assoc_Type is (None, Open, Individual, Whole);
+
+   function Sem_Formal (Formal : Iir; Inter : Iir) return Param_Assoc_Type
+   is
+      Prefix : Iir;
+      Formal_Type : Iir;
+   begin
+      case Get_Kind (Formal) is
+         when Iir_Kind_Simple_Name =>
+            --  Certainly the most common case: FORMAL_NAME => VAL.
+            --  It is also the easiest.  So, handle it completly now.
+            if Get_Identifier (Formal) = Get_Identifier (Inter) then
+               Formal_Type := Get_Type (Inter);
+               Set_Named_Entity (Formal, Inter);
+               Set_Type (Formal, Formal_Type);
+               Set_Base_Name (Formal, Inter);
+               return Whole;
+            end if;
+            return None;
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Parenthesis_Name =>
+            null;
+         when others =>
+            --  Should have been caught by sem_association_list.
+            Error_Kind ("sem_formal", Formal);
+      end case;
+      --  Check for a sub-element.
+      Sem_Formal_Name (Formal, Inter, Prefix, Formal_Type);
+      if Formal_Type /= Null_Iir then
+         Set_Type (Formal, Formal_Type);
+         Set_Named_Entity (Prefix, Inter);
+         return Individual;
+      else
+         return None;
+      end if;
+   end Sem_Formal;
+
+   function Is_Valid_Conversion
+     (Func : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir)
+     return Boolean
+   is
+      R_Type : Iir;
+      P_Type : Iir;
+   begin
+      case Get_Kind (Func) is
+         when Iir_Kinds_Function_Declaration =>
+            R_Type := Get_Type (Func);
+            P_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
+            if Get_Base_Type (R_Type) = Res_Base_Type
+              and then Get_Base_Type (P_Type) = Param_Base_Type
+            then
+               return True;
+            else
+               return False;
+            end if;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            R_Type := Get_Type (Func);
+            if Get_Base_Type (R_Type) = Res_Base_Type
+              and then Are_Types_Closely_Related (R_Type, Param_Base_Type)
+            then
+               return True;
+            else
+               return False;
+            end if;
+         when Iir_Kind_Function_Call =>
+            return Is_Valid_Conversion (Get_Implementation (Func),
+                                        Res_Base_Type, Param_Base_Type);
+         when Iir_Kind_Type_Conversion =>
+            return Is_Valid_Conversion (Get_Type_Mark (Func),
+                                        Res_Base_Type, Param_Base_Type);
+         when Iir_Kinds_Denoting_Name =>
+            return Is_Valid_Conversion (Get_Named_Entity (Func),
+                                        Res_Base_Type, Param_Base_Type);
+         when others =>
+            Error_Kind ("is_valid_conversion(2)", Func);
+      end case;
+   end Is_Valid_Conversion;
+
+   function Extract_Conversion
+     (Conv : Iir; Res_Type : Iir; Param_Type : Iir; Loc : Iir)
+     return Iir
+   is
+      List : Iir_List;
+      Res_Base_Type : Iir;
+      Param_Base_Type : Iir;
+      El : Iir;
+      Res : Iir;
+   begin
+      Res_Base_Type := Get_Base_Type (Res_Type);
+      if Param_Type = Null_Iir then
+         --  In case of error.
+         return Null_Iir;
+      end if;
+      Param_Base_Type := Get_Base_Type (Param_Type);
+      if Is_Overload_List (Conv) then
+         List := Get_Overload_List (Conv);
+         Res := Null_Iir;
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if Is_Valid_Conversion (El, Res_Base_Type, Param_Base_Type) then
+               if Res /= Null_Iir then
+                  raise Internal_Error;
+               end if;
+               Free_Iir (Conv);
+               Res := El;
+            end if;
+         end loop;
+      else
+         if Is_Valid_Conversion (Conv, Res_Base_Type, Param_Base_Type) then
+            Res := Conv;
+         else
+            Res := Null_Iir;
+            Error_Msg_Sem ("conversion function or type does not match", Loc);
+         end if;
+      end if;
+      return Res;
+   end Extract_Conversion;
+
+   function Extract_In_Conversion (Conv : Iir;
+                                   Res_Type : Iir; Param_Type : Iir)
+                                  return Iir
+   is
+      Func : Iir;
+   begin
+      if Conv = Null_Iir then
+         return Null_Iir;
+      end if;
+      Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv);
+      if Func = Null_Iir then
+         return Null_Iir;
+      end if;
+      case Get_Kind (Func) is
+         when Iir_Kind_Function_Call
+           | Iir_Kind_Type_Conversion =>
+            return Func;
+         when others =>
+            Error_Kind ("extract_in_conversion", Func);
+      end case;
+   end Extract_In_Conversion;
+
+   function Extract_Out_Conversion (Conv : Iir;
+                                    Res_Type : Iir; Param_Type : Iir)
+                                   return Iir
+   is
+      Func : Iir;
+      Res : Iir;
+   begin
+      if Conv = Null_Iir then
+         return Null_Iir;
+      end if;
+      Func := Extract_Conversion (Get_Named_Entity (Conv),
+                                  Res_Type, Param_Type, Conv);
+      if Func = Null_Iir then
+         return Null_Iir;
+      end if;
+      pragma Assert (Get_Kind (Conv) in Iir_Kinds_Denoting_Name);
+      Set_Named_Entity (Conv, Func);
+
+      case Get_Kind (Func) is
+         when Iir_Kinds_Function_Declaration =>
+            Res := Create_Iir (Iir_Kind_Function_Call);
+            Location_Copy (Res, Conv);
+            Set_Implementation (Res, Func);
+            Set_Prefix (Res, Conv);
+            Set_Base_Name (Res, Res);
+            Set_Parameter_Association_Chain (Res, Null_Iir);
+            Set_Type (Res, Get_Return_Type (Func));
+            Set_Expr_Staticness (Res, None);
+            Mark_Subprogram_Used (Func);
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration =>
+            Res := Create_Iir (Iir_Kind_Type_Conversion);
+            Location_Copy (Res, Conv);
+            Set_Type_Mark (Res, Conv);
+            Set_Type (Res, Get_Type (Func));
+            Set_Expression (Res, Null_Iir);
+            Set_Expr_Staticness (Res, None);
+         when others =>
+            Error_Kind ("extract_out_conversion", Res);
+      end case;
+      Xrefs.Xref_Name (Conv);
+      return Res;
+   end Extract_Out_Conversion;
+
+   procedure Sem_Association_Open
+     (Assoc : Iir;
+      Inter : Iir;
+      Finish : Boolean;
+      Match : out Boolean)
+   is
+      Formal : Iir;
+      Assoc_Kind : Param_Assoc_Type;
+   begin
+      Formal := Get_Formal (Assoc);
+
+      if Formal /= Null_Iir then
+         Assoc_Kind := Sem_Formal (Formal, Inter);
+         if Assoc_Kind = None then
+            Match := False;
+            return;
+         end if;
+         Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole);
+         if Finish then
+            Sem_Name (Formal);
+            Formal := Finish_Sem_Name (Formal);
+            Set_Formal (Assoc, Formal);
+            if Get_Kind (Formal) in Iir_Kinds_Denoting_Name
+              and then Is_Error (Get_Named_Entity (Formal))
+            then
+               Match := False;
+               return;
+            end if;
+
+            --  LRM 4.3.3.2  Associations lists
+            --  It is an error if an actual of open is associated with a
+            --  formal that is associated individually.
+            if Assoc_Kind = Individual then
+               Error_Msg_Sem ("cannot associate individually with open",
+                              Assoc);
+            end if;
+         end if;
+      else
+         Set_Whole_Association_Flag (Assoc, True);
+      end if;
+      Match := True;
+   end Sem_Association_Open;
+
+   procedure Sem_Association_Package
+     (Assoc : Iir;
+      Inter : Iir;
+      Finish : Boolean;
+      Match : out Boolean)
+   is
+      Formal : constant Iir := Get_Formal (Assoc);
+      Actual : Iir;
+      Package_Inter : Iir;
+   begin
+      if not Finish then
+         Match := Get_Associated_Interface (Assoc) = Inter;
+         return;
+      end if;
+
+      --  Always match (as this is a generic association, there is no
+      --  need to resolve overload).
+      pragma Assert (Get_Associated_Interface (Assoc) = Inter);
+      Match := True;
+
+      if Formal /= Null_Iir then
+         pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name);
+         pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter));
+         Set_Named_Entity (Formal, Inter);
+         Set_Base_Name (Formal, Inter);
+      end if;
+
+      --  Analyze actual.
+      Actual := Get_Actual (Assoc);
+      Actual := Sem_Denoting_Name (Actual);
+      Set_Actual (Assoc, Actual);
+
+      Actual := Get_Named_Entity (Actual);
+      if Is_Error (Actual) then
+         return;
+      end if;
+
+      --  LRM08 6.5.7.2 Generic map aspects
+      --  An actual associated with a formal generic package in a
+      --  generic map aspect shall be the name that denotes an instance
+      --  of the uninstantiated package named in the formal generic
+      --  package declaration [...]
+      if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then
+         Error_Msg_Sem
+           ("actual of association is not a package instantiation", Assoc);
+         return;
+      end if;
+
+      Package_Inter :=
+        Get_Named_Entity (Get_Uninstantiated_Package_Name (Inter));
+      if Get_Named_Entity (Get_Uninstantiated_Package_Name (Actual))
+        /= Package_Inter
+      then
+         Error_Msg_Sem
+           ("actual package name is not an instance of interface package",
+            Assoc);
+         return;
+      end if;
+
+      --  LRM08 6.5.7.2 Generic map aspects
+      --  b) If the formal generic package declaration includes an interface
+      --     generic map aspect in the form that includes the box (<>) symbol,
+      --     then the instantiaed package denotes by the actual may be any
+      --     instance of the uninstantiated package named in the formal
+      --     generic package declaration.
+      if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then
+         null;
+      else
+         --  Other cases not yet handled.
+         raise Internal_Error;
+      end if;
+
+      return;
+   end Sem_Association_Package;
+
+   --  Associate ASSOC with interface INTERFACE
+   --  This sets MATCH.
+   procedure Sem_Association_By_Expression
+     (Assoc : Iir;
+      Inter : Iir;
+      Finish : Boolean;
+      Match : out Boolean)
+   is
+      Formal : Iir;
+      Formal_Type : Iir;
+      Actual: Iir;
+      Out_Conv, In_Conv : Iir;
+      Expr : Iir;
+      Res_Type : Iir;
+      Assoc_Kind : Param_Assoc_Type;
+   begin
+      Formal := Get_Formal (Assoc);
+
+      --  Pre-semantize formal and extract out conversion.
+      if Formal /= Null_Iir then
+         Assoc_Kind := Sem_Formal (Formal, Inter);
+         if Assoc_Kind = None then
+            Match := False;
+            return;
+         end if;
+         Set_Whole_Association_Flag (Assoc, Assoc_Kind = Whole);
+         Formal := Get_Formal (Assoc);
+
+         Out_Conv := Get_Out_Conversion (Assoc);
+      else
+         Set_Whole_Association_Flag (Assoc, True);
+         Out_Conv := Null_Iir;
+         Formal := Inter;
+      end if;
+      Formal_Type := Get_Type (Formal);
+
+      --  Extract conversion from actual.
+      Actual := Get_Actual (Assoc);
+      In_Conv := Null_Iir;
+      if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then
+         case Get_Kind (Actual) is
+            when Iir_Kind_Function_Call =>
+               Expr := Get_Parameter_Association_Chain (Actual);
+               if Is_Conversion_Function (Expr) then
+                  In_Conv := Actual;
+                  Actual := Get_Actual (Expr);
+               end if;
+            when Iir_Kind_Type_Conversion =>
+               if Flags.Vhdl_Std > Vhdl_87 then
+                  In_Conv := Actual;
+                  Actual := Get_Expression (Actual);
+               end if;
+            when others =>
+               null;
+         end case;
+      end if;
+
+      --  4 cases: F:out_conv, G:in_conv.
+      --    A  => B     type of A = type of B
+      --  F(A) => B     type of B = type of F
+      --    A  => G(B)  type of A = type of G
+      --  F(A) => G(B)  type of B = type of F, type of A = type of G
+      if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
+         Match := Is_Expr_Compatible (Formal_Type, Actual);
+      else
+         Match := True;
+         if In_Conv /= Null_Iir then
+            if not Is_Expr_Compatible (Formal_Type, In_Conv) then
+               Match := False;
+            end if;
+         end if;
+         if Out_Conv /= Null_Iir then
+            if not Is_Expr_Compatible (Get_Type (Out_Conv), Actual) then
+               Match := False;
+            end if;
+         end if;
+      end if;
+
+      if not Match then
+         if Finish then
+            Error_Msg_Sem
+              ("can't associate " & Disp_Node (Actual) & " with "
+               & Disp_Node (Inter), Assoc);
+            Error_Msg_Sem
+              ("(type of " & Disp_Node (Actual) & " is "
+               & Disp_Type_Of (Actual) & ")", Assoc);
+            Error_Msg_Sem
+              ("(type of " & Disp_Node (Inter) & " is "
+               & Disp_Type_Of (Inter) & ")", Inter);
+         end if;
+         return;
+      end if;
+
+      if not Finish then
+         return;
+      end if;
+
+      --  At that point, the analysis is being finished.
+
+      if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
+         Res_Type := Formal_Type;
+      else
+         if Out_Conv /= Null_Iir then
+            Res_Type := Search_Compatible_Type (Get_Type (Out_Conv),
+                                                Get_Type (Actual));
+         else
+            Res_Type := Get_Type (Actual);
+         end if;
+
+         if In_Conv /= Null_Iir then
+            In_Conv := Extract_In_Conversion (In_Conv, Formal_Type, Res_Type);
+         end if;
+         if Out_Conv /= Null_Iir then
+            Out_Conv := Extract_Out_Conversion (Out_Conv,
+                                                Res_Type, Formal_Type);
+         end if;
+      end if;
+
+      if Res_Type = Null_Iir then
+         --  In case of error, do not go farther.
+         Match := False;
+         return;
+      end if;
+
+      --  Semantize formal.
+      if Get_Formal (Assoc) /= Null_Iir then
+         Set_Type (Formal, Null_Iir);
+         Sem_Name (Formal);
+         Expr := Get_Named_Entity (Formal);
+         if Get_Kind (Expr) = Iir_Kind_Error then
+            return;
+         end if;
+         Formal := Finish_Sem_Name (Formal);
+         Set_Formal (Assoc, Formal);
+         Formal_Type := Get_Type (Expr);
+         if Out_Conv = Null_Iir and In_Conv = Null_Iir then
+            Res_Type := Formal_Type;
+         end if;
+      end if;
+
+      --  LRM08 6.5.7 Association lists
+      --  The formal part of a named association element may be in the form of
+      --  a function call [...] if and only if the formal is an interface
+      --  object, the mode of the formal is OUT, INOUT, BUFFER or LINKAGE [...]
+      Set_Out_Conversion (Assoc, Out_Conv);
+      if Out_Conv /= Null_Iir
+        and then Get_Mode (Inter) = Iir_In_Mode
+      then
+         Error_Msg_Sem
+           ("can't use an out conversion for an in interface", Assoc);
+      end if;
+
+      --  LRM08 6.5.7 Association lists
+      --  The actual part of an association element may be in the form of a
+      --  function call [...] if and only if the mode of the format is IN,
+      --  INOUT or LINKAGE [...]
+      Set_In_Conversion (Assoc, In_Conv);
+      if In_Conv /= Null_Iir
+        and then Get_Mode (Inter) in Iir_Buffer_Mode .. Iir_Out_Mode
+      then
+         Error_Msg_Sem
+           ("can't use an in conversion for an out/buffer interface", Assoc);
+      end if;
+
+      --  FIXME: LRM refs
+      --  This is somewhat wrong.  A missing conversion is not an error but
+      --  may result in a type mismatch.
+      if Get_Mode (Inter) = Iir_Inout_Mode then
+         if In_Conv = Null_Iir and then Out_Conv /= Null_Iir then
+            Error_Msg_Sem
+              ("out conversion without corresponding in conversion", Assoc);
+         elsif In_Conv /= Null_Iir and then Out_Conv = Null_Iir then
+            Error_Msg_Sem
+              ("in conversion without corresponding out conversion", Assoc);
+         end if;
+      end if;
+      Set_Actual (Assoc, Actual);
+
+      --  Semantize actual.
+      Expr := Sem_Expression (Actual, Res_Type);
+      if Expr /= Null_Iir then
+         Expr := Eval_Expr_Check_If_Static (Expr, Res_Type);
+         Set_Actual (Assoc, Expr);
+         if In_Conv = Null_Iir and then Out_Conv = Null_Iir then
+            if not Check_Implicit_Conversion (Formal_Type, Expr) then
+               Error_Msg_Sem ("actual length does not match formal length",
+                              Assoc);
+            end if;
+         end if;
+      end if;
+   end Sem_Association_By_Expression;
+
+      --  Associate ASSOC with interface INTERFACE
+   --  This sets MATCH.
+   procedure Sem_Association
+     (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Boolean) is
+   begin
+      case Get_Kind (Assoc) is
+         when Iir_Kind_Association_Element_Open =>
+            Sem_Association_Open (Assoc, Inter, Finish, Match);
+
+         when Iir_Kind_Association_Element_Package =>
+            Sem_Association_Package (Assoc, Inter, Finish, Match);
+
+         when Iir_Kind_Association_Element_By_Expression =>
+            Sem_Association_By_Expression (Assoc, Inter, Finish, Match);
+
+         when others =>
+            Error_Kind ("sem_assocation", Assoc);
+      end case;
+   end Sem_Association;
+
+   procedure Sem_Association_Chain
+     (Interface_Chain : Iir;
+      Assoc_Chain: in out Iir;
+      Finish: Boolean;
+      Missing : Missing_Type;
+      Loc : Iir;
+      Match : out Boolean)
+   is
+      --  Set POS and INTERFACE to *the* matching interface if any of ASSOC.
+      procedure Search_Interface (Assoc : Iir;
+                                  Inter : out Iir;
+                                  Pos : out Integer)
+      is
+         I_Match : Boolean;
+      begin
+         Inter := Interface_Chain;
+         Pos := 0;
+         while Inter /= Null_Iir loop
+            -- Formal assoc is not necessarily a simple name, it may
+            -- be a conversion function, or even an indexed or
+            -- selected name.
+            Sem_Association (Assoc, Inter, False, I_Match);
+            if I_Match then
+               return;
+            end if;
+            Inter := Get_Chain (Inter);
+            Pos := Pos + 1;
+         end loop;
+      end Search_Interface;
+
+      Assoc: Iir;
+      Inter: Iir;
+
+      type Bool_Array is array (Natural range <>) of Param_Assoc_Type;
+      Nbr_Arg: constant Natural := Get_Chain_Length (Interface_Chain);
+      Arg_Matched: Bool_Array (0 .. Nbr_Arg - 1) := (others => None);
+
+      Last_Individual : Iir;
+      Has_Individual : Boolean;
+      Pos : Integer;
+      Formal : Iir;
+
+      Interface_1 : Iir;
+      Pos_1 : Integer;
+      Assoc_1 : Iir;
+   begin
+      Match := True;
+      Has_Individual := False;
+
+      -- Loop on every assoc element, try to match it.
+      Inter := Interface_Chain;
+      Last_Individual := Null_Iir;
+      Pos := 0;
+
+      Assoc := Assoc_Chain;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         if Formal = Null_Iir then
+            -- Positional argument.
+            if Pos < 0 then
+               --  Positional after named argument.  Already caught by
+               --  Sem_Actual_Of_Association_Chain (because it is called only
+               --  once, while sem_association_chain may be called several
+               --  times).
+               Match := False;
+               return;
+            end if;
+            -- Try to match actual of ASSOC with the interface.
+            if Inter = Null_Iir then
+               if Finish then
+                  Error_Msg_Sem
+                    ("too many actuals for " & Disp_Node (Loc), Assoc);
+               end if;
+               Match := False;
+               return;
+            end if;
+            Sem_Association (Assoc, Inter, Finish, Match);
+            if not Match then
+               return;
+            end if;
+            if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
+               Arg_Matched (Pos) := Open;
+            else
+               Arg_Matched (Pos) := Whole;
+            end if;
+            Set_Whole_Association_Flag (Assoc, True);
+            Inter := Get_Chain (Inter);
+            Pos := Pos + 1;
+         else
+            -- FIXME: directly search the formal if finish is true.
+            -- Find the Interface.
+            case Get_Kind (Formal) is
+               when Iir_Kind_Parenthesis_Name =>
+                  Assoc_1 := Sem_Formal_Conversion (Assoc);
+                  if Assoc_1 /= Null_Iir then
+                     Search_Interface (Assoc_1, Interface_1, Pos_1);
+                     --  LRM 4.3.2.2  Association Lists
+                     --  The formal part of a named element association may be
+                     --  in the form of a function call, [...], if and only
+                     --  if the mode of the formal is OUT, INOUT, BUFFER, or
+                     --  LINKAGE, and the actual is not OPEN.
+                     if Interface_1 = Null_Iir
+                       or else Get_Mode (Interface_1) = Iir_In_Mode
+                     then
+                        Sem_Name_Clean (Get_Out_Conversion (Assoc_1));
+                        Free_Iir (Assoc_1);
+                        Assoc_1 := Null_Iir;
+                     end if;
+                  end if;
+                  Search_Interface (Assoc, Inter, Pos);
+                  if Inter = Null_Iir then
+                     if Assoc_1 /= Null_Iir then
+                        Inter := Interface_1;
+                        Pos := Pos_1;
+                        Free_Parenthesis_Name
+                          (Get_Formal (Assoc), Get_Out_Conversion (Assoc_1));
+                        Set_Formal (Assoc, Get_Formal (Assoc_1));
+                        Set_Out_Conversion
+                          (Assoc, Get_Out_Conversion (Assoc_1));
+                        Set_Whole_Association_Flag
+                          (Assoc, Get_Whole_Association_Flag (Assoc_1));
+                        Free_Iir (Assoc_1);
+                     end if;
+                  else
+                     if Assoc_1 /= Null_Iir then
+                        raise Internal_Error;
+                     end if;
+                  end if;
+               when others =>
+                  Search_Interface (Assoc, Inter, Pos);
+            end case;
+
+            if Inter /= Null_Iir then
+               if Get_Whole_Association_Flag (Assoc) then
+                  --  Whole association.
+                  Last_Individual := Null_Iir;
+                  if Arg_Matched (Pos) = None then
+                     if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open
+                     then
+                        Arg_Matched (Pos) := Open;
+                     else
+                        Arg_Matched (Pos) := Whole;
+                     end if;
+                  else
+                     if Finish then
+                        Error_Msg_Sem
+                          (Disp_Node (Inter) & " already associated", Assoc);
+                        Match := False;
+                        return;
+                     end if;
+                  end if;
+               else
+                  --  Individual association.
+                  Has_Individual := True;
+                  if Arg_Matched (Pos) /= Whole then
+                     if Finish
+                       and then Arg_Matched (Pos) = Individual
+                       and then Last_Individual /= Inter
+                     then
+                        Error_Msg_Sem
+                          ("non consecutive individual association for "
+                           & Disp_Node (Inter), Assoc);
+                        Match := False;
+                        return;
+                     end if;
+                     Last_Individual := Inter;
+                     Arg_Matched (Pos) := Individual;
+                  else
+                     if Finish then
+                        Error_Msg_Sem
+                          (Disp_Node (Inter) & " already associated", Assoc);
+                        Match := False;
+                        return;
+                     end if;
+                  end if;
+               end if;
+               if Finish then
+                  Sem_Association (Assoc, Inter, True, Match);
+                  --  MATCH can be false du to errors.
+               end if;
+            else
+               -- Not found.
+               if Finish then
+                  --  FIXME: display the name of subprg or component/entity.
+                  --  FIXME: fetch the interface (for parenthesis_name).
+                  Error_Msg_Sem
+                    ("no interface for " & Disp_Node (Get_Formal (Assoc))
+                     & " in association", Assoc);
+               end if;
+               Match := False;
+               return;
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      if Finish and then Has_Individual then
+         Sem_Individual_Association (Assoc_Chain);
+      end if;
+
+      if Missing = Missing_Allowed then
+         return;
+      end if;
+
+      --  LRM93 8.6 Procedure Call Statement
+      --  For each formal parameter of a procedure, a procedure call must
+      --  specify exactly one corresponding actual parameter.
+      --  This actual parameter is specified either explicitly, by an
+      --  association element (other than the actual OPEN) in the association
+      --  list, or in the absence of such an association element, by a default
+      --  expression (see Section 4.3.3.2).
+
+      --  LRM93 7.3.3 Function Calls
+      --  For each formal parameter of a function, a function call must
+      --  specify exactly one corresponding actual parameter.
+      --  This actual parameter is specified either explicitly, by an
+      --  association element (other than the actual OPEN) in the association
+      --  list, or in the absence of such an association element, by a default
+      --  expression (see Section 4.3.3.2).
+
+      --  LRM93 1.1.1.2 / LRM08 6.5.6.3 Port clauses
+      --  A port of mode IN may be unconnected or unassociated only if its
+      --  declaration includes a default expression.
+      --  It is an error if a port of any mode other than IN is unconnected
+      --  or unassociated and its type is an unconstrained array type.
+
+      --  LRM08 6.5.6.2 Generic clauses
+      --  It is an error if no such actual [instantiated package] is specified
+      --  for a given formal generic package (either because the formal generic
+      --  is unassociated or because the actual is OPEN).
+
+      Inter := Interface_Chain;
+      Pos := 0;
+      while Inter /= Null_Iir loop
+         if Arg_Matched (Pos) <= Open then
+            case Get_Kind (Inter) is
+               when Iir_Kinds_Interface_Object_Declaration =>
+                  if Get_Default_Value (Inter) = Null_Iir then
+                     case Missing is
+                        when Missing_Parameter
+                          | Missing_Generic =>
+                           if Finish then
+                              Error_Msg_Sem
+                                ("no actual for " & Disp_Node (Inter), Loc);
+                           end if;
+                           Match := False;
+                           return;
+                        when Missing_Port =>
+                           case Get_Mode (Inter) is
+                              when Iir_In_Mode =>
+                                 if not Finish then
+                                    raise Internal_Error;
+                                 end if;
+                                 Error_Msg_Sem
+                                   (Disp_Node (Inter)
+                                      & " of mode IN must be connected", Loc);
+                                 Match := False;
+                                 return;
+                              when Iir_Out_Mode
+                                | Iir_Linkage_Mode
+                                | Iir_Inout_Mode
+                                | Iir_Buffer_Mode =>
+                                 if not Finish then
+                                    raise Internal_Error;
+                                 end if;
+                                 if not Is_Fully_Constrained_Type
+                                   (Get_Type (Inter))
+                                 then
+                                    Error_Msg_Sem
+                                      ("unconstrained " & Disp_Node (Inter)
+                                         & " must be connected", Loc);
+                                    Match := False;
+                                    return;
+                                 end if;
+                              when Iir_Unknown_Mode =>
+                                 raise Internal_Error;
+                           end case;
+                        when Missing_Allowed =>
+                           null;
+                     end case;
+                  end if;
+               when Iir_Kind_Interface_Package_Declaration =>
+                  Error_Msg_Sem
+                    (Disp_Node (Inter) & " must be associated", Loc);
+                  Match := False;
+               when others =>
+                  Error_Kind ("sem_association_chain", Inter);
+            end case;
+         end if;
+         Inter := Get_Chain (Inter);
+         Pos := Pos + 1;
+      end loop;
+   end Sem_Association_Chain;
+end Sem_Assocs;
diff --git a/src/sem_assocs.ads b/src/sem_assocs.ads
new file mode 100644
index 000000000..ec460e0e3
--- /dev/null
+++ b/src/sem_assocs.ads
@@ -0,0 +1,60 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Sem_Assocs is
+   --  Change the kind of association corresponding to non-object interfaces.
+   --  Such an association mustn't be handled an like association for object.
+   function Extract_Non_Object_Association
+     (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir;
+
+   --  Semantize actuals of ASSOC_CHAIN.
+   --  Check all named associations are after positionnal one.
+   --  Return TRUE if no error.
+   function Sem_Actual_Of_Association_Chain (Assoc_Chain : Iir) return Boolean;
+
+   --  Semantize association chain ASSOC_CHAIN with interfaces from
+   --  INTERFACE_CHAIN.
+   --  Return the level of compatibility between the two chains in LEVEL.
+   --  If FINISH is true, then ASSOC_CHAIN may be modifies (individual assoc
+   --  added), and error messages (if any) are displayed.
+   --  MISSING control unassociated interfaces.
+   -- LOC is the association.
+   -- Sem_Actual_Of_Association_Chain must have been called before.
+   type Missing_Type is (Missing_Parameter, Missing_Port, Missing_Generic,
+                         Missing_Allowed);
+   procedure Sem_Association_Chain
+     (Interface_Chain : Iir;
+      Assoc_Chain: in out Iir;
+      Finish: Boolean;
+      Missing : Missing_Type;
+      Loc : Iir;
+      Match : out Boolean);
+
+   --  Do port Sem_Association_Chain checks for subprograms.
+   procedure Check_Subprogram_Associations
+     (Inter_Chain : Iir; Assoc_Chain : Iir);
+
+   --  Check for restrictions in §1.1.1.2
+   --  Return FALSE in case of error.
+   function Check_Port_Association_Restriction
+     (Formal : Iir_Interface_Signal_Declaration;
+      Actual : Iir_Interface_Signal_Declaration;
+      Assoc : Iir)
+     return Boolean;
+end Sem_Assocs;
diff --git a/src/sem_decls.adb b/src/sem_decls.adb
new file mode 100644
index 000000000..a7c0b4b44
--- /dev/null
+++ b/src/sem_decls.adb
@@ -0,0 +1,3018 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Errorout; use Errorout;
+with Types; use Types;
+with Std_Names;
+with Tokens;
+with Flags; use Flags;
+with Std_Package; use Std_Package;
+with Ieee.Std_Logic_1164;
+with Iir_Chains;
+with Evaluation; use Evaluation;
+with Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Sem; use Sem;
+with Sem_Expr; use Sem_Expr;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Names; use Sem_Names;
+with Sem_Specs; use Sem_Specs;
+with Sem_Types; use Sem_Types;
+with Sem_Inst;
+with Xrefs; use Xrefs;
+use Iir_Chains;
+
+package body Sem_Decls is
+   --  Emit an error if the type of DECL is a file type, access type,
+   --  protected type or if a subelement of DECL is an access type.
+   procedure Check_Signal_Type (Decl : Iir)
+   is
+      Decl_Type : Iir;
+   begin
+      Decl_Type := Get_Type (Decl);
+      if Get_Signal_Type_Flag (Decl_Type) = False then
+         Error_Msg_Sem ("type of " & Disp_Node (Decl)
+                        & " cannot be " & Disp_Node (Decl_Type), Decl);
+         case Get_Kind (Decl_Type) is
+            when Iir_Kind_File_Type_Definition =>
+               null;
+            when Iir_Kind_Protected_Type_Declaration =>
+               null;
+            when Iir_Kind_Access_Type_Definition
+              | Iir_Kind_Access_Subtype_Definition =>
+               null;
+            when Iir_Kinds_Array_Type_Definition
+              | Iir_Kind_Record_Type_Definition
+              | Iir_Kind_Record_Subtype_Definition =>
+               Error_Msg_Sem ("(" & Disp_Node (Decl_Type)
+                              & " has an access subelement)", Decl);
+            when others =>
+               Error_Kind ("check_signal_type", Decl_Type);
+         end case;
+      end if;
+   end Check_Signal_Type;
+
+   procedure Sem_Interface_Object_Declaration
+     (Inter, Last : Iir; Interface_Kind : Interface_Kind_Type)
+   is
+      A_Type: Iir;
+      Default_Value: Iir;
+   begin
+      --  Avoid the reanalysed duplicated types.
+      --  This is not an optimization, since the unanalysed type must have
+      --  been freed.
+      A_Type := Get_Subtype_Indication (Inter);
+      if A_Type = Null_Iir then
+         pragma Assert (Last /= Null_Iir);
+         Set_Subtype_Indication (Inter, Get_Subtype_Indication (Last));
+         A_Type := Get_Type (Last);
+         Default_Value := Get_Default_Value (Last);
+      else
+         A_Type := Sem_Subtype_Indication (A_Type);
+         Set_Subtype_Indication (Inter, A_Type);
+         A_Type := Get_Type_Of_Subtype_Indication (A_Type);
+
+         Default_Value := Get_Default_Value (Inter);
+         if Default_Value /= Null_Iir and then A_Type /= Null_Iir then
+            Deferred_Constant_Allowed := True;
+            Default_Value := Sem_Expression (Default_Value, A_Type);
+            Default_Value :=
+              Eval_Expr_Check_If_Static (Default_Value, A_Type);
+            Deferred_Constant_Allowed := False;
+            Check_Read (Default_Value);
+         end if;
+      end if;
+
+      Set_Name_Staticness (Inter, Locally);
+      Xref_Decl (Inter);
+
+      if A_Type /= Null_Iir then
+         Set_Type (Inter, A_Type);
+
+         if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
+            case Get_Signal_Kind (Inter) is
+               when Iir_No_Signal_Kind =>
+                  null;
+               when Iir_Bus_Kind =>
+                  --  FIXME: where this test came from ?
+                  --  FIXME: from 4.3.1.2 ?
+                  if False
+                    and
+                    (Get_Kind (A_Type) not in Iir_Kinds_Subtype_Definition
+                       or else Get_Resolution_Indication (A_Type) = Null_Iir)
+                  then
+                     Error_Msg_Sem
+                       (Disp_Node (A_Type) & " of guarded " & Disp_Node (Inter)
+                          & " is not resolved", Inter);
+                  end if;
+
+                  --  LRM 2.1.1.2  Signal parameter
+                  --  It is an error if the declaration of a formal signal
+                  --  parameter includes the reserved word BUS.
+                  if Flags.Vhdl_Std >= Vhdl_93
+                    and then Interface_Kind in Parameter_Interface_List
+                  then
+                     Error_Msg_Sem
+                       ("signal parameter can't be of kind bus", Inter);
+                  end if;
+               when Iir_Register_Kind =>
+                  Error_Msg_Sem
+                    ("interface signal can't be of kind register", Inter);
+            end case;
+            Set_Type_Has_Signal (A_Type);
+         end if;
+
+         case Get_Kind (Inter) is
+            when Iir_Kind_Interface_Constant_Declaration
+              | Iir_Kind_Interface_Signal_Declaration =>
+               --  LRM 4.3.2  Interface declarations
+               --  For an interface constant declaration or an interface
+               --  signal declaration, the subtype indication must define
+               --  a subtype that is neither a file type, an access type,
+               --  nor a protected type.  Moreover, the subtype indication
+               --  must not denote a composite type with a subelement that
+               --  is a file type, an access type, or a protected type.
+               Check_Signal_Type (Inter);
+            when Iir_Kind_Interface_Variable_Declaration =>
+               case Get_Kind (Get_Base_Type (A_Type)) is
+                  when Iir_Kind_File_Type_Definition =>
+                     if Flags.Vhdl_Std >= Vhdl_93 then
+                        Error_Msg_Sem ("variable formal type can't be a "
+                                         & "file type (vhdl 93)", Inter);
+                     end if;
+                  when Iir_Kind_Protected_Type_Declaration =>
+                     --  LRM 2.1.1.1  Constant and variable parameters
+                     --  It is an error if the mode of the parameter is
+                     --  other that INOUT.
+                     if Get_Mode (Inter) /= Iir_Inout_Mode then
+                        Error_Msg_Sem
+                          ("parameter of protected type must be inout", Inter);
+                     end if;
+                  when others =>
+                     null;
+               end case;
+            when Iir_Kind_Interface_File_Declaration =>
+               if Get_Kind (Get_Base_Type (A_Type))
+                 /= Iir_Kind_File_Type_Definition
+               then
+                  Error_Msg_Sem
+                    ("file formal type must be a file type", Inter);
+               end if;
+            when others =>
+               --  Inter is not an interface.
+               raise Internal_Error;
+         end case;
+
+         if Default_Value /= Null_Iir then
+            Set_Default_Value (Inter, Default_Value);
+
+            --  LRM 4.3.2  Interface declarations.
+            --  It is an error if a default expression appears in an
+            --  interface declaration and any of the following conditions
+            --  hold:
+            --   -  The mode is linkage
+            --   -  The interface object is a formal signal parameter
+            --   -  The interface object is a formal variable parameter of
+            --      mode other than in
+            --   -  The subtype indication of the interface declaration
+            --      denotes a protected type.
+            case Get_Kind (Inter) is
+               when Iir_Kind_Interface_Constant_Declaration =>
+                  null;
+               when Iir_Kind_Interface_Signal_Declaration =>
+                  if Get_Mode (Inter) = Iir_Linkage_Mode then
+                     Error_Msg_Sem
+                       ("default expression not allowed for linkage port",
+                        Inter);
+                  elsif Interface_Kind in Parameter_Interface_List then
+                     Error_Msg_Sem ("default expression not allowed"
+                                      & " for signal parameter", Inter);
+                  end if;
+               when Iir_Kind_Interface_Variable_Declaration =>
+                  if Get_Mode (Inter) /= Iir_In_Mode then
+                     Error_Msg_Sem
+                       ("default expression not allowed for"
+                          & " out or inout variable parameter", Inter);
+                  elsif Get_Kind (A_Type) = Iir_Kind_Protected_Type_Declaration
+                  then
+                     Error_Msg_Sem
+                       ("default expression not allowed for"
+                          & " variable parameter of protected type", Inter);
+                  end if;
+               when Iir_Kind_Interface_File_Declaration =>
+                  raise Internal_Error;
+               when others =>
+                  null;
+            end case;
+         end if;
+      else
+         Set_Type (Inter, Error_Type);
+      end if;
+
+      Sem_Scopes.Add_Name (Inter);
+
+      --  By default, interface are not static.
+      --  This may be changed just below.
+      Set_Expr_Staticness (Inter, None);
+
+      case Interface_Kind is
+         when Generic_Interface_List =>
+            --  LRM93 1.1.1
+            --  The generic list in the formal generic clause defines
+            --  generic constants whose values may be determined by the
+            --  environment.
+            if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then
+               Error_Msg_Sem
+                 ("generic " & Disp_Node (Inter) & " must be a constant",
+                  Inter);
+            else
+               --   LRM93 7.4.2 (Globally static primaries)
+               --   3. a generic constant.
+               Set_Expr_Staticness (Inter, Globally);
+            end if;
+         when Port_Interface_List =>
+            if Get_Kind (Inter) /= Iir_Kind_Interface_Signal_Declaration then
+               Error_Msg_Sem
+                 ("port " & Disp_Node (Inter) & " must be a signal", Inter);
+            end if;
+         when Parameter_Interface_List =>
+            if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration
+              and then Interface_Kind = Function_Parameter_Interface_List
+            then
+               Error_Msg_Sem ("variable interface parameter are not "
+                                & "allowed for a function (use a constant)",
+                              Inter);
+            end if;
+
+            --  By default, we suppose a subprogram read the activity of
+            --  a signal.
+            --  This will be adjusted when the body is analyzed.
+            if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration
+              and then Get_Mode (Inter) in Iir_In_Modes
+            then
+               Set_Has_Active_Flag (Inter, True);
+            end if;
+
+            case Get_Mode (Inter) is
+               when Iir_Unknown_Mode =>
+                  raise Internal_Error;
+               when Iir_In_Mode =>
+                  null;
+               when Iir_Inout_Mode
+                 | Iir_Out_Mode =>
+                  if Interface_Kind = Function_Parameter_Interface_List
+                    and then
+                    Get_Kind (Inter) /= Iir_Kind_Interface_File_Declaration
+                  then
+                     Error_Msg_Sem ("mode of a function parameter cannot "
+                                      & "be inout or out", Inter);
+                  end if;
+               when Iir_Buffer_Mode
+                 | Iir_Linkage_Mode =>
+                  Error_Msg_Sem ("buffer or linkage mode is not allowed "
+                                   & "for a subprogram parameter", Inter);
+            end case;
+      end case;
+   end Sem_Interface_Object_Declaration;
+
+   procedure Sem_Interface_Package_Declaration (Inter : Iir)
+   is
+      Pkg : Iir;
+   begin
+      --  LRM08 6.5.5 Interface package declarations
+      --  the uninstantiated_package_name shall denote an uninstantiated
+      --  package declared in a package declaration.
+      Pkg := Sem_Uninstantiated_Package_Name (Inter);
+      if Pkg = Null_Iir then
+         return;
+      end if;
+
+      Sem_Inst.Instantiate_Package_Declaration (Inter, Pkg);
+
+      if Get_Generic_Map_Aspect_Chain (Inter) /= Null_Iir then
+         --  TODO
+         raise Internal_Error;
+      end if;
+
+      Sem_Scopes.Add_Name (Inter);
+   end Sem_Interface_Package_Declaration;
+
+   procedure Sem_Interface_Chain (Interface_Chain: Iir;
+                                  Interface_Kind : Interface_Kind_Type)
+   is
+      Inter : Iir;
+
+      --  LAST is the last interface declaration that has a type.  This is
+      --  used to set type and default value for the following declarations
+      --  that appeared in a list of identifiers.
+      Last : Iir;
+   begin
+      Last := Null_Iir;
+
+      Inter := Interface_Chain;
+      while Inter /= Null_Iir loop
+         case Get_Kind (Inter) is
+            when Iir_Kinds_Interface_Object_Declaration =>
+               Sem_Interface_Object_Declaration (Inter, Last, Interface_Kind);
+               Last := Inter;
+            when Iir_Kind_Interface_Package_Declaration =>
+               Sem_Interface_Package_Declaration (Inter);
+            when others =>
+               raise Internal_Error;
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      --  LRM 10.3  Visibility
+      --  A declaration is visible only within a certain part of its scope;
+      --  this starts at the end of the declaration [...]
+
+      --  LRM 4.3.2.1  Interface List
+      --  A name that denotes an interface object must not appear in any
+      --  interface declaration within the interface list containing the
+      --  denotes interface except to declare this object.
+
+      --  GHDL: this is achieved by making the interface object visible after
+      --   having analyzed the interface list.
+      Inter := Interface_Chain;
+      while Inter /= Null_Iir loop
+         Name_Visible (Inter);
+         Inter := Get_Chain (Inter);
+      end loop;
+   end Sem_Interface_Chain;
+
+   --  LRM93 7.2.2
+   --  A discrete array is a one-dimensional array whose elements are of a
+   --  discrete type.
+   function Is_Discrete_Array (Def : Iir) return Boolean
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            null;
+         when others =>
+            raise Internal_Error;
+            -- return False;
+      end case;
+      if not Is_One_Dimensional_Array_Type (Def) then
+         return False;
+      end if;
+      if Get_Kind (Get_Element_Subtype (Def))
+        not in Iir_Kinds_Discrete_Type_Definition
+      then
+         return False;
+      end if;
+      return True;
+   end Is_Discrete_Array;
+
+   procedure Create_Implicit_File_Primitives
+     (Decl : Iir_Type_Declaration; Type_Definition : Iir_File_Type_Definition)
+   is
+      use Iir_Chains.Interface_Declaration_Chain_Handling;
+      Type_Mark : constant Iir := Get_File_Type_Mark (Type_Definition);
+      Type_Mark_Type : constant Iir := Get_Type (Type_Mark);
+      Proc: Iir_Implicit_Procedure_Declaration;
+      Func: Iir_Implicit_Function_Declaration;
+      Inter: Iir;
+      Loc : Location_Type;
+      File_Interface_Kind : Iir_Kind;
+      Last_Interface : Iir;
+      Last : Iir;
+   begin
+      Last := Decl;
+      Loc := Get_Location (Decl);
+
+      if Flags.Vhdl_Std >= Vhdl_93c then
+         for I in 1 .. 2 loop
+            --  Create the implicit file_open (form 1) declaration.
+            --  Create the implicit file_open (form 2) declaration.
+            Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+            Set_Location (Proc, Loc);
+            Set_Parent (Proc, Get_Parent (Decl));
+            Set_Identifier (Proc, Std_Names.Name_File_Open);
+            Set_Type_Reference (Proc, Decl);
+            Set_Visible_Flag (Proc, True);
+            Build_Init (Last_Interface);
+            case I is
+               when 1 =>
+                  Set_Implicit_Definition (Proc, Iir_Predefined_File_Open);
+               when 2 =>
+                  Set_Implicit_Definition (Proc,
+                                           Iir_Predefined_File_Open_Status);
+                  --  status : out file_open_status.
+                  Inter :=
+                    Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+                  Set_Location (Inter, Loc);
+                  Set_Identifier (Inter, Std_Names.Name_Status);
+                  Set_Type (Inter,
+                            Std_Package.File_Open_Status_Type_Definition);
+                  Set_Mode (Inter, Iir_Out_Mode);
+                  Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+                  Append (Last_Interface, Proc, Inter);
+            end case;
+            --  File F : FT
+            Inter := Create_Iir (Iir_Kind_Interface_File_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_F);
+            Set_Type (Inter, Type_Definition);
+            Set_Mode (Inter, Iir_Inout_Mode);
+            Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+            Append (Last_Interface, Proc, Inter);
+            --  External_Name : in STRING
+            Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_External_Name);
+            Set_Type (Inter, Std_Package.String_Type_Definition);
+            Set_Mode (Inter, Iir_In_Mode);
+            Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+            Append (Last_Interface, Proc, Inter);
+            --  Open_Kind : in File_Open_Kind := Read_Mode.
+            Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+            Set_Location (Inter, Loc);
+            Set_Identifier (Inter, Std_Names.Name_Open_Kind);
+            Set_Type (Inter, Std_Package.File_Open_Kind_Type_Definition);
+            Set_Mode (Inter, Iir_In_Mode);
+            Set_Default_Value (Inter,
+                               Std_Package.File_Open_Kind_Read_Mode);
+            Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+            Append (Last_Interface, Proc, Inter);
+            Compute_Subprogram_Hash (Proc);
+            -- Add it to the list.
+            Insert_Incr (Last, Proc);
+         end loop;
+
+         --  Create the implicit file_close declaration.
+         Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+         Set_Identifier (Proc, Std_Names.Name_File_Close);
+         Set_Location (Proc, Loc);
+         Set_Parent (Proc, Get_Parent (Decl));
+         Set_Implicit_Definition (Proc, Iir_Predefined_File_Close);
+         Set_Type_Reference (Proc, Decl);
+         Set_Visible_Flag (Proc, True);
+         Build_Init (Last_Interface);
+         Inter := Create_Iir (Iir_Kind_Interface_File_Declaration);
+         Set_Identifier (Inter, Std_Names.Name_F);
+         Set_Location (Inter, Loc);
+         Set_Type (Inter, Type_Definition);
+         Set_Mode (Inter, Iir_Inout_Mode);
+         Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+         Append (Last_Interface, Proc, Inter);
+         Compute_Subprogram_Hash (Proc);
+         -- Add it to the list.
+         Insert_Incr (Last, Proc);
+      end if;
+
+      if Flags.Vhdl_Std = Vhdl_87 then
+         File_Interface_Kind := Iir_Kind_Interface_Variable_Declaration;
+      else
+         File_Interface_Kind := Iir_Kind_Interface_File_Declaration;
+      end if;
+
+      -- Create the implicit procedure read declaration.
+      Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+      Set_Identifier (Proc, Std_Names.Name_Read);
+      Set_Location (Proc, Loc);
+      Set_Parent (Proc, Get_Parent (Decl));
+      Set_Type_Reference (Proc, Decl);
+      Set_Visible_Flag (Proc, True);
+      Build_Init (Last_Interface);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Append (Last_Interface, Proc, Inter);
+      Inter := Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+      Set_Identifier (Inter, Std_Names.Name_Value);
+      Set_Location (Inter, Loc);
+      Set_Subtype_Indication (Inter, Type_Mark);
+      Set_Type (Inter, Type_Mark_Type);
+      Set_Mode (Inter, Iir_Out_Mode);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Append (Last_Interface, Proc, Inter);
+      if Get_Kind (Type_Mark_Type) in Iir_Kinds_Array_Type_Definition
+        and then Get_Constraint_State (Type_Mark_Type) /= Fully_Constrained
+      then
+         Inter := Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+         Set_Identifier (Inter, Std_Names.Name_Length);
+         Set_Location (Inter, Loc);
+         Set_Type (Inter, Std_Package.Natural_Subtype_Definition);
+         Set_Mode (Inter, Iir_Out_Mode);
+         Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+         Append (Last_Interface, Proc, Inter);
+         Set_Implicit_Definition (Proc, Iir_Predefined_Read_Length);
+      else
+         Set_Implicit_Definition (Proc, Iir_Predefined_Read);
+      end if;
+      Compute_Subprogram_Hash (Proc);
+      -- Add it to the list.
+      Insert_Incr (Last, Proc);
+
+      -- Create the implicit procedure write declaration.
+      Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+      Set_Identifier (Proc, Std_Names.Name_Write);
+      Set_Location (Proc, Loc);
+      Set_Parent (Proc, Get_Parent (Decl));
+      Set_Type_Reference (Proc, Decl);
+      Set_Visible_Flag (Proc, True);
+      Build_Init (Last_Interface);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_Out_Mode);
+      Set_Name_Staticness (Inter, Locally);
+      Set_Expr_Staticness (Inter, None);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Append (Last_Interface, Proc, Inter);
+      Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+      Set_Identifier (Inter, Std_Names.Name_Value);
+      Set_Location (Inter, Loc);
+      Set_Subtype_Indication (Inter, Type_Mark);
+      Set_Type (Inter, Type_Mark_Type);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Append (Last_Interface, Proc, Inter);
+      Set_Implicit_Definition (Proc, Iir_Predefined_Write);
+      Compute_Subprogram_Hash (Proc);
+      -- Add it to the list.
+      Insert_Incr (Last, Proc);
+
+      --  Create the implicit procedure flush declaration
+      if Flags.Vhdl_Std >= Vhdl_08 then
+         Proc := Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+         Set_Identifier (Proc, Std_Names.Name_Flush);
+         Set_Location (Proc, Loc);
+         Set_Parent (Proc, Get_Parent (Decl));
+         Set_Type_Reference (Proc, Decl);
+         Set_Visible_Flag (Proc, True);
+         Build_Init (Last_Interface);
+         Inter := Create_Iir (File_Interface_Kind);
+         Set_Identifier (Inter, Std_Names.Name_F);
+         Set_Location (Inter, Loc);
+         Set_Type (Inter, Type_Definition);
+         Set_Name_Staticness (Inter, Locally);
+         Set_Expr_Staticness (Inter, None);
+         Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+         Append (Last_Interface, Proc, Inter);
+         Set_Implicit_Definition (Proc, Iir_Predefined_Flush);
+         Compute_Subprogram_Hash (Proc);
+         -- Add it to the list.
+         Insert_Incr (Last, Proc);
+      end if;
+      -- Create the implicit function endfile declaration.
+      Func := Create_Iir (Iir_Kind_Implicit_Function_Declaration);
+      Set_Identifier (Func, Std_Names.Name_Endfile);
+      Set_Location (Func, Loc);
+      Set_Parent (Func, Get_Parent (Decl));
+      Set_Type_Reference (Func, Decl);
+      Set_Visible_Flag (Func, True);
+      Build_Init (Last_Interface);
+      Inter := Create_Iir (File_Interface_Kind);
+      Set_Identifier (Inter, Std_Names.Name_F);
+      Set_Location (Inter, Loc);
+      Set_Type (Inter, Type_Definition);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Append (Last_Interface, Func, Inter);
+      Set_Return_Type (Func, Std_Package.Boolean_Type_Definition);
+      Set_Implicit_Definition (Func, Iir_Predefined_Endfile);
+      Compute_Subprogram_Hash (Func);
+      -- Add it to the list.
+      Insert_Incr (Last, Func);
+   end Create_Implicit_File_Primitives;
+
+   function Create_Anonymous_Interface (Atype : Iir)
+     return Iir_Interface_Constant_Declaration
+   is
+      Inter : Iir_Interface_Constant_Declaration;
+   begin
+      Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+      Location_Copy (Inter, Atype);
+      Set_Identifier (Inter, Null_Identifier);
+      Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+      Set_Mode (Inter, Iir_In_Mode);
+      Set_Type (Inter, Atype);
+      return Inter;
+   end Create_Anonymous_Interface;
+
+   procedure Create_Implicit_Operations
+     (Decl : Iir; Is_Std_Standard : Boolean := False)
+   is
+      use Std_Names;
+      Binary_Chain : Iir;
+      Unary_Chain : Iir;
+      Type_Definition : Iir;
+      Last : Iir;
+
+      procedure Add_Operation
+        (Name : Name_Id;
+         Def : Iir_Predefined_Functions;
+         Interface_Chain : Iir;
+         Return_Type : Iir)
+      is
+         Operation : Iir_Implicit_Function_Declaration;
+      begin
+         Operation := Create_Iir (Iir_Kind_Implicit_Function_Declaration);
+         Location_Copy (Operation, Decl);
+         Set_Parent (Operation, Get_Parent (Decl));
+         Set_Interface_Declaration_Chain (Operation, Interface_Chain);
+         Set_Type_Reference (Operation, Decl);
+         Set_Return_Type (Operation, Return_Type);
+         Set_Implicit_Definition (Operation, Def);
+         Set_Identifier (Operation, Name);
+         Set_Visible_Flag (Operation, True);
+         Compute_Subprogram_Hash (Operation);
+         Insert_Incr (Last, Operation);
+      end Add_Operation;
+
+      procedure Add_Relational (Name : Name_Id; Def : Iir_Predefined_Functions)
+      is
+      begin
+         Add_Operation
+           (Name, Def, Binary_Chain, Std_Package.Boolean_Type_Definition);
+      end Add_Relational;
+
+      procedure Add_Binary (Name : Name_Id; Def : Iir_Predefined_Functions) is
+      begin
+         Add_Operation (Name, Def, Binary_Chain, Type_Definition);
+      end Add_Binary;
+
+      procedure Add_Unary (Name : Name_Id; Def : Iir_Predefined_Functions) is
+      begin
+         Add_Operation (Name, Def, Unary_Chain, Type_Definition);
+      end Add_Unary;
+
+      procedure Add_To_String (Def : Iir_Predefined_Functions) is
+      begin
+         Add_Operation (Name_To_String, Def,
+                        Unary_Chain, String_Type_Definition);
+      end Add_To_String;
+
+      procedure Add_Min_Max (Name : Name_Id; Def : Iir_Predefined_Functions)
+      is
+         Left, Right : Iir;
+      begin
+         Left := Create_Anonymous_Interface (Type_Definition);
+         Set_Identifier (Left, Name_L);
+         Right := Create_Anonymous_Interface (Type_Definition);
+         Set_Identifier (Right, Name_R);
+         Set_Chain (Left, Right);
+         Add_Operation (Name, Def, Left, Type_Definition);
+      end Add_Min_Max;
+
+      procedure Add_Vector_Min_Max
+        (Name : Name_Id; Def : Iir_Predefined_Functions)
+      is
+         Left : Iir;
+      begin
+         Left := Create_Anonymous_Interface (Type_Definition);
+         Set_Identifier (Left, Name_L);
+         Add_Operation
+           (Name, Def, Left, Get_Element_Subtype (Type_Definition));
+      end Add_Vector_Min_Max;
+
+      procedure Add_Shift_Operators
+      is
+         Inter_Chain : Iir_Interface_Constant_Declaration;
+         Inter_Int : Iir;
+      begin
+         Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+
+         Inter_Int := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+         Location_Copy (Inter_Int, Decl);
+         Set_Identifier (Inter_Int, Null_Identifier);
+         Set_Mode (Inter_Int, Iir_In_Mode);
+         Set_Type (Inter_Int, Std_Package.Integer_Subtype_Definition);
+         Set_Lexical_Layout (Inter_Int, Iir_Lexical_Has_Type);
+
+         Set_Chain (Inter_Chain, Inter_Int);
+
+         Add_Operation
+           (Name_Sll, Iir_Predefined_Array_Sll, Inter_Chain, Type_Definition);
+         Add_Operation
+           (Name_Srl, Iir_Predefined_Array_Srl, Inter_Chain, Type_Definition);
+         Add_Operation
+           (Name_Sla, Iir_Predefined_Array_Sla, Inter_Chain, Type_Definition);
+         Add_Operation
+           (Name_Sra, Iir_Predefined_Array_Sra, Inter_Chain, Type_Definition);
+         Add_Operation
+           (Name_Rol, Iir_Predefined_Array_Rol, Inter_Chain, Type_Definition);
+         Add_Operation
+           (Name_Ror, Iir_Predefined_Array_Ror, Inter_Chain, Type_Definition);
+      end Add_Shift_Operators;
+   begin
+      Last := Decl;
+
+      Type_Definition := Get_Base_Type (Get_Type_Definition (Decl));
+      if Get_Kind (Type_Definition) /= Iir_Kind_File_Type_Definition then
+         Unary_Chain := Create_Anonymous_Interface (Type_Definition);
+         Binary_Chain := Create_Anonymous_Interface (Type_Definition);
+         Set_Chain (Binary_Chain, Unary_Chain);
+      end if;
+
+      case Get_Kind (Type_Definition) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Add_Relational (Name_Op_Equality, Iir_Predefined_Enum_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Enum_Inequality);
+            Add_Relational (Name_Op_Greater, Iir_Predefined_Enum_Greater);
+            Add_Relational
+              (Name_Op_Greater_Equal, Iir_Predefined_Enum_Greater_Equal);
+            Add_Relational (Name_Op_Less, Iir_Predefined_Enum_Less);
+            Add_Relational
+              (Name_Op_Less_Equal, Iir_Predefined_Enum_Less_Equal);
+
+            if Flags.Vhdl_Std >= Vhdl_08 then
+               --  LRM08 5.2.6 Predefined operations on scalar types
+               --  Given a type declaration that declares a scalar type T, the
+               --  following operations are implicitely declared immediately
+               --  following the type declaration (except for the TO_STRING
+               --  operations in package STANDARD [...])
+               Add_Min_Max (Name_Minimum, Iir_Predefined_Enum_Minimum);
+               Add_Min_Max (Name_Maximum, Iir_Predefined_Enum_Maximum);
+               if not Is_Std_Standard then
+                  Add_To_String (Iir_Predefined_Enum_To_String);
+               end if;
+
+               --  LRM08 9.2.3 Relational operators
+               --  The matching relational operators are predefined for the
+               --  [predefined type BIT and for the] type STD_ULOGIC defined
+               --  in package STD_LOGIC_1164.
+               if Type_Definition = Ieee.Std_Logic_1164.Std_Ulogic_Type then
+                  Add_Binary (Name_Op_Match_Equality,
+                              Iir_Predefined_Std_Ulogic_Match_Equality);
+                  Add_Binary (Name_Op_Match_Inequality,
+                              Iir_Predefined_Std_Ulogic_Match_Inequality);
+                  Add_Binary (Name_Op_Match_Less,
+                              Iir_Predefined_Std_Ulogic_Match_Less);
+                  Add_Binary (Name_Op_Match_Less_Equal,
+                              Iir_Predefined_Std_Ulogic_Match_Less_Equal);
+                  Add_Binary (Name_Op_Match_Greater,
+                              Iir_Predefined_Std_Ulogic_Match_Greater);
+                  Add_Binary (Name_Op_Match_Greater_Equal,
+                              Iir_Predefined_Std_Ulogic_Match_Greater_Equal);
+               end if;
+            end if;
+
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Element_Type : Iir;
+
+               Element_Array_Inter_Chain : Iir;
+               Array_Element_Inter_Chain : Iir;
+               Element_Element_Inter_Chain : Iir;
+            begin
+               Add_Relational
+                 (Name_Op_Equality, Iir_Predefined_Array_Equality);
+               Add_Relational
+                 (Name_Op_Inequality, Iir_Predefined_Array_Inequality);
+               if Is_Discrete_Array (Type_Definition) then
+                  Add_Relational
+                    (Name_Op_Greater, Iir_Predefined_Array_Greater);
+                  Add_Relational
+                    (Name_Op_Greater_Equal,
+                     Iir_Predefined_Array_Greater_Equal);
+                  Add_Relational
+                    (Name_Op_Less, Iir_Predefined_Array_Less);
+                  Add_Relational
+                    (Name_Op_Less_Equal, Iir_Predefined_Array_Less_Equal);
+
+                  --  LRM08 5.3.2.4 Predefined operations on array types
+                  --  Given a type declaration that declares a discrete array
+                  --  type T, the following operatons are implicitly declared
+                  --  immediately following the type declaration:
+                  --   function MINIMUM (L, R : T) return T;
+                  --   function MAXIMUM (L, R : T) return T;
+                  if Vhdl_Std >= Vhdl_08 then
+                     Add_Min_Max (Name_Maximum, Iir_Predefined_Array_Maximum);
+                     Add_Min_Max (Name_Minimum, Iir_Predefined_Array_Minimum);
+                  end if;
+               end if;
+
+               Element_Type := Get_Element_Subtype (Type_Definition);
+
+               if Is_One_Dimensional_Array_Type (Type_Definition) then
+                  --  LRM93 7.2.4 Adding operators
+                  --  The concatenation operator & is predefined for any
+                  --  one-dimensional array type.
+                  Add_Operation (Name_Op_Concatenation,
+                                 Iir_Predefined_Array_Array_Concat,
+                                 Binary_Chain,
+                                 Type_Definition);
+
+                  Element_Array_Inter_Chain :=
+                    Create_Anonymous_Interface (Element_Type);
+                  Set_Chain (Element_Array_Inter_Chain, Unary_Chain);
+                  Add_Operation (Name_Op_Concatenation,
+                                 Iir_Predefined_Element_Array_Concat,
+                                 Element_Array_Inter_Chain,
+                                 Type_Definition);
+
+                  Array_Element_Inter_Chain :=
+                    Create_Anonymous_Interface (Type_Definition);
+                  Set_Chain (Array_Element_Inter_Chain,
+                             Create_Anonymous_Interface (Element_Type));
+                  Add_Operation (Name_Op_Concatenation,
+                                 Iir_Predefined_Array_Element_Concat,
+                                 Array_Element_Inter_Chain,
+                                 Type_Definition);
+
+                  Element_Element_Inter_Chain :=
+                    Create_Anonymous_Interface (Element_Type);
+                  Set_Chain (Element_Element_Inter_Chain,
+                             Create_Anonymous_Interface (Element_Type));
+                  Add_Operation (Name_Op_Concatenation,
+                                 Iir_Predefined_Element_Element_Concat,
+                                 Element_Element_Inter_Chain,
+                                 Type_Definition);
+
+                  --  LRM08 5.3.2.4 Predefined operations on array types
+                  --  In addition, given a type declaration that declares a
+                  --  one-dimensional array type T whose elements are of a
+                  --  sclar type E, the following operations are implicitly
+                  --  declared immediately following the type declaration:
+                  --   function MINIMUM (L : T) return E;
+                  --   function MAXIMUM (L : T) return E;
+                  if Vhdl_Std >= Vhdl_08
+                    and then (Get_Kind (Element_Type) in
+                                Iir_Kinds_Scalar_Type_Definition)
+                  then
+                     Add_Vector_Min_Max
+                       (Name_Maximum, Iir_Predefined_Vector_Maximum);
+                     Add_Vector_Min_Max
+                       (Name_Minimum, Iir_Predefined_Vector_Minimum);
+                  end if;
+
+                  if Element_Type = Std_Package.Boolean_Type_Definition
+                    or else Element_Type = Std_Package.Bit_Type_Definition
+                  then
+                     --  LRM93 7.2.1 Logical operators
+                     --  LRM08 9.2.2 Logical operators
+                     --  The binary logical operators AND, OR, NAND, NOR, XOR,
+                     --  and XNOR, and the unary logical operator NOT are
+                     --  defined for predefined types BIT and BOOLEAN.  They
+                     --  are also defined for any one-dimensional array type
+                     --  whose element type is BIT or BOOLEAN.
+
+                     Add_Unary (Name_Not, Iir_Predefined_TF_Array_Not);
+
+                     Add_Binary (Name_And, Iir_Predefined_TF_Array_And);
+                     Add_Binary (Name_Or, Iir_Predefined_TF_Array_Or);
+                     Add_Binary (Name_Nand, Iir_Predefined_TF_Array_Nand);
+                     Add_Binary (Name_Nor, Iir_Predefined_TF_Array_Nor);
+                     Add_Binary (Name_Xor, Iir_Predefined_TF_Array_Xor);
+                     if Flags.Vhdl_Std > Vhdl_87 then
+                        Add_Binary (Name_Xnor, Iir_Predefined_TF_Array_Xnor);
+
+                        --  LRM93 7.2.3 Shift operators
+                        --  The shift operators SLL, SRL, SLA, SRA, ROL and
+                        --  ROR are defined for any one-dimensional array type
+                        --  whose element type is either of the predefined
+                        --  types BIT or BOOLEAN.
+                        Add_Shift_Operators;
+                     end if;
+
+                     --  LRM08 9.2.2 Logical operators
+                     --  For the binary operators AND, OR, NAND, NOR, XOR and
+                     --  XNOR, the operands shall both be [of the same base
+                     --  type,] or one operand shall be of a scalar type and
+                     --  the other operand shall be a one-dimensional array
+                     --  whose element type is the scalar type.  The result
+                     --  type is the same as the base type of the operands if
+                     --  [both operands are scalars of the same base type or]
+                     --  both operands are arrays, or the same as the base type
+                     --  of the array operand if one operand is a scalar and
+                     --  the other operand is an array.
+                     if Flags.Vhdl_Std >= Vhdl_08 then
+                        Add_Operation
+                          (Name_And, Iir_Predefined_TF_Element_Array_And,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_And, Iir_Predefined_TF_Array_Element_And,
+                           Array_Element_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Or, Iir_Predefined_TF_Element_Array_Or,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Or, Iir_Predefined_TF_Array_Element_Or,
+                           Array_Element_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Nand, Iir_Predefined_TF_Element_Array_Nand,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Nand, Iir_Predefined_TF_Array_Element_Nand,
+                           Array_Element_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Nor, Iir_Predefined_TF_Element_Array_Nor,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Nor, Iir_Predefined_TF_Array_Element_Nor,
+                           Array_Element_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Xor, Iir_Predefined_TF_Element_Array_Xor,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Xor, Iir_Predefined_TF_Array_Element_Xor,
+                           Array_Element_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Xnor, Iir_Predefined_TF_Element_Array_Xnor,
+                           Element_Array_Inter_Chain, Type_Definition);
+                        Add_Operation
+                          (Name_Xnor, Iir_Predefined_TF_Array_Element_Xnor,
+                           Array_Element_Inter_Chain, Type_Definition);
+                     end if;
+
+                     if Flags.Vhdl_Std >= Vhdl_08 then
+                        --  LRM08 9.2.2 Logical operations
+                        --  The unary logical operators AND, OR, NAND, NOR,
+                        --  XOR, and XNOR are referred to as logical reduction
+                        --  operators.  The logical reduction operators are
+                        --  predefined for any one-dimensional array type whose
+                        --  element type is BIT or BOOLEAN.  The result type
+                        --  for the logical reduction operators is the same as
+                        --  the element type of the operand.
+                        Add_Operation
+                          (Name_And, Iir_Predefined_TF_Reduction_And,
+                           Unary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Or, Iir_Predefined_TF_Reduction_Or,
+                           Unary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Nand, Iir_Predefined_TF_Reduction_Nand,
+                           Unary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Nor, Iir_Predefined_TF_Reduction_Nor,
+                           Unary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Xor, Iir_Predefined_TF_Reduction_Xor,
+                           Unary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Xnor, Iir_Predefined_TF_Reduction_Xnor,
+                           Unary_Chain, Element_Type);
+                     end if;
+                  end if;
+
+                  --  LRM08 9.2.3 Relational operators
+                  --  The matching equality and matching inequality operatotrs
+                  --  are also defined for any one-dimensional array type
+                  --  whose element type is BIT or STD_ULOGIC.
+                  if Flags.Vhdl_Std >= Vhdl_08 then
+                     if Element_Type = Std_Package.Bit_Type_Definition then
+                        Add_Operation
+                          (Name_Op_Match_Equality,
+                           Iir_Predefined_Bit_Array_Match_Equality,
+                           Binary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Op_Match_Inequality,
+                           Iir_Predefined_Bit_Array_Match_Inequality,
+                           Binary_Chain, Element_Type);
+                     elsif Element_Type = Ieee.Std_Logic_1164.Std_Ulogic_Type
+                     then
+                        Add_Operation
+                          (Name_Op_Match_Equality,
+                           Iir_Predefined_Std_Ulogic_Array_Match_Equality,
+                           Binary_Chain, Element_Type);
+                        Add_Operation
+                          (Name_Op_Match_Inequality,
+                           Iir_Predefined_Std_Ulogic_Array_Match_Inequality,
+                           Binary_Chain, Element_Type);
+                     end if;
+                  end if;
+
+                  --  LRM08 5.3.2.4  Predefined operations on array type
+                  --
+                  --  Given a type declaration that declares a one-dimensional
+                  --  array type T whose element type is a character type that
+                  --  contains only character literals, the following operation
+                  --  is implicitely declared immediately following the type
+                  --  declaration
+                  if Vhdl_Std >= Vhdl_08
+                    and then String_Type_Definition /= Null_Iir
+                    and then (Get_Kind (Element_Type)
+                                = Iir_Kind_Enumeration_Type_Definition)
+                    and then Get_Only_Characters_Flag (Element_Type)
+                  then
+                     Add_Operation (Name_To_String,
+                                    Iir_Predefined_Array_Char_To_String,
+                                    Unary_Chain,
+                                    String_Type_Definition);
+                  end if;
+               end if;
+            end;
+
+         when Iir_Kind_Access_Type_Definition =>
+            Add_Relational (Name_Op_Equality, Iir_Predefined_Access_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Access_Inequality);
+            declare
+               Deallocate_Proc: Iir_Implicit_Procedure_Declaration;
+               Var_Interface: Iir_Interface_Variable_Declaration;
+            begin
+               Deallocate_Proc :=
+                 Create_Iir (Iir_Kind_Implicit_Procedure_Declaration);
+               Set_Identifier (Deallocate_Proc, Std_Names.Name_Deallocate);
+               Set_Implicit_Definition
+                 (Deallocate_Proc, Iir_Predefined_Deallocate);
+               Var_Interface :=
+                 Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+               Set_Identifier (Var_Interface, Std_Names.Name_P);
+               Set_Type (Var_Interface, Type_Definition);
+               Set_Mode (Var_Interface, Iir_Inout_Mode);
+               Set_Lexical_Layout (Var_Interface, Iir_Lexical_Has_Type);
+               --Set_Purity_State (Deallocate_Proc, Impure);
+               Set_Wait_State (Deallocate_Proc, False);
+               Set_Type_Reference (Deallocate_Proc, Decl);
+               Set_Visible_Flag (Deallocate_Proc, True);
+
+               Set_Interface_Declaration_Chain
+                 (Deallocate_Proc, Var_Interface);
+               Compute_Subprogram_Hash (Deallocate_Proc);
+               Insert_Incr (Last, Deallocate_Proc);
+            end;
+
+         when Iir_Kind_Record_Type_Definition =>
+            Add_Relational (Name_Op_Equality, Iir_Predefined_Record_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Record_Inequality);
+
+         when Iir_Kind_Integer_Type_Definition =>
+            Add_Relational (Name_Op_Equality, Iir_Predefined_Integer_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Integer_Inequality);
+            Add_Relational (Name_Op_Greater, Iir_Predefined_Integer_Greater);
+            Add_Relational
+              (Name_Op_Greater_Equal, Iir_Predefined_Integer_Greater_Equal);
+            Add_Relational (Name_Op_Less, Iir_Predefined_Integer_Less);
+            Add_Relational
+              (Name_Op_Less_Equal, Iir_Predefined_Integer_Less_Equal);
+
+            Add_Binary (Name_Op_Plus, Iir_Predefined_Integer_Plus);
+            Add_Binary (Name_Op_Minus, Iir_Predefined_Integer_Minus);
+
+            Add_Unary (Name_Op_Minus, Iir_Predefined_Integer_Negation);
+            Add_Unary (Name_Op_Plus, Iir_Predefined_Integer_Identity);
+
+            Add_Binary (Name_Op_Mul, Iir_Predefined_Integer_Mul);
+            Add_Binary (Name_Op_Div, Iir_Predefined_Integer_Div);
+            Add_Binary (Name_Mod, Iir_Predefined_Integer_Mod);
+            Add_Binary (Name_Rem, Iir_Predefined_Integer_Rem);
+
+            Add_Unary (Name_Abs, Iir_Predefined_Integer_Absolute);
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+               Set_Chain
+                 (Inter_Chain,
+                  Create_Anonymous_Interface (Integer_Type_Definition));
+               Add_Operation (Name_Op_Exp, Iir_Predefined_Integer_Exp,
+                              Inter_Chain, Type_Definition);
+            end;
+
+            if Vhdl_Std >= Vhdl_08 then
+               --  LRM08 5.2.6 Predefined operations on scalar types
+               --  Given a type declaration that declares a scalar type T, the
+               --  following operations are implicitely declared immediately
+               --  following the type declaration (except for the TO_STRING
+               --  operations in package STANDARD [...])
+               Add_Min_Max (Name_Minimum, Iir_Predefined_Integer_Minimum);
+               Add_Min_Max (Name_Maximum, Iir_Predefined_Integer_Maximum);
+               if not Is_Std_Standard then
+                  Add_To_String (Iir_Predefined_Integer_To_String);
+               end if;
+            end if;
+
+         when Iir_Kind_Floating_Type_Definition =>
+            Add_Relational
+              (Name_Op_Equality, Iir_Predefined_Floating_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Floating_Inequality);
+            Add_Relational
+              (Name_Op_Greater, Iir_Predefined_Floating_Greater);
+            Add_Relational
+              (Name_Op_Greater_Equal, Iir_Predefined_Floating_Greater_Equal);
+            Add_Relational
+              (Name_Op_Less, Iir_Predefined_Floating_Less);
+            Add_Relational
+              (Name_Op_Less_Equal, Iir_Predefined_Floating_Less_Equal);
+
+            Add_Binary (Name_Op_Plus, Iir_Predefined_Floating_Plus);
+            Add_Binary (Name_Op_Minus, Iir_Predefined_Floating_Minus);
+
+            Add_Unary (Name_Op_Minus, Iir_Predefined_Floating_Negation);
+            Add_Unary (Name_Op_Plus, Iir_Predefined_Floating_Identity);
+
+            Add_Binary (Name_Op_Mul, Iir_Predefined_Floating_Mul);
+            Add_Binary (Name_Op_Div, Iir_Predefined_Floating_Div);
+
+            Add_Unary (Name_Abs, Iir_Predefined_Floating_Absolute);
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+               Set_Chain
+                 (Inter_Chain,
+                  Create_Anonymous_Interface (Integer_Type_Definition));
+               Add_Operation (Name_Op_Exp, Iir_Predefined_Floating_Exp,
+                              Inter_Chain, Type_Definition);
+            end;
+
+            if Vhdl_Std >= Vhdl_08 then
+               --  LRM08 5.2.6 Predefined operations on scalar types
+               --  Given a type declaration that declares a scalar type T, the
+               --  following operations are implicitely declared immediately
+               --  following the type declaration (except for the TO_STRING
+               --  operations in package STANDARD [...])
+               Add_Min_Max (Name_Minimum, Iir_Predefined_Floating_Minimum);
+               Add_Min_Max (Name_Maximum, Iir_Predefined_Floating_Maximum);
+               if not Is_Std_Standard then
+                  Add_To_String (Iir_Predefined_Floating_To_String);
+               end if;
+            end if;
+
+         when Iir_Kind_Physical_Type_Definition =>
+            Add_Relational
+              (Name_Op_Equality, Iir_Predefined_Physical_Equality);
+            Add_Relational
+              (Name_Op_Inequality, Iir_Predefined_Physical_Inequality);
+            Add_Relational
+              (Name_Op_Greater, Iir_Predefined_Physical_Greater);
+            Add_Relational
+              (Name_Op_Greater_Equal, Iir_Predefined_Physical_Greater_Equal);
+            Add_Relational
+              (Name_Op_Less, Iir_Predefined_Physical_Less);
+            Add_Relational
+              (Name_Op_Less_Equal, Iir_Predefined_Physical_Less_Equal);
+
+            Add_Binary (Name_Op_Plus, Iir_Predefined_Physical_Plus);
+            Add_Binary (Name_Op_Minus, Iir_Predefined_Physical_Minus);
+
+            Add_Unary (Name_Op_Minus, Iir_Predefined_Physical_Negation);
+            Add_Unary (Name_Op_Plus, Iir_Predefined_Physical_Identity);
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+               Set_Chain
+                 (Inter_Chain,
+                  Create_Anonymous_Interface (Integer_Type_Definition));
+               Add_Operation (Name_Op_Mul, Iir_Predefined_Physical_Integer_Mul,
+                              Inter_Chain, Type_Definition);
+               Add_Operation (Name_Op_Div, Iir_Predefined_Physical_Integer_Div,
+                              Inter_Chain, Type_Definition);
+            end;
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain :=
+                 Create_Anonymous_Interface (Integer_Type_Definition);
+               Set_Chain (Inter_Chain, Unary_Chain);
+               Add_Operation (Name_Op_Mul, Iir_Predefined_Integer_Physical_Mul,
+                              Inter_Chain, Type_Definition);
+            end;
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+               Set_Chain (Inter_Chain,
+                          Create_Anonymous_Interface (Real_Type_Definition));
+               Add_Operation (Name_Op_Mul, Iir_Predefined_Physical_Real_Mul,
+                              Inter_Chain, Type_Definition);
+               Add_Operation (Name_Op_Div, Iir_Predefined_Physical_Real_Div,
+                              Inter_Chain, Type_Definition);
+            end;
+
+            declare
+               Inter_Chain : Iir;
+            begin
+               Inter_Chain :=
+                 Create_Anonymous_Interface (Real_Type_Definition);
+               Set_Chain (Inter_Chain, Unary_Chain);
+               Add_Operation (Name_Op_Mul, Iir_Predefined_Real_Physical_Mul,
+                              Inter_Chain, Type_Definition);
+            end;
+            Add_Operation (Name_Op_Div, Iir_Predefined_Physical_Physical_Div,
+                           Binary_Chain,
+                           Std_Package.Convertible_Integer_Type_Definition);
+
+            Add_Unary (Name_Abs, Iir_Predefined_Physical_Absolute);
+
+            if Vhdl_Std >= Vhdl_08 then
+               --  LRM08 5.2.6 Predefined operations on scalar types
+               --  Given a type declaration that declares a scalar type T, the
+               --  following operations are implicitely declared immediately
+               --  following the type declaration (except for the TO_STRING
+               --  operations in package STANDARD [...])
+               Add_Min_Max (Name_Minimum, Iir_Predefined_Physical_Minimum);
+               Add_Min_Max (Name_Maximum, Iir_Predefined_Physical_Maximum);
+               if not Is_Std_Standard then
+                  Add_To_String (Iir_Predefined_Physical_To_String);
+               end if;
+            end if;
+
+         when Iir_Kind_File_Type_Definition =>
+            Create_Implicit_File_Primitives (Decl, Type_Definition);
+
+         when Iir_Kind_Protected_Type_Declaration =>
+            null;
+
+         when others =>
+            Error_Kind ("create_predefined_operations", Type_Definition);
+      end case;
+
+      if not Is_Std_Standard then
+         return;
+      end if;
+      if Decl = Std_Package.Boolean_Type_Declaration then
+         Add_Binary (Name_And, Iir_Predefined_Boolean_And);
+         Add_Binary (Name_Or, Iir_Predefined_Boolean_Or);
+         Add_Binary (Name_Nand, Iir_Predefined_Boolean_Nand);
+         Add_Binary (Name_Nor, Iir_Predefined_Boolean_Nor);
+         Add_Binary (Name_Xor, Iir_Predefined_Boolean_Xor);
+         if Flags.Vhdl_Std > Vhdl_87 then
+            Add_Binary (Name_Xnor, Iir_Predefined_Boolean_Xnor);
+         end if;
+         Add_Unary (Name_Not, Iir_Predefined_Boolean_Not);
+      elsif Decl = Std_Package.Bit_Type_Declaration then
+         Add_Binary (Name_And, Iir_Predefined_Bit_And);
+         Add_Binary (Name_Or, Iir_Predefined_Bit_Or);
+         Add_Binary (Name_Nand, Iir_Predefined_Bit_Nand);
+         Add_Binary (Name_Nor, Iir_Predefined_Bit_Nor);
+         Add_Binary (Name_Xor, Iir_Predefined_Bit_Xor);
+         if Flags.Vhdl_Std > Vhdl_87 then
+            Add_Binary (Name_Xnor, Iir_Predefined_Bit_Xnor);
+         end if;
+         Add_Unary (Name_Not, Iir_Predefined_Bit_Not);
+         if Flags.Vhdl_Std >= Vhdl_08 then
+            Add_Binary (Name_Op_Match_Equality,
+                        Iir_Predefined_Bit_Match_Equality);
+            Add_Binary (Name_Op_Match_Inequality,
+                        Iir_Predefined_Bit_Match_Inequality);
+            Add_Binary (Name_Op_Match_Less,
+                        Iir_Predefined_Bit_Match_Less);
+            Add_Binary (Name_Op_Match_Less_Equal,
+                        Iir_Predefined_Bit_Match_Less_Equal);
+            Add_Binary (Name_Op_Match_Greater,
+                        Iir_Predefined_Bit_Match_Greater);
+            Add_Binary (Name_Op_Match_Greater_Equal,
+                        Iir_Predefined_Bit_Match_Greater_Equal);
+
+            --  LRM08 9.2.9 Condition operator
+            --  The unary operator ?? is predefined for type BIT defined in
+            --  package STANDARD.
+            Add_Operation (Name_Op_Condition, Iir_Predefined_Bit_Condition,
+                           Unary_Chain, Std_Package.Boolean_Type_Definition);
+
+         end if;
+      elsif Decl = Std_Package.Universal_Real_Type_Declaration then
+         declare
+            Inter_Chain : Iir;
+         begin
+            Inter_Chain := Create_Anonymous_Interface (Type_Definition);
+            Set_Chain
+              (Inter_Chain,
+               Create_Anonymous_Interface (Universal_Integer_Type_Definition));
+            Add_Operation (Name_Op_Mul, Iir_Predefined_Universal_R_I_Mul,
+                           Inter_Chain, Type_Definition);
+            Add_Operation (Name_Op_Div, Iir_Predefined_Universal_R_I_Div,
+                           Inter_Chain, Type_Definition);
+         end;
+
+         declare
+            Inter_Chain : Iir;
+         begin
+            Inter_Chain :=
+              Create_Anonymous_Interface (Universal_Integer_Type_Definition);
+            Set_Chain (Inter_Chain, Unary_Chain);
+            Add_Operation (Name_Op_Mul, Iir_Predefined_Universal_I_R_Mul,
+                           Inter_Chain, Type_Definition);
+         end;
+      end if;
+   end Create_Implicit_Operations;
+
+   procedure Sem_Type_Declaration (Decl: Iir; Is_Global : Boolean)
+   is
+      Def: Iir;
+      Inter : Name_Interpretation_Type;
+      Old_Decl : Iir;
+      St_Decl : Iir_Subtype_Declaration;
+      Bt_Def : Iir;
+   begin
+      --  Check if DECL complete a previous incomplete type declaration.
+      Inter := Get_Interpretation (Get_Identifier (Decl));
+      if Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      then
+         Old_Decl := Get_Declaration (Inter);
+         if Get_Kind (Old_Decl) /= Iir_Kind_Type_Declaration
+           or else (Get_Kind (Get_Type_Definition (Old_Decl)) /=
+                      Iir_Kind_Incomplete_Type_Definition)
+         then
+            Old_Decl := Null_Iir;
+         end if;
+      else
+         Old_Decl := Null_Iir;
+      end if;
+
+      if Old_Decl = Null_Iir then
+         if Get_Kind (Decl) = Iir_Kind_Type_Declaration then
+            --  This is necessary at least for enumeration type definition.
+            Sem_Scopes.Add_Name (Decl);
+         end if;
+      else
+         --  This is a way to prevent:
+         --    type a;
+         --    type a is access a;
+         --  which is non-sense.
+         Set_Visible_Flag (Old_Decl, False);
+      end if;
+
+      -- Check the definition of the type.
+      Def := Get_Type_Definition (Decl);
+      if Def = Null_Iir then
+         --  Incomplete type declaration
+         Def := Create_Iir (Iir_Kind_Incomplete_Type_Definition);
+         Location_Copy (Def, Decl);
+         Set_Type_Definition (Decl, Def);
+         Set_Base_Type (Def, Def);
+         Set_Signal_Type_Flag (Def, True);
+         Set_Type_Declarator (Def, Decl);
+         Set_Visible_Flag (Decl, True);
+         Set_Incomplete_Type_List (Def, Create_Iir_List);
+         Xref_Decl (Decl);
+      else
+         --  A complete type declaration.
+         if Old_Decl = Null_Iir then
+            Xref_Decl (Decl);
+         else
+            Xref_Body (Decl, Old_Decl);
+         end if;
+
+         Def := Sem_Type_Definition (Def, Decl);
+
+         if Def /= Null_Iir then
+            case Get_Kind (Def) is
+               when Iir_Kind_Integer_Subtype_Definition
+                 | Iir_Kind_Floating_Subtype_Definition
+                 | Iir_Kind_Physical_Subtype_Definition
+                 | Iir_Kind_Array_Subtype_Definition =>
+                  --  Some type declaration are in fact subtype declarations.
+                  St_Decl := Create_Iir (Iir_Kind_Subtype_Declaration);
+                  Location_Copy (St_Decl, Decl);
+                  Set_Identifier (St_Decl, Get_Identifier (Decl));
+                  Set_Type (St_Decl, Def);
+                  Set_Type_Declarator (Def, St_Decl);
+                  Set_Chain (St_Decl, Get_Chain (Decl));
+                  Set_Chain (Decl, St_Decl);
+
+                  --  The type declaration declares the base type.
+                  Bt_Def := Get_Base_Type (Def);
+                  Set_Type_Definition (Decl, Bt_Def);
+                  Set_Type_Declarator (Bt_Def, Decl);
+                  Set_Subtype_Definition (Decl, Def);
+
+                  if Old_Decl = Null_Iir then
+                     Sem_Scopes.Add_Name (St_Decl);
+                  else
+                     Replace_Name (Get_Identifier (Decl), Old_Decl, St_Decl);
+                     Set_Type_Declarator
+                       (Get_Type_Definition (Old_Decl), St_Decl);
+                  end if;
+
+                  Sem_Scopes.Name_Visible (St_Decl);
+
+                  --  The implicit subprogram will be added in the
+                  -- scope just after.
+                  Create_Implicit_Operations (Decl, False);
+
+               when Iir_Kind_Enumeration_Type_Definition
+                 | Iir_Kind_Array_Type_Definition
+                 | Iir_Kind_Record_Type_Definition
+                 | Iir_Kind_Access_Type_Definition
+                 | Iir_Kind_File_Type_Definition =>
+                  St_Decl := Null_Iir;
+                  Set_Type_Declarator (Def, Decl);
+
+                  Sem_Scopes.Name_Visible (Decl);
+
+                  --  The implicit subprogram will be added in the
+                  -- scope just after.
+                  Create_Implicit_Operations (Decl, False);
+
+               when Iir_Kind_Protected_Type_Declaration =>
+                  Set_Type_Declarator (Def, Decl);
+                  St_Decl := Null_Iir;
+                  --  No implicit subprograms.
+
+               when others =>
+                  Error_Kind ("sem_type_declaration", Def);
+            end case;
+
+            if Old_Decl /= Null_Iir then
+               --  Complete the type definition.
+               declare
+                  List : Iir_List;
+                  El : Iir;
+                  Old_Def : Iir;
+               begin
+                  Old_Def := Get_Type_Definition (Old_Decl);
+                  Set_Signal_Type_Flag (Old_Def, Get_Signal_Type_Flag (Def));
+                  List := Get_Incomplete_Type_List (Old_Def);
+                  for I in Natural loop
+                     El := Get_Nth_Element (List, I);
+                     exit when El = Null_Iir;
+                     Set_Designated_Type (El, Def);
+                  end loop;
+                  --  Complete the incomplete_type_definition node
+                  --  (set type_declarator and base_type).
+
+                  Set_Base_Type (Old_Def, Get_Base_Type (Def));
+                  if St_Decl = Null_Iir then
+                     Set_Type_Declarator (Old_Def, Decl);
+                     Replace_Name (Get_Identifier (Decl), Old_Decl, Decl);
+                  end if;
+               end;
+            end if;
+
+            if Is_Global then
+               Set_Type_Has_Signal (Def);
+            end if;
+         end if;
+      end if;
+   end Sem_Type_Declaration;
+
+   procedure Sem_Subtype_Declaration (Decl: Iir; Is_Global : Boolean)
+   is
+      Def: Iir;
+      Ind : Iir;
+   begin
+      --  Real hack to skip subtype declarations of anonymous type decls.
+      if Get_Visible_Flag (Decl) then
+         return;
+      end if;
+
+      Sem_Scopes.Add_Name (Decl);
+      Xref_Decl (Decl);
+
+      --  Analyze the definition of the type.
+      Ind := Get_Subtype_Indication (Decl);
+      Ind := Sem_Subtype_Indication (Ind);
+      Set_Subtype_Indication (Decl, Ind);
+      Def := Get_Type_Of_Subtype_Indication (Ind);
+      if Def = Null_Iir then
+         return;
+      end if;
+
+      if not Is_Anonymous_Type_Definition (Def) then
+         --  There is no added constraints and therefore the subtype
+         --  declaration is in fact an alias of the type.  Create a copy so
+         --  that it has its own type declarator.
+         Def := Copy_Subtype_Indication (Def);
+         Location_Copy (Def, Decl);
+         Set_Subtype_Type_Mark (Def, Ind);
+         Set_Subtype_Indication (Decl, Def);
+      end if;
+
+      Set_Type (Decl, Def);
+      Set_Type_Declarator (Def, Decl);
+      Name_Visible (Decl);
+      if Is_Global then
+         Set_Type_Has_Signal (Def);
+      end if;
+   end Sem_Subtype_Declaration;
+
+   --  If DECL is a constant declaration, and there is already a constant
+   --  declaration in the current scope with the same name, then return it.
+   --  Otherwise, return NULL.
+   function Get_Deferred_Constant (Decl : Iir) return Iir
+   is
+      Deferred_Const : Iir;
+      Interp : Name_Interpretation_Type;
+   begin
+      if Get_Kind (Decl) /= Iir_Kind_Constant_Declaration then
+         return Null_Iir;
+      end if;
+      Interp := Get_Interpretation (Get_Identifier (Decl));
+      if not Valid_Interpretation (Interp) then
+         return Null_Iir;
+      end if;
+
+      if not Is_In_Current_Declarative_Region (Interp)
+        or else Is_Potentially_Visible (Interp)
+      then
+         --  Deferred and full declarations must be declared in the same
+         --  declarative region.
+         return Null_Iir;
+      end if;
+
+      Deferred_Const := Get_Declaration (Interp);
+      if Get_Kind (Deferred_Const) /= Iir_Kind_Constant_Declaration then
+         return Null_Iir;
+      end if;
+      --  LRM93 4.3.1.1
+      --  The corresponding full constant declaration, which defines the value
+      --  of the constant, must appear in the body of the package.
+      if Get_Kind (Get_Library_Unit (Get_Current_Design_Unit))
+        /= Iir_Kind_Package_Body
+      then
+         Error_Msg_Sem
+           ("full constant declaration must appear in package body", Decl);
+      end if;
+      return Deferred_Const;
+   end Get_Deferred_Constant;
+
+   procedure Sem_Object_Declaration (Decl: Iir; Parent : Iir; Last_Decl : Iir)
+   is
+      Deferred_Const : constant Iir := Get_Deferred_Constant (Decl);
+      Atype: Iir;
+      Default_Value : Iir;
+      Staticness : Iir_Staticness;
+   begin
+      --  LRM08 12.2 Scope of declarations
+      --  Then scope of a declaration [...] extends from the beginning of the
+      --  declaration [...]
+      if Deferred_Const = Null_Iir then
+         Sem_Scopes.Add_Name (Decl);
+         Xref_Decl (Decl);
+      else
+         Xref_Ref (Decl, Deferred_Const);
+      end if;
+
+      --  Semantize type and default value:
+      Atype := Get_Subtype_Indication (Decl);
+      if Atype /= Null_Iir then
+         Atype := Sem_Subtype_Indication (Atype);
+         Set_Subtype_Indication (Decl, Atype);
+         Atype := Get_Type_Of_Subtype_Indication (Atype);
+         if Atype = Null_Iir then
+            Atype := Create_Error_Type (Get_Type (Decl));
+         end if;
+
+         Default_Value := Get_Default_Value (Decl);
+         if Default_Value /= Null_Iir then
+            Default_Value := Sem_Expression (Default_Value, Atype);
+            if Default_Value = Null_Iir then
+               Default_Value :=
+                 Create_Error_Expr (Get_Default_Value (Decl), Atype);
+            end if;
+            Check_Read (Default_Value);
+            Default_Value := Eval_Expr_Check_If_Static (Default_Value, Atype);
+         end if;
+      else
+         Default_Value := Get_Default_Value (Last_Decl);
+         Atype := Get_Type (Last_Decl);
+      end if;
+
+      Set_Type (Decl, Atype);
+      Set_Default_Value (Decl, Default_Value);
+      Set_Name_Staticness (Decl, Locally);
+      Set_Visible_Flag (Decl, True);
+
+      --  LRM93 2.6
+      --  The subtype indication given in the full declaration of the deferred
+      --  constant must conform to that given in the deferred constant
+      --  declaration.
+      if Deferred_Const /= Null_Iir
+        and then not Are_Trees_Equal (Get_Type (Decl),
+                                      Get_Type (Deferred_Const))
+      then
+         Error_Msg_Sem
+           ("subtype indication doesn't conform with the deferred constant",
+            Decl);
+      end if;
+
+      --  LRM 4.3.1.3
+      --  It is an error if a variable declaration declares a variable that is
+      --  of a file type.
+      --
+      --  LRM 4.3.1.1
+      --  It is an error if a constant declaration declares a constant that is
+      --  of a file type, or an access type, or a composite type which has
+      --  subelement that is a file type of an access type.
+      --
+      --  LRM 4.3.1.2
+      --  It is an error if a signal declaration declares a signal that is of
+      --  a file type [or an access type].
+      case Get_Kind (Atype) is
+         when Iir_Kind_File_Type_Definition =>
+            Error_Msg_Sem (Disp_Node (Decl) & " cannot be of type file", Decl);
+         when others =>
+            if Get_Kind (Decl) /= Iir_Kind_Variable_Declaration then
+               Check_Signal_Type (Decl);
+            end if;
+      end case;
+
+      if not Check_Implicit_Conversion (Atype, Default_Value) then
+         Error_Msg_Sem
+           ("default value length does not match object type length", Decl);
+      end if;
+
+      case Get_Kind (Decl) is
+         when Iir_Kind_Constant_Declaration =>
+            --  LRM93 4.3.1.1
+            --  If the assignment symbol ":=" followed by an expression is not
+            --  present in a constant declaration, then the declaration
+            --  declares a deferred constant.
+            --  Such a constant declaration may only appear in a package
+            --  declaration.
+            if Deferred_Const /= Null_Iir then
+               Set_Deferred_Declaration (Decl, Deferred_Const);
+               Set_Deferred_Declaration (Deferred_Const, Decl);
+            end if;
+            if Default_Value = Null_Iir then
+               if Deferred_Const /= Null_Iir then
+                  Error_Msg_Sem
+                    ("full constant declaration must have a default value",
+                     Decl);
+               else
+                  Set_Deferred_Declaration_Flag (Decl, True);
+               end if;
+               if Get_Kind (Parent) /= Iir_Kind_Package_Declaration then
+                  Error_Msg_Sem ("a constant must have a default value", Decl);
+               end if;
+               Set_Expr_Staticness (Decl, Globally);
+            else
+               --  LRM93 7.4.1: a locally static primary is defined:
+               --  A constant (other than deferred constant) explicitly
+               --  declared by a constant declaration and initialized
+               --  with a locally static expression.
+               --  Note: the staticness of the full declaration may be locally.
+               if False and Deferred_Const /= Null_Iir then
+                  --  This is a deferred constant.
+                  Staticness := Globally;
+               else
+                  Staticness := Min (Get_Expr_Staticness (Default_Value),
+                                     Get_Type_Staticness (Atype));
+                  --  What about expr staticness of c in:
+                  --    constant c : bit_vector (a to b) := "01";
+                  --  where a and b are not locally static ?
+                  --Staticness := Get_Expr_Staticness (Default_Value);
+
+                  --  LRM 7.4.2 (Globally static primaries)
+                  --  5. a constant
+                  if Staticness < Globally then
+                     Staticness := Globally;
+                  end if;
+               end if;
+               Set_Expr_Staticness (Decl, Staticness);
+            end if;
+
+         when Iir_Kind_Signal_Declaration =>
+            --  LRM93 4.3.1.2
+            --  It is also an error if a guarded signal of a
+            --  scalar type is neither a resolved signal nor a
+            --  subelement of a resolved signal.
+            if Get_Signal_Kind (Decl) /= Iir_No_Signal_Kind
+              and then not Get_Resolved_Flag (Atype)
+            then
+               Error_Msg_Sem
+                 ("guarded " & Disp_Node (Decl) & " must be resolved", Decl);
+            end if;
+            Set_Expr_Staticness (Decl, None);
+            Set_Has_Disconnect_Flag (Decl, False);
+            Set_Type_Has_Signal (Atype);
+
+         when Iir_Kind_Variable_Declaration =>
+            --  LRM93 4.3.1.3  Variable declarations
+            --  Variable declared immediatly within entity declarations,
+            --  architectures bodies, packages, packages bodies, and blocks
+            --  must be shared variable.
+            --  Variables declared immediatly within subprograms and
+            --  processes must not be shared variables.
+            --  Variables may appear in proteted type bodies; such
+            --  variables, which must not be shared variables, represent
+            --  shared data.
+            case Get_Kind (Parent) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Architecture_Body
+                 | Iir_Kind_Package_Declaration
+                 | Iir_Kind_Package_Body
+                 | Iir_Kind_Block_Statement
+                 | Iir_Kind_Generate_Statement =>
+                  if not Get_Shared_Flag (Decl) then
+                     Error_Msg_Sem
+                       ("non shared variable declaration not allowed here",
+                        Decl);
+                  end if;
+               when Iir_Kinds_Process_Statement
+                 | Iir_Kind_Function_Body
+                 | Iir_Kind_Procedure_Body =>
+                  if Get_Shared_Flag (Decl) then
+                     Error_Msg_Sem
+                       ("shared variable declaration not allowed here", Decl);
+                  end if;
+               when Iir_Kind_Protected_Type_Body =>
+                  if Get_Shared_Flag (Decl) then
+                     Error_Msg_Sem
+                       ("variable of protected type body must not be shared",
+                        Decl);
+                  end if;
+               when Iir_Kind_Protected_Type_Declaration =>
+                  --  This is not allowed, but caught
+                  --  in sem_protected_type_declaration.
+                  null;
+               when others =>
+                  Error_Kind ("sem_object_declaration(2)", Parent);
+            end case;
+
+            if Flags.Vhdl_Std >= Vhdl_00 then
+               declare
+                  Base_Type : Iir;
+                  Is_Protected : Boolean;
+               begin
+                  Base_Type := Get_Base_Type (Atype);
+                  Is_Protected :=
+                    Get_Kind (Base_Type) = Iir_Kind_Protected_Type_Declaration;
+
+                  --  LRM00 4.3.1.3
+                  --  The base type of the subtype indication of a
+                  --  shared variable declaration must be a protected type.
+                  if Get_Shared_Flag (Decl) and not Is_Protected then
+                     Error_Msg_Sem
+                       ("type of a shared variable must be a protected type",
+                        Decl);
+                  end if;
+
+                  --  LRM00 4.3.1.3  Variable declarations
+                  --  If a given variable appears (directly or indirectly)
+                  --  within a protected type body, then the base type
+                  --  denoted by the subtype indication of the variable
+                  --  declarations must not be a protected type defined by
+                  --  the protected type body.
+                  --  FIXME: indirectly ?
+                  if Is_Protected
+                    and then Get_Kind (Parent) = Iir_Kind_Protected_Type_Body
+                    and then Base_Type
+                    = Get_Protected_Type_Declaration (Parent)
+                  then
+                     Error_Msg_Sem
+                       ("variable type must not be of the protected type body",
+                        Decl);
+                  end if;
+               end;
+            end if;
+            Set_Expr_Staticness (Decl, None);
+         when others =>
+            Error_Kind ("sem_object_declaration", Decl);
+      end case;
+
+      case Get_Kind (Decl) is
+         when Iir_Kind_Constant_Declaration =>
+            --  LRM93 §3.2.1.1
+            --  For a constant declared by an object declaration, the index
+            --  ranges are defined by the initial value, if the subtype of the
+            --  constant is unconstrained; otherwise they are defined by this
+            --  subtype.
+            --if Default_Value = Null_Iir
+            --  and then not Sem_Is_Constrained (Atype)
+            --then
+            --   Error_Msg_Sem ("constant declaration of unconstrained "
+            --                  & Disp_Node (Atype) & " is not allowed", Decl);
+            --end if;
+            null;
+            --if Deferred_Const = Null_Iir then
+            --   Name_Visible (Decl);
+            --end if;
+
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Signal_Declaration =>
+            --  LRM93 3.2.1.1 / LRM08 5.3.2.2
+            --  For a variable or signal declared by an object declaration, the
+            --  subtype indication of the corressponding object declaration
+            --  must define a constrained array subtype.
+            if not Is_Fully_Constrained_Type (Atype) then
+               Error_Msg_Sem
+                 ("declaration of " & Disp_Node (Decl)
+                  & " with unconstrained " & Disp_Node (Atype)
+                  & " is not allowed", Decl);
+               if Default_Value /= Null_Iir then
+                  Error_Msg_Sem ("(even with a default value)", Decl);
+               end if;
+            end if;
+
+         when others =>
+            Error_Kind ("sem_object_declaration(2)", Decl);
+      end case;
+   end Sem_Object_Declaration;
+
+   procedure Sem_File_Declaration (Decl: Iir_File_Declaration; Last_Decl : Iir)
+   is
+      Atype: Iir;
+      Logical_Name: Iir;
+      Open_Kind : Iir;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Set_Expr_Staticness (Decl, None);
+      Xref_Decl (Decl);
+
+      -- Try to find a type.
+      Atype := Get_Subtype_Indication (Decl);
+      if Atype /= Null_Iir then
+         Atype := Sem_Subtype_Indication (Atype);
+         Set_Subtype_Indication (Decl, Atype);
+         Atype := Get_Type_Of_Subtype_Indication (Atype);
+         if Atype = Null_Iir then
+            Atype := Create_Error_Type (Get_Type (Decl));
+         end if;
+      else
+         Atype := Get_Type (Last_Decl);
+      end if;
+      Set_Type (Decl, Atype);
+
+      --  LRM93 4.3.1.4
+      --  The subtype indication of a file declaration must define a file
+      --  subtype.
+      if Get_Kind (Atype) /= Iir_Kind_File_Type_Definition then
+         Error_Msg_Sem ("file subtype expected for a file declaration", Decl);
+         return;
+      end if;
+
+      Logical_Name := Get_File_Logical_Name (Decl);
+      --  LRM93 4.3.1.4
+      --  The file logical name must be an expression of predefined type
+      --  STRING.
+      if Logical_Name /= Null_Iir then
+         Logical_Name := Sem_Expression (Logical_Name, String_Type_Definition);
+         if Logical_Name /= Null_Iir then
+            Check_Read (Logical_Name);
+            Set_File_Logical_Name (Decl, Logical_Name);
+         end if;
+      end if;
+
+      Open_Kind := Get_File_Open_Kind (Decl);
+      if Open_Kind /= Null_Iir then
+         Open_Kind :=
+           Sem_Expression (Open_Kind, File_Open_Kind_Type_Definition);
+         if Open_Kind /= Null_Iir then
+            Check_Read (Open_Kind);
+            Set_File_Open_Kind (Decl, Open_Kind);
+         end if;
+      else
+         --  LRM93 4.3.1.4
+         --  If a file open kind expression is not included in the file open
+         --  information of a given file declaration, then the default value
+         --  of READ_MODE is used during elaboration of the file declaration.
+         --
+         --  LRM87 4.3.1.4
+         --  The default mode is IN, if no mode is specified.
+         if Get_Mode (Decl) = Iir_Unknown_Mode then
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Set_Mode (Decl, Iir_In_Mode);
+            else
+               null;
+               --  Set_File_Open_Kind (Decl, File_Open_Kind_Read_Mode);
+            end if;
+         end if;
+      end if;
+      Name_Visible (Decl);
+
+      --  LRM 93 2.2
+      --  If a pure function is the parent of a given procedure, then
+      --  that procedure must not contain a reference to an explicitly
+      --  declared file object [...]
+      --
+      --  A pure function must not contain a reference to an explicitly
+      --  declared file.
+
+      --  Note: this check is also performed when a file is referenced.
+      --    But a file can be declared without being explicitly referenced.
+      if Flags.Vhdl_Std > Vhdl_93c then
+         declare
+            Parent : Iir;
+            Spec : Iir;
+         begin
+            Parent := Get_Parent (Decl);
+            case Get_Kind (Parent) is
+               when Iir_Kind_Function_Body =>
+                  Spec := Get_Subprogram_Specification (Parent);
+                  if Get_Pure_Flag (Spec) then
+                     Error_Msg_Sem
+                       ("cannot declare a file in a pure function", Decl);
+                  end if;
+               when Iir_Kind_Procedure_Body =>
+                  Spec := Get_Subprogram_Specification (Parent);
+                  Set_Purity_State (Spec, Impure);
+                  Set_Impure_Depth (Parent, Iir_Depth_Impure);
+               when Iir_Kind_Function_Declaration
+                 | Iir_Kind_Procedure_Declaration =>
+                  Error_Kind ("sem_file_declaration", Parent);
+               when others =>
+                  null;
+            end case;
+         end;
+      end if;
+   end Sem_File_Declaration;
+
+   procedure Sem_Attribute_Declaration (Decl: Iir_Attribute_Declaration)
+   is
+      A_Type : Iir;
+      Ident : Name_Id;
+   begin
+      --  LRM93 4.4
+      --  The identifier is said to be the designator of the attribute.
+      Ident := Get_Identifier (Decl);
+      if Ident in Std_Names.Name_Id_Attributes
+        or else (Flags.Vhdl_Std = Vhdl_87
+                 and then Ident in Std_Names.Name_Id_Vhdl87_Attributes)
+        or else (Flags.Vhdl_Std > Vhdl_87
+                 and then Ident in Std_Names.Name_Id_Vhdl93_Attributes)
+      then
+         Error_Msg_Sem ("predefined attribute """ & Name_Table.Image (Ident)
+                        & """ overriden", Decl);
+      end if;
+      Sem_Scopes.Add_Name (Decl);
+      Xref_Decl (Decl);
+
+      A_Type := Sem_Type_Mark (Get_Type_Mark (Decl));
+      Set_Type_Mark (Decl, A_Type);
+      A_Type := Get_Type (A_Type);
+      Set_Type (Decl, A_Type);
+
+      --  LRM93 4.4  Attribute declarations.
+      --  It is an error if the type mark denotes an access type, a file type,
+      --  a protected type, or a composite type with a subelement that is
+      --  an access type, a file type, or a protected type.
+      --  The subtype need not be constrained.
+      Check_Signal_Type (Decl);
+      Name_Visible (Decl);
+   end Sem_Attribute_Declaration;
+
+   procedure Sem_Component_Declaration (Component: Iir_Component_Declaration)
+   is
+   begin
+      Sem_Scopes.Add_Name (Component);
+      Xref_Decl (Component);
+
+      --  LRM 10.1 Declarative region
+      --  6. A component declaration.
+      Open_Declarative_Region;
+
+      Sem_Interface_Chain
+        (Get_Generic_Chain (Component), Generic_Interface_List);
+      Sem_Interface_Chain
+        (Get_Port_Chain (Component), Port_Interface_List);
+
+      Close_Declarative_Region;
+
+      Name_Visible (Component);
+   end Sem_Component_Declaration;
+
+   procedure Sem_Object_Alias_Declaration (Alias: Iir_Object_Alias_Declaration)
+   is
+      N_Name: constant Iir := Get_Name (Alias);
+      N_Type: Iir;
+      Name_Type : Iir;
+   begin
+      --  LRM93 4.3.3.1 Object Aliases.
+      --  1. A signature may not appear in a declaration of an object alias.
+      -- FIXME: todo.
+      --
+      --  2. The name must be a static name that denotes an object.
+      if Get_Name_Staticness (N_Name) < Globally then
+         Error_Msg_Sem ("aliased name must be a static name", Alias);
+      end if;
+
+      --  LRM93 4.3.3.1
+      --  The base type of the name specified in an alias declaration must be
+      --  the same as the base type of the type mark in the subtype indication
+      --  (if the subtype indication is present);
+      Name_Type := Get_Type (N_Name);
+      N_Type := Get_Subtype_Indication (Alias);
+      if N_Type = Null_Iir then
+         Set_Type (Alias, Name_Type);
+         N_Type := Name_Type;
+      else
+         --  FIXME: must be analyzed before calling Name_Visibility.
+         N_Type := Sem_Subtype_Indication (N_Type);
+         Set_Subtype_Indication (Alias, N_Type);
+         N_Type := Get_Type_Of_Subtype_Indication (N_Type);
+         if N_Type /= Null_Iir then
+            Set_Type (Alias, N_Type);
+            if Get_Base_Type (N_Type) /= Get_Base_Type (Name_Type) then
+               Error_Msg_Sem ("base type of aliased name and name mismatch",
+                              Alias);
+            end if;
+         end if;
+      end if;
+
+      --  LRM93 4.3.3.1
+      --  This type must not be a multi-dimensional array type.
+      if Get_Kind (N_Type) in Iir_Kinds_Array_Type_Definition then
+         if not Is_One_Dimensional_Array_Type (N_Type) then
+            Error_Msg_Sem
+              ("aliased name must not be a multi-dimensional array type",
+               Alias);
+         end if;
+         if Get_Type_Staticness (N_Type) = Locally
+           and then Get_Type_Staticness (Name_Type) = Locally
+           and then Eval_Discrete_Type_Length
+           (Get_Nth_Element (Get_Index_Subtype_List (N_Type), 0))
+           /= Eval_Discrete_Type_Length
+           (Get_Nth_Element (Get_Index_Subtype_List (Name_Type), 0))
+         then
+            Error_Msg_Sem
+              ("number of elements not matching in type and name", Alias);
+         end if;
+      end if;
+
+      Set_Name_Staticness (Alias, Get_Name_Staticness (N_Name));
+      Set_Expr_Staticness (Alias, Get_Expr_Staticness (N_Name));
+      if Is_Signal_Object (N_Name) then
+         Set_Type_Has_Signal (N_Type);
+      end if;
+   end Sem_Object_Alias_Declaration;
+
+   function Signature_Match (N_Entity : Iir; Sig : Iir_Signature)
+                            return Boolean
+   is
+      List : Iir_List;
+      Inter : Iir;
+      El : Iir;
+   begin
+      List := Get_Type_Marks_List (Sig);
+      case Get_Kind (N_Entity) is
+         when Iir_Kind_Enumeration_Literal =>
+            --  LRM93 2.3.2  Signatures
+            --  * Similarly, a signature is said to match the parameter and
+            --    result type profile of a given enumeration literal if
+            --    the signature matches the parameter and result type profile
+            --    of the subprogram equivalent to the enumeration literal,
+            --    defined in Section 3.1.1
+            return List = Null_Iir_List
+              and then Get_Type (N_Entity)
+              = Get_Type (Get_Return_Type_Mark (Sig));
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            --  LRM93 2.3.2  Signatures
+            --  * if the reserved word RETURN is present, the subprogram is
+            --    a function and the base type of the type mark following
+            --    the reserved word in the signature is the same as the base
+            --    type of the return type of the function, [...]
+            if Get_Type (Get_Return_Type_Mark (Sig)) /=
+              Get_Base_Type (Get_Return_Type (N_Entity))
+            then
+               return False;
+            end if;
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            --  LRM93 2.3.2  Signatures
+            --  * [...] or the reserved word RETURN is absent and the
+            --    subprogram is a procedure.
+            if Get_Return_Type_Mark (Sig) /= Null_Iir then
+               return False;
+            end if;
+         when others =>
+            --  LRM93 2.3.2  Signatures
+            --  A signature distinguishes between overloaded subprograms and
+            --  overloaded enumeration literals based on their parameter
+            --  and result type profiles.
+            return False;
+      end case;
+
+      --  LRM93 2.3.2  Signature
+      --  * the number of type marks prior the reserved word RETURN, if any,
+      --    matches the number of formal parameters of the subprogram;
+      --  * at each parameter position, the base type denoted by the type
+      --    mark of the signature is the same as the base type of the
+      --    corresponding formal parameter of the subprogram; [and finally, ]
+      Inter := Get_Interface_Declaration_Chain (N_Entity);
+      if List = Null_Iir_List then
+         return Inter = Null_Iir;
+      end if;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         if El = Null_Iir and Inter = Null_Iir then
+            return True;
+         end if;
+         if El = Null_Iir or Inter = Null_Iir then
+            return False;
+         end if;
+         if Get_Base_Type (Get_Type (Inter)) /= Get_Type (El) then
+            return False;
+         end if;
+         Inter := Get_Chain (Inter);
+      end loop;
+      --  Avoid a spurious warning.
+      return False;
+   end Signature_Match;
+
+   --  Extract from NAME the named entity whose profile matches with SIG.
+   function Sem_Signature (Name : Iir; Sig : Iir_Signature) return Iir
+   is
+      Res : Iir;
+      El : Iir;
+      List : Iir_List;
+      Error : Boolean;
+   begin
+      --  Sem signature.
+      List := Get_Type_Marks_List (Sig);
+      if List /= Null_Iir_List then
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            El := Sem_Type_Mark (El);
+            Replace_Nth_Element (List, I, El);
+
+            --  Reuse the Type field of the name for the base type.  This is
+            --  a deviation from the use of Type in a name, but restricted to
+            --  analysis of signatures.
+            Set_Type (El, Get_Base_Type (Get_Type (El)));
+         end loop;
+      end if;
+      El := Get_Return_Type_Mark (Sig);
+      if El /= Null_Iir then
+         El := Sem_Type_Mark (El);
+         Set_Return_Type_Mark (Sig, El);
+         --  Likewise.
+         Set_Type (El, Get_Base_Type (Get_Type (El)));
+      end if;
+
+      --  FIXME: what to do in case of error ?
+      Res := Null_Iir;
+      Error := False;
+      if Is_Overload_List (Name) then
+         for I in Natural loop
+            El := Get_Nth_Element (Get_Overload_List (Name), I);
+            exit when El = Null_Iir;
+            if Signature_Match (El, Sig) then
+               if Res = Null_Iir then
+                  Res := El;
+               else
+                  Error := True;
+                  Error_Msg_Sem
+                    ("cannot resolve signature, many matching subprograms:",
+                     Sig);
+                  Error_Msg_Sem ("found: " & Disp_Node (Res), Res);
+               end if;
+               if Error then
+                  Error_Msg_Sem ("found: " & Disp_Node (El), El);
+               end if;
+            end if;
+         end loop;
+
+         --  Free the overload list (with a workaround as only variables can
+         --  be free).
+         declare
+            Name_Ov : Iir;
+         begin
+            Name_Ov := Name;
+            Free_Overload_List (Name_Ov);
+         end;
+      else
+         if Signature_Match (Name, Sig) then
+            Res := Name;
+         end if;
+      end if;
+
+      if Error then
+         return Null_Iir;
+      end if;
+      if Res = Null_Iir then
+         Error_Msg_Sem
+           ("cannot resolve signature, no matching subprogram", Sig);
+      end if;
+
+      return Res;
+   end Sem_Signature;
+
+   --  Create implicit aliases for an alias ALIAS of a type or of a subtype.
+   procedure Add_Aliases_For_Type_Alias (Alias : Iir)
+   is
+      N_Entity : constant Iir := Get_Named_Entity (Get_Name (Alias));
+      Def : constant Iir := Get_Base_Type (Get_Type (N_Entity));
+      Type_Decl : constant Iir := Get_Type_Declarator (Def);
+      Last : Iir;
+      El : Iir;
+      Enum_List : Iir_Enumeration_Literal_List;
+
+      --  Append an implicit alias
+      procedure Add_Implicit_Alias (Decl : Iir)
+      is
+         N_Alias : constant Iir_Non_Object_Alias_Declaration :=
+           Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
+         N_Name : constant Iir := Create_Iir (Iir_Kind_Simple_Name);
+      begin
+         --  Create the name (can be in fact a character literal or a symbol
+         --  operator).
+         Location_Copy (N_Name, Alias);
+         Set_Identifier (N_Name, Get_Identifier (Decl));
+         Set_Named_Entity (N_Name, Decl);
+
+         Location_Copy (N_Alias, Alias);
+         Set_Identifier (N_Alias, Get_Identifier (Decl));
+         Set_Name (N_Alias, N_Name);
+         Set_Parent (N_Alias, Get_Parent (Alias));
+         Set_Implicit_Alias_Flag (N_Alias, True);
+
+         Sem_Scopes.Add_Name (N_Alias);
+         Set_Visible_Flag (N_Alias, True);
+
+         --  Append in the declaration chain.
+         Set_Chain (N_Alias, Get_Chain (Last));
+         Set_Chain (Last, N_Alias);
+         Last := N_Alias;
+      end Add_Implicit_Alias;
+   begin
+      Last := Alias;
+
+      if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
+         --  LRM93 4.3.3.2  Non-Object Aliases
+         --  3.  If the name denotes an enumeration type, then one
+         --      implicit alias declaration for each of the
+         --      literals of the type immediatly follows the alias
+         --      declaration for the enumeration type; [...]
+         --
+         --  LRM08 6.6.3 Nonobject aliases
+         --  c)  If the name denotes an enumeration type of a subtype of an
+         --      enumeration type, then one implicit alias declaration for each
+         --      of the litereals of the base type immediately follows the
+         --      alias declaration for the enumeration type; [...]
+         Enum_List := Get_Enumeration_Literal_List (Def);
+         for I in Natural loop
+            El := Get_Nth_Element (Enum_List, I);
+            exit when El = Null_Iir;
+            --  LRM93 4.3.3.2  Non-Object Aliases
+            --      [...] each such implicit declaration has, as its alias
+            --      designator, the simple name or character literal of the
+            --      literal, and has, as its name, a name constructed by taking
+            --      the name of the alias for the enumeration type and
+            --      substituting the simple name or character literal being
+            --      aliased for the simple name of the type.  Each implicit
+            --      alias has a signature that matches the parameter and result
+            --      type profile of the literal being aliased.
+            --
+            --  LRM08 6.6.3 Nonobject aliases
+            --      [...] each such implicit declaration has, as its alias
+            --      designator, the simple name or character literal of the
+            --      literal and has, as its name, a name constructed by taking
+            --      the name of the alias for the enumeration type or subtype
+            --      and substituing the simple name or character literal being
+            --      aliased for the simple name of the type or subtype.  Each
+            --      implicit alias has a signature that matches the parameter
+            --      and result type profile of the literal being aliased.
+            Add_Implicit_Alias (El);
+         end loop;
+      end if;
+
+      --  LRM93 4.3.3.2  Non-Object Aliases
+      --  4.  Alternatively, if the name denotes a physical type
+      --      [...]
+      --  GHDL: this is not possible, since a physical type is
+      --  anonymous (LRM93 is buggy on this point).
+      --
+      --  LRM08 6.6.3 Nonobject aliases
+      --  d)  Alternatively, if the name denotes a subtype of a physical type,
+      --      [...]
+      if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
+         --  LRM08 6.3.3 Nonobject aliases
+         --      [...] then one implicit alias declaration for each of the
+         --      units of the base type immediately follows the alias
+         --      declaration for the physical type; each such implicit
+         --      declaration has, as its alias designator, the simple name of
+         --      the unit and has, as its name, a name constructed by taking
+         --      the name of the alias for the subtype of the physical type
+         --      and substituting the simple name of the unit being aliased for
+         --      the simple name of the subtype.
+         El := Get_Unit_Chain (Def);
+         while El /= Null_Iir loop
+            Add_Implicit_Alias (El);
+            El := Get_Chain (El);
+         end loop;
+      end if;
+
+      --  LRM93 4.3.3.2  Non-Object Aliases
+      --  5.  Finally, if the name denotes a type, then implicit
+      --      alias declarations for each predefined operator
+      --      for the type immediatly follow the explicit alias
+      --      declaration for the type, and if present, any
+      --      implicit alias declarations for literals or units
+      --      of the type.
+      --      Each implicit alias has a signature that matches the
+      --      parameter and result type profule of the implicit
+      --      operator being aliased.
+      --
+      --  LRM08 6.6.3 Nonobject aliases
+      --  e)  Finally, if the name denotes a type of a subtype, then implicit
+      --      alias declarations for each predefined operation for the type
+      --      immediately follow the explicit alias declaration for the type or
+      --      subtype and, if present, any implicit alias declarations for
+      --      literals or units of the type.  Each implicit alias has a
+      --      signature that matches the parameter and result type profile of
+      --      the implicit operation being aliased.
+      El := Get_Chain (Type_Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               exit when Get_Type_Reference (El) /= Type_Decl;
+            when others =>
+               exit;
+         end case;
+         Add_Implicit_Alias (El);
+         El := Get_Chain (El);
+      end loop;
+   end Add_Aliases_For_Type_Alias;
+
+   procedure Sem_Non_Object_Alias_Declaration
+     (Alias : Iir_Non_Object_Alias_Declaration)
+   is
+      use Std_Names;
+      N_Entity : constant Iir := Get_Named_Entity (Get_Name (Alias));
+      Id : Name_Id;
+   begin
+      case Get_Kind (N_Entity) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            --  LRM93 4.3.3.2  Non-Object Aliases
+            --  2.  A signature is required if the name denotes a subprogram
+            --      (including an operator) or enumeration literal.
+            if Get_Alias_Signature (Alias) = Null_Iir then
+               Error_Msg_Sem ("signature required for subprogram", Alias);
+            end if;
+         when Iir_Kind_Enumeration_Literal =>
+            if Get_Alias_Signature (Alias) = Null_Iir then
+               Error_Msg_Sem ("signature required for enumeration literal",
+                              Alias);
+            end if;
+         when Iir_Kind_Type_Declaration =>
+            Add_Aliases_For_Type_Alias (Alias);
+         when Iir_Kind_Subtype_Declaration =>
+            --  LRM08 6.6.3 Nonobject aliases
+            --  ... or a subtype ...
+            if Flags.Vhdl_Std >= Vhdl_08 then
+               Add_Aliases_For_Type_Alias (Alias);
+            end if;
+         when Iir_Kinds_Object_Declaration =>
+            raise Internal_Error;
+         when Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Component_Declaration =>
+            null;
+         when Iir_Kind_Terminal_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("sem_non_object_alias_declaration", N_Entity);
+      end case;
+
+      Id := Get_Identifier (Alias);
+
+      case Id is
+         when Name_Characters =>
+            --  LRM 4.3.3  Alias declarations
+            --  If the alias designator is a character literal, the
+            --  name must denote an enumeration literal.
+            if Get_Kind (N_Entity) /= Iir_Kind_Enumeration_Literal then
+               Error_Msg_Sem
+                 ("alias of a character must denote an enumeration literal",
+                  Alias);
+               return;
+            end if;
+         when Name_Id_Operators
+           | Name_Shift_Operators
+           | Name_Word_Operators =>
+            --  LRM 4.3.3  Alias declarations
+            --  If the alias designator is an operator symbol, the
+            --  name must denote a function, and that function then
+            --  overloads the operator symbol.  In this latter case,
+            --  the operator symbol and the function both must meet the
+            --  requirements of 2.3.1.
+            if Get_Kind (N_Entity) not in Iir_Kinds_Function_Declaration then
+               Error_Msg_Sem
+                 ("alias of an operator must denote a function", Alias);
+               return;
+            end if;
+            Check_Operator_Requirements (Id, N_Entity);
+         when others =>
+            null;
+      end case;
+   end Sem_Non_Object_Alias_Declaration;
+
+   function Sem_Alias_Declaration (Alias : Iir) return Iir
+   is
+      use Std_Names;
+      Name : Iir;
+      Sig : Iir_Signature;
+      N_Entity : Iir;
+      Res : Iir;
+   begin
+      Xref_Decl (Alias);
+
+      Name := Get_Name (Alias);
+      if Get_Kind (Name) = Iir_Kind_Signature then
+         Sig := Name;
+         Name := Get_Signature_Prefix (Sig);
+         Sem_Name (Name);
+         Set_Signature_Prefix (Sig, Name);
+      else
+         Sem_Name (Name);
+         Sig := Null_Iir;
+      end if;
+
+      N_Entity := Get_Named_Entity (Name);
+      if N_Entity = Error_Mark then
+         return Alias;
+      end if;
+
+      if Is_Overload_List (N_Entity) then
+         if Sig = Null_Iir then
+            Error_Msg_Sem
+              ("signature required for alias of a subprogram", Alias);
+            return Alias;
+         end if;
+      end if;
+
+      if Sig /= Null_Iir then
+         N_Entity := Sem_Signature (N_Entity, Sig);
+      end if;
+      if N_Entity = Null_Iir then
+         return Alias;
+      end if;
+
+      Set_Named_Entity (Name, N_Entity);
+      Set_Name (Alias, Finish_Sem_Name (Name));
+
+      if Is_Object_Name (N_Entity) then
+         --  Object alias declaration.
+
+         Sem_Scopes.Add_Name (Alias);
+         Name_Visible (Alias);
+
+         if Sig /= Null_Iir then
+            Error_Msg_Sem ("signature not allowed for object alias", Sig);
+         end if;
+         Sem_Object_Alias_Declaration (Alias);
+         return Alias;
+      else
+         --  Non object alias declaration.
+
+         if Get_Type (Alias) /= Null_Iir then
+            Error_Msg_Sem
+              ("subtype indication not allowed for non-object alias", Alias);
+         end if;
+         if Get_Subtype_Indication (Alias) /= Null_Iir then
+            Error_Msg_Sem
+              ("subtype indication shall not appear in a nonobject alias",
+               Alias);
+         end if;
+
+         Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
+         Location_Copy (Res, Alias);
+         Set_Parent (Res, Get_Parent (Alias));
+         Set_Chain (Res, Get_Chain (Alias));
+         Set_Identifier (Res, Get_Identifier (Alias));
+         Set_Name (Res, Name);
+         Set_Alias_Signature (Res, Sig);
+
+         Sem_Scopes.Add_Name (Res);
+         Name_Visible (Res);
+
+         Free_Iir (Alias);
+
+         Sem_Non_Object_Alias_Declaration (Res);
+         return Res;
+      end if;
+   end Sem_Alias_Declaration;
+
+   procedure Sem_Group_Template_Declaration
+     (Decl : Iir_Group_Template_Declaration)
+   is
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Sem_Scopes.Name_Visible (Decl);
+      Xref_Decl (Decl);
+   end Sem_Group_Template_Declaration;
+
+   procedure Sem_Group_Declaration (Group : Iir_Group_Declaration)
+   is
+      use Tokens;
+
+      Constituent_List : Iir_Group_Constituent_List;
+      Template : Iir_Group_Template_Declaration;
+      Template_Name : Iir;
+      Class, Prev_Class : Token_Type;
+      El : Iir;
+      El_Name : Iir;
+      El_Entity : Iir_Entity_Class;
+   begin
+      Sem_Scopes.Add_Name (Group);
+      Xref_Decl (Group);
+
+      Template_Name := Sem_Denoting_Name (Get_Group_Template_Name (Group));
+      Set_Group_Template_Name (Group, Template_Name);
+      Template := Get_Named_Entity (Template_Name);
+      if Get_Kind (Template) /= Iir_Kind_Group_Template_Declaration then
+         Error_Class_Match (Template_Name, "group template");
+         return;
+      end if;
+      Constituent_List := Get_Group_Constituent_List (Group);
+      El_Entity := Get_Entity_Class_Entry_Chain (Template);
+      Prev_Class := Tok_Eof;
+      for I in Natural loop
+         El := Get_Nth_Element (Constituent_List, I);
+         exit when El = Null_Iir;
+
+         Sem_Name (El);
+
+         if El_Entity = Null_Iir then
+            Error_Msg_Sem
+              ("too many elements in group constituent list", Group);
+            exit;
+         end if;
+
+         Class := Get_Entity_Class (El_Entity);
+         if Class = Tok_Box then
+            --  LRM93 4.6
+            --  An entity class entry that includes a box (<>) allows zero
+            --  or more group constituents to appear in this position in the
+            --  corresponding group declaration.
+            Class := Prev_Class;
+         else
+            Prev_Class := Class;
+            El_Entity := Get_Chain (El_Entity);
+         end if;
+
+         El_Name := Get_Named_Entity (El);
+         if Is_Error (El_Name) then
+            null;
+         elsif Is_Overload_List (El_Name) then
+            Error_Overload (El_Name);
+         else
+            El := Finish_Sem_Name (El);
+            Replace_Nth_Element (Constituent_List, I, El);
+            El_Name := Get_Named_Entity (El);
+
+            --  LRM93 4.7
+            --  It is an error if the class of any group constituent in the
+            --  group constituent list is not the same as the class specified
+            --  by the corresponding entity class entry in the entity class
+            --  entry list of the group template.
+            if Get_Entity_Class_Kind (El_Name) /= Class then
+               Error_Msg_Sem
+                 ("constituent not of class '" & Tokens.Image (Class) & ''',
+                  El);
+            end if;
+         end if;
+      end loop;
+
+      --  End of entity_class list reached or zero or more constituent allowed.
+      if not (El_Entity = Null_Iir
+              or else Get_Entity_Class (El_Entity) = Tok_Box)
+      then
+         Error_Msg_Sem
+           ("not enough elements in group constituent list", Group);
+      end if;
+      Set_Visible_Flag (Group, True);
+   end Sem_Group_Declaration;
+
+   function Sem_Scalar_Nature_Definition (Def : Iir; Decl : Iir) return Iir
+   is
+      function Sem_Scalar_Nature_Typemark (T : Iir; Name : String) return Iir
+      is
+         Res : Iir;
+      begin
+         Res := Sem_Type_Mark (T);
+         Res := Get_Type (Res);
+         if Is_Error (Res) then
+            return Real_Type_Definition;
+         end if;
+         --  LRM93 3.5.1
+         --  The type marks must denote floating point types
+         case Get_Kind (Res) is
+            when Iir_Kind_Floating_Subtype_Definition
+              | Iir_Kind_Floating_Type_Definition =>
+               return Res;
+            when others =>
+               Error_Msg_Sem (Name & "type must be a floating point type", T);
+               return Real_Type_Definition;
+         end case;
+      end Sem_Scalar_Nature_Typemark;
+
+      Tm : Iir;
+      Ref : Iir;
+   begin
+      Tm := Get_Across_Type (Def);
+      Tm := Sem_Scalar_Nature_Typemark (Tm, "across");
+      Set_Across_Type (Def, Tm);
+
+      Tm := Get_Through_Type (Def);
+      Tm := Sem_Scalar_Nature_Typemark (Tm, "through");
+      Set_Through_Type (Def, Tm);
+
+      --  Declare the reference
+      Ref := Get_Reference (Def);
+      Set_Nature (Ref, Def);
+      Set_Chain (Ref, Get_Chain (Decl));
+      Set_Chain (Decl, Ref);
+
+      return Def;
+   end Sem_Scalar_Nature_Definition;
+
+   function Sem_Nature_Definition (Def : Iir; Decl : Iir) return Iir
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Scalar_Nature_Definition =>
+            return Sem_Scalar_Nature_Definition (Def, Decl);
+         when others =>
+            Error_Kind ("sem_nature_definition", Def);
+            return Null_Iir;
+      end case;
+   end Sem_Nature_Definition;
+
+   procedure Sem_Nature_Declaration (Decl : Iir)
+   is
+      Def : Iir;
+   begin
+      Def := Get_Nature (Decl);
+      if Def /= Null_Iir then
+         Sem_Scopes.Add_Name (Decl);
+         Xref_Decl (Decl);
+
+         Def := Sem_Nature_Definition (Def, Decl);
+         if Def /= Null_Iir then
+            Set_Nature_Declarator (Def, Decl);
+            Sem_Scopes.Name_Visible (Decl);
+         end if;
+      end if;
+   end Sem_Nature_Declaration;
+
+   procedure Sem_Terminal_Declaration (Decl : Iir; Last_Decl : Iir)
+   is
+      Def, Nature : Iir;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Xref_Decl (Decl);
+
+      Def := Get_Nature (Decl);
+
+      if Def = Null_Iir then
+         Nature := Get_Nature (Last_Decl);
+      else
+         Nature := Sem_Subnature_Indication (Def);
+      end if;
+
+      if Nature /= Null_Iir then
+         Set_Nature (Decl, Nature);
+         Sem_Scopes.Name_Visible (Decl);
+      end if;
+   end Sem_Terminal_Declaration;
+
+   procedure Sem_Branch_Quantity_Declaration (Decl : Iir; Last_Decl : Iir)
+   is
+      Plus_Name : Iir;
+      Minus_Name : Iir;
+      Branch_Type : Iir;
+      Value : Iir;
+      Is_Second : Boolean;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Xref_Decl (Decl);
+
+      Plus_Name := Get_Plus_Terminal (Decl);
+      if Plus_Name = Null_Iir then
+         --  List of identifier.
+         Is_Second := True;
+         Plus_Name := Get_Plus_Terminal (Last_Decl);
+         Minus_Name := Get_Minus_Terminal (Last_Decl);
+         Value := Get_Default_Value (Last_Decl);
+      else
+         Is_Second := False;
+         Plus_Name := Sem_Terminal_Name (Plus_Name);
+         Minus_Name := Get_Minus_Terminal (Decl);
+         if Minus_Name /= Null_Iir then
+            Minus_Name := Sem_Terminal_Name (Minus_Name);
+         end if;
+         Value := Get_Default_Value (Decl);
+      end if;
+      Set_Plus_Terminal (Decl, Plus_Name);
+      Set_Minus_Terminal (Decl, Minus_Name);
+      case Get_Kind (Decl) is
+         when Iir_Kind_Across_Quantity_Declaration =>
+            Branch_Type := Get_Across_Type (Get_Nature (Plus_Name));
+         when Iir_Kind_Through_Quantity_Declaration =>
+            Branch_Type := Get_Through_Type (Get_Nature (Plus_Name));
+         when others =>
+            raise Program_Error;
+      end case;
+      Set_Type (Decl, Branch_Type);
+
+      if not Is_Second and then Value /= Null_Iir then
+         Value := Sem_Expression (Value, Branch_Type);
+      end if;
+      Set_Default_Value (Decl, Value);
+
+      --  TODO: tolerance
+
+      Sem_Scopes.Name_Visible (Decl);
+   end Sem_Branch_Quantity_Declaration;
+
+   procedure Sem_Declaration_Chain (Parent : Iir)
+   is
+      Decl: Iir;
+      Last_Decl : Iir;
+      Attr_Spec_Chain : Iir;
+
+      --  Used for list of identifiers in object declarations to get the type
+      --  and default value for the following declarations.
+      Last_Obj_Decl : Iir;
+
+      --  If IS_GLOBAL is set, then declarations may be seen outside of unit.
+      --  This must be set for entities and packages (except when
+      --   Flags.Flag_Whole_Analyze is set).
+      Is_Global : Boolean;
+   begin
+      case Get_Kind (Parent) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration =>
+            Is_Global := not Flags.Flag_Whole_Analyze;
+         when others =>
+            Is_Global := False;
+      end case;
+
+      --  Due to implicit declarations, the list can grow during sem.
+      Decl := Get_Declaration_Chain (Parent);
+      Last_Decl := Null_Iir;
+      Attr_Spec_Chain := Null_Iir;
+      Last_Obj_Decl := Null_Iir;
+
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Anonymous_Type_Declaration =>
+               Sem_Type_Declaration (Decl, Is_Global);
+            when Iir_Kind_Subtype_Declaration =>
+               Sem_Subtype_Declaration (Decl, Is_Global);
+            when Iir_Kind_Signal_Declaration =>
+               Sem_Object_Declaration (Decl, Parent, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when Iir_Kind_Constant_Declaration =>
+               Sem_Object_Declaration (Decl, Parent, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when Iir_Kind_Variable_Declaration =>
+               Sem_Object_Declaration (Decl, Parent, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when Iir_Kind_File_Declaration =>
+               Sem_File_Declaration (Decl, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when Iir_Kind_Attribute_Declaration =>
+               Sem_Attribute_Declaration (Decl);
+            when Iir_Kind_Attribute_Specification =>
+               Sem_Attribute_Specification (Decl, Parent);
+               if Get_Entity_Name_List (Decl) in Iir_Lists_All_Others then
+                  Set_Attribute_Specification_Chain (Decl, Attr_Spec_Chain);
+                  Attr_Spec_Chain := Decl;
+               end if;
+            when Iir_Kind_Component_Declaration =>
+               Sem_Component_Declaration (Decl);
+            when Iir_Kind_Function_Declaration =>
+               Sem_Subprogram_Declaration (Decl);
+               if Is_Global
+                 and then Is_A_Resolution_Function (Decl, Null_Iir)
+               then
+                  Set_Resolution_Function_Flag (Decl, True);
+               end if;
+            when Iir_Kind_Procedure_Declaration =>
+               Sem_Subprogram_Declaration (Decl);
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               Sem_Subprogram_Body (Decl);
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Sem_Scopes.Add_Name (Decl);
+               --  Implicit subprogram are already visible.
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               --  Added by Sem_Alias_Declaration.  Need to check that no
+               --  existing attribute specification apply to them.
+               null;
+            when Iir_Kind_Object_Alias_Declaration =>
+               declare
+                  Res : Iir;
+               begin
+                  Res := Sem_Alias_Declaration (Decl);
+                  if Res /= Decl then
+                     --  Replace DECL with RES.
+                     if Last_Decl = Null_Iir then
+                        Set_Declaration_Chain (Parent, Res);
+                     else
+                        Set_Chain (Last_Decl, Res);
+                     end if;
+                     Decl := Res;
+
+                     --  An alias may add new alias declarations. Do not skip
+                     --  them: check that no existing attribute specifications
+                     --  apply to them.
+                  end if;
+               end;
+            when Iir_Kind_Use_Clause =>
+               Sem_Use_Clause (Decl);
+            when Iir_Kind_Configuration_Specification =>
+               null;
+            when Iir_Kind_Disconnection_Specification =>
+               Sem_Disconnection_Specification (Decl);
+            when Iir_Kind_Group_Template_Declaration =>
+               Sem_Group_Template_Declaration (Decl);
+            when Iir_Kind_Group_Declaration =>
+               Sem_Group_Declaration (Decl);
+            when Iir_Kinds_Signal_Attribute =>
+               --  Added by sem, so nothing to do.
+               null;
+            when Iir_Kind_Protected_Type_Body =>
+               Sem_Protected_Type_Body (Decl);
+            when Iir_Kind_Nature_Declaration =>
+               Sem_Nature_Declaration (Decl);
+            when Iir_Kind_Terminal_Declaration =>
+               Sem_Terminal_Declaration (Decl, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when Iir_Kind_Across_Quantity_Declaration
+              | Iir_Kind_Through_Quantity_Declaration =>
+               Sem_Branch_Quantity_Declaration (Decl, Last_Obj_Decl);
+               Last_Obj_Decl := Decl;
+            when others =>
+               Error_Kind ("sem_declaration_chain", Decl);
+         end case;
+         if Attr_Spec_Chain /= Null_Iir then
+            Check_Post_Attribute_Specification (Attr_Spec_Chain, Decl);
+         end if;
+         Last_Decl := Decl;
+         Decl := Get_Chain (Decl);
+      end  loop;
+   end Sem_Declaration_Chain;
+
+   procedure Check_Full_Declaration (Decls_Parent : Iir; Decl: Iir)
+   is
+      El: Iir;
+
+      --  If set, emit a warning if a declaration is not used.
+      Check_Unused : Boolean;
+   begin
+      --  LRM 3.5 Protected types.
+      --  Each protected type declaration appearing immediatly within a given
+      --  declaration region must have exactly one corresponding protected type
+      --  body appearing immediatly within the same declarative region and
+      --  textually subsequent to the protected type declaration.
+
+      --  LRM 3.3.1 Incomplete type declarations
+      --  For each incomplete type declaration, there must be a corresponding
+      --  full type declaration with the same identifier.  This full type
+      --  declaration must occur later and immediatly within the same
+      --  declarative part as the incomplete type declaration to which it
+      --  correspinds.
+
+      --  LRM 4.3.1.1 Constant declarations
+      --  If the assignment symbol ":=" followed by an expression is not
+      --  present in a constant declaration, then the declaration declares a
+      --  deferred constant.  Such a constant declaration must appear in a
+      --  package declaration.  The corresponding full constant declaration,
+      --  which defines the value of the constant, must appear in the body of
+      --  the package (see 2.6).
+
+      --  LRM 2.2 Subprogram bodies
+      --  If both a declaration and a body are given, [...].  Furthermore,
+      --  both the declaration and the body must occur immediatly within the
+      --  same declaration region.
+
+      --  Set Check_Unused.
+      Check_Unused := False;
+      if Flags.Warn_Unused then
+         case Get_Kind (Decl) is
+            when Iir_Kind_Entity_Declaration =>
+               --  May be used in architecture.
+               null;
+            when Iir_Kind_Architecture_Body
+              | Iir_Kind_Block_Statement
+              | Iir_Kind_Generate_Statement =>
+               --  Might be used in a configuration.
+               --  FIXME: create a second level of warning.
+               null;
+            when Iir_Kind_Package_Body
+              | Iir_Kind_Protected_Type_Body =>
+               --  Check only for declarations of the body.
+               if Decls_Parent = Decl then
+                  Check_Unused := True;
+               end if;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body
+              | Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_Statement =>
+               Check_Unused := True;
+            when others =>
+               --  Note: Check_Full_Declaration is not called
+               --   for package declarations or protected type declarations.
+               Error_Kind ("check_full_declaration", Decl);
+         end case;
+      end if;
+
+      El := Get_Declaration_Chain (Decls_Parent);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Constant_Declaration =>
+               if Get_Deferred_Declaration_Flag (El) then
+                  if Get_Deferred_Declaration (El) = Null_Iir then
+                     Error_Msg_Sem ("missing value for constant declared at "
+                                    & Disp_Location (El), Decl);
+                  else
+                     --  Remove from visibility the full declaration of the
+                     --  constant.
+                     --  FIXME: this is not a check!
+                     Set_Deferred_Declaration (El, Null_Iir);
+                  end if;
+               end if;
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               if Get_Subprogram_Body (El) = Null_Iir then
+                  Error_Msg_Sem ("missing body for " & Disp_Node (El)
+                                 & " declared at "
+                                 & Disp_Location (El), Decl);
+               end if;
+            when Iir_Kind_Type_Declaration =>
+               declare
+                  Def : Iir;
+               begin
+                  Def := Get_Type_Definition (El);
+                  if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition
+                    and then Get_Type_Declarator (Def) = El
+                  then
+                     Error_Msg_Sem ("missing full type declaration for "
+                                    & Disp_Node (El), El);
+                  elsif Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
+                    and then Get_Protected_Type_Body (Def) = Null_Iir
+                  then
+                     Error_Msg_Sem ("missing protected type body for "
+                                    & Disp_Node (El), El);
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+
+         if Check_Unused then
+            --  All subprograms declared in the specification (package or
+            --  protected type) have only their *body* in the body.
+            --  Therefore, they don't appear as declaration in body.
+            --  Only private subprograms appears as declarations.
+            case Get_Kind (El) is
+               when Iir_Kind_Function_Declaration
+                 | Iir_Kind_Procedure_Declaration =>
+                  if not Get_Use_Flag (El)
+                    and then not Is_Second_Subprogram_Specification (El)
+                  then
+                     Warning_Msg_Sem
+                       (Disp_Node (El) & " is never referenced", El);
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end if;
+
+         El := Get_Chain (El);
+      end loop;
+   end Check_Full_Declaration;
+
+   procedure Sem_Iterator (Iterator : Iir_Iterator_Declaration;
+                           Staticness : Iir_Staticness)
+   is
+      It_Range: constant Iir := Get_Discrete_Range (Iterator);
+      It_Type : Iir;
+      A_Range: Iir;
+   begin
+      Xref_Decl (Iterator);
+
+      A_Range := Sem_Discrete_Range_Integer (It_Range);
+      if A_Range = Null_Iir then
+         Set_Type (Iterator, Create_Error_Type (It_Range));
+         return;
+      end if;
+
+      Set_Discrete_Range (Iterator, A_Range);
+
+      It_Type := Range_To_Subtype_Indication (A_Range);
+      Set_Subtype_Indication (Iterator, It_Type);
+      Set_Type (Iterator, Get_Type_Of_Subtype_Indication (It_Type));
+
+      Set_Expr_Staticness (Iterator, Staticness);
+   end Sem_Iterator;
+end Sem_Decls;
diff --git a/src/sem_decls.ads b/src/sem_decls.ads
new file mode 100644
index 000000000..7a8e24042
--- /dev/null
+++ b/src/sem_decls.ads
@@ -0,0 +1,52 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Sem_Decls is
+   procedure Sem_Interface_Chain (Interface_Chain: Iir;
+                                  Interface_Kind : Interface_Kind_Type);
+
+   --  Create predefined operations for DECL.
+   procedure Create_Implicit_Operations
+     (Decl : Iir; Is_Std_Standard : Boolean := False);
+
+   --  Semantize declarations of PARENT.
+   procedure Sem_Declaration_Chain (Parent : Iir);
+
+   --  Check all declarations of DECLS_PARENT are complete
+   --  This checks subprograms, deferred constants, incomplete types and
+   --  protected types.
+   --
+   --  DECL is the declaration that contains the declaration_list DECLS_PARENT.
+   --  (location of errors).
+   --  DECL is different from DECLS_PARENT for package bodies and protected
+   --  type bodies.
+   --
+   --  Also, report unused declarations if DECL = DECLS_PARENT.
+   --  As a consequence, Check_Full_Declaration must be called after sem
+   --  of statements, if any.
+   procedure Check_Full_Declaration (Decls_Parent : Iir; Decl: Iir);
+
+   procedure Sem_Iterator (Iterator : Iir_Iterator_Declaration;
+                           Staticness : Iir_Staticness);
+
+   --  Extract from NAME the named entity whose profile matches SIG.  If NAME
+   --  is an overload list, it is destroyed.
+   function Sem_Signature (Name : Iir; Sig : Iir_Signature) return Iir;
+
+end Sem_Decls;
diff --git a/src/sem_expr.adb b/src/sem_expr.adb
new file mode 100644
index 000000000..f7af76c09
--- /dev/null
+++ b/src/sem_expr.adb
@@ -0,0 +1,4262 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Std_Package; use Std_Package;
+with Errorout; use Errorout;
+with Flags; use Flags;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Names; use Sem_Names;
+with Sem;
+with Name_Table;
+with Iirs_Utils; use Iirs_Utils;
+with Evaluation; use Evaluation;
+with Iir_Chains; use Iir_Chains;
+with Sem_Types;
+with Sem_Stmts; use Sem_Stmts;
+with Sem_Assocs; use Sem_Assocs;
+with Xrefs; use Xrefs;
+
+package body Sem_Expr is
+   procedure Not_Match (Expr: Iir; A_Type: Iir)
+   is
+      pragma Inline (Not_Match);
+   begin
+      Error_Not_Match (Expr, A_Type, Expr);
+   end Not_Match;
+
+--    procedure Not_Match (Expr: Iir; Type1: Iir; Type2: Iir) is
+--    begin
+--       Error_Msg_Sem
+--         ("can't match '" & Disp_Node (Expr) & "' with type '"
+--          & Disp_Node (Type1) & "' or type '" & Disp_Node (Type2) & "'",
+--          Expr);
+--    end Not_Match;
+
+--    procedure Overloaded (Expr: Iir) is
+--    begin
+--       Error_Msg_Sem
+--         ("cant resolve overloaded identifier '" & Get_String (Expr) & "'",
+--          Expr);
+--    end Overloaded;
+
+   -- Replace type of TARGET by A_TYPE.
+   -- If TARGET has already a type, it must be an overload list, and in this
+   -- case, this list is freed, or it must be A_TYPE.
+   -- A_TYPE can't be an overload list.
+   --
+   -- This procedure can be called in the second pass, when the type is known.
+   procedure Replace_Type (Target: Iir; A_Type: Iir) is
+      Old_Type: Iir;
+   begin
+      Old_Type := Get_Type (Target);
+      if Old_Type /= Null_Iir then
+         if Is_Overload_List (Old_Type) then
+            Free_Iir (Old_Type);
+         elsif Old_Type = A_Type then
+            return;
+         else
+            -- Cannot replace a type.
+            raise Internal_Error;
+         end if;
+      end if;
+      if A_Type = Null_Iir then
+         return;
+      end if;
+      if Is_Overload_List (A_Type) then
+         raise Internal_Error;
+      end if;
+      Set_Type (Target, A_Type);
+   end Replace_Type;
+
+   --  Return true if EXPR is overloaded, ie has several meanings.
+   function Is_Overloaded (Expr : Iir) return Boolean
+   is
+      Expr_Type : constant Iir := Get_Type (Expr);
+   begin
+      return Expr_Type = Null_Iir or else Is_Overload_List (Expr_Type);
+   end Is_Overloaded;
+
+   -- Return the common type of base types LEFT and RIGHT.
+   -- LEFT are RIGHT must be really base types (not subtypes).
+   -- Roughly speaking, it returns LEFT (= RIGHT) if LEFT = RIGHT (ie, same
+   -- type), null otherwise.
+   -- However, it handles implicite conversions of universal types.
+   function Get_Common_Basetype (Left: Iir; Right: Iir)
+     return Iir is
+   begin
+      if Left = Right then
+         return Left;
+      end if;
+      case Get_Kind (Left) is
+         when Iir_Kind_Integer_Type_Definition =>
+            if Right = Convertible_Integer_Type_Definition then
+               return Left;
+            elsif Left = Convertible_Integer_Type_Definition
+              and then Get_Kind (Right) = Iir_Kind_Integer_Type_Definition
+            then
+               return Right;
+            end if;
+         when Iir_Kind_Floating_Type_Definition =>
+            if Right = Convertible_Real_Type_Definition then
+               return Left;
+            elsif Left = Convertible_Real_Type_Definition
+              and then Get_Kind (Right) = Iir_Kind_Floating_Type_Definition
+            then
+               return Right;
+            end if;
+         when others =>
+            null;
+      end case;
+      return Null_Iir;
+   end Get_Common_Basetype;
+
+   -- LEFT are RIGHT must be really a type (not a subtype).
+   function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
+     return Boolean is
+   begin
+      return Get_Common_Basetype (Left, Right) /= Null_Iir;
+   end Are_Basetypes_Compatible;
+
+   function Are_Types_Compatible (Left: Iir; Right: Iir)
+     return Boolean is
+   begin
+      return Get_Common_Basetype (Get_Base_Type (Left),
+                                  Get_Base_Type (Right)) /= Null_Iir;
+   end Are_Types_Compatible;
+
+   function Are_Nodes_Compatible (Left: Iir; Right: Iir)
+     return Boolean is
+   begin
+      return Are_Types_Compatible (Get_Type (Left), Get_Type (Right));
+   end Are_Nodes_Compatible;
+
+   --  Return TRUE iif LEFT_TYPE and RIGHT_TYPES are compatible. RIGHT_TYPES
+   --  may be an overload list.
+   function Compatibility_Types1 (Left_Type : Iir; Right_Types : Iir)
+                                 return Boolean
+   is
+      El : Iir;
+      Right_List : Iir_List;
+   begin
+      pragma Assert (not Is_Overload_List (Left_Type));
+
+      if Is_Overload_List (Right_Types) then
+         Right_List := Get_Overload_List (Right_Types);
+         for I in Natural loop
+            El := Get_Nth_Element (Right_List, I);
+            exit when El = Null_Iir;
+            if Are_Types_Compatible (Left_Type, El) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      else
+         return Are_Types_Compatible (Left_Type, Right_Types);
+      end if;
+   end Compatibility_Types1;
+
+   --  Return compatibility for nodes LEFT and RIGHT.
+   --  LEFT is expected to be an interface of a function definition.
+   --  Type of RIGHT can be an overload_list
+   --  RIGHT might be implicitly converted to LEFT.
+   function Compatibility_Nodes (Left : Iir; Right : Iir)
+     return Boolean
+   is
+      Left_Type, Right_Type : Iir;
+   begin
+      Left_Type := Get_Base_Type (Get_Type (Left));
+      Right_Type := Get_Type (Right);
+
+      --  Check.
+      case Get_Kind (Left_Type) is
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            null;
+         when others =>
+            Error_Kind ("are_node_compatible_ov", Left_Type);
+      end case;
+
+      return Compatibility_Types1 (Left_Type, Right_Type);
+   end Compatibility_Nodes;
+
+   --  Return TRUE iff A_TYPE can be the type of string or bit string literal
+   --  EXPR.  EXPR is needed to distinguish between string and bit string
+   --  for VHDL87 rule about the type of a bit string.
+   function Is_String_Literal_Type (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+      El_Bt : Iir;
+   begin
+      --  LRM 7.3.1
+      --  [...] the type of the literal must be a one-dimensional array ...
+      if not Is_One_Dimensional_Array_Type (Base_Type) then
+         return False;
+      end if;
+      --  LRM 7.3.1
+      --  ... of a character type ...
+      El_Bt := Get_Base_Type (Get_Element_Subtype (Base_Type));
+      if Get_Kind (El_Bt) /= Iir_Kind_Enumeration_Type_Definition then
+         return False;
+      end if;
+      --  LRM87 7.3.1
+      --  ... (for string literals) or of type BIT (for bit string literals).
+      if Flags.Vhdl_Std = Vhdl_87
+        and then Get_Kind (Expr) = Iir_Kind_Bit_String_Literal
+        and then El_Bt /= Bit_Type_Definition
+      then
+         return False;
+      end if;
+      return True;
+   end Is_String_Literal_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of an aggregate.
+   function Is_Aggregate_Type (A_Type : Iir) return Boolean is
+   begin
+      --  LRM 7.3.2 Aggregates
+      --  [...]  the type of the aggregate must be a composite type.
+      case Get_Kind (Get_Base_Type (A_Type)) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Aggregate_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of a null literal.
+   function Is_Null_Literal_Type (A_Type : Iir) return Boolean is
+   begin
+      --  LRM 7.3.1 Literals
+      --  The literal NULL represents the null access value for any access
+      --  type.
+      return
+        Get_Kind (Get_Base_Type (A_Type)) = Iir_Kind_Access_Type_Definition;
+   end Is_Null_Literal_Type;
+
+   --  Return TRUE iff A_TYPE can be the type of allocator EXPR.  Note that
+   --  the allocator must have been analyzed.
+   function Is_Allocator_Type (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+      Designated_Type : Iir;
+   begin
+      --  LRM 7.3.6 Allocators
+      --  [...] the value returned is of an access type having the named
+      --  designated type.
+
+      if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then
+         return False;
+      end if;
+      Designated_Type := Get_Allocator_Designated_Type (Expr);
+      pragma Assert (Designated_Type /= Null_Iir);
+      --  Cheat: there is no allocators on universal types.
+      return Get_Base_Type (Get_Designated_Type (Base_Type))
+        = Get_Base_Type (Designated_Type);
+   end Is_Allocator_Type;
+
+   --  Return TRUE iff the type of EXPR is compatible with A_TYPE
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir) return Boolean
+   is
+      Expr_Type : constant Iir := Get_Type (Expr);
+   begin
+      if Expr_Type /= Null_Iir then
+         return Compatibility_Types1 (A_Type, Expr_Type);
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Aggregate =>
+            return Is_Aggregate_Type (A_Type);
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            return Is_String_Literal_Type (A_Type, Expr);
+         when Iir_Kind_Null_Literal =>
+            return Is_Null_Literal_Type (A_Type);
+         when Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype =>
+            return Is_Allocator_Type (A_Type, Expr);
+         when Iir_Kind_Parenthesis_Expression =>
+            return Is_Expr_Compatible (A_Type, Get_Expression (Expr));
+         when others =>
+            --  Error while EXPR was typed.  FIXME: should create an ERROR
+            --  node?
+            return False;
+      end case;
+   end Is_Expr_Compatible;
+
+   function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir
+   is
+   begin
+      if Expr = Null_Iir then
+         return Null_Iir;
+      end if;
+      case Get_Kind (Expr) is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kinds_Subtype_Definition
+           | Iir_Kind_Design_Unit
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Library_Clause
+           | Iir_Kind_Component_Declaration
+           | Iir_Kinds_Procedure_Declaration
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Element_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Psl_Declaration =>
+            Error_Msg_Sem (Disp_Node (Expr)
+                           & " not allowed in an expression", Loc);
+            return Null_Iir;
+         when Iir_Kinds_Function_Declaration =>
+            return Expr;
+         when Iir_Kind_Overload_List =>
+            return Expr;
+         when Iir_Kinds_Literal
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Simple_Aggregate
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Enumeration_Literal =>
+            return Expr;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Aggregate
+           | Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype
+           | Iir_Kind_Qualified_Expression =>
+            return Expr;
+         when Iir_Kinds_Quantity_Declaration =>
+            return Expr;
+         when Iir_Kinds_Dyadic_Operator
+           | Iir_Kinds_Monadic_Operator =>
+            return Expr;
+         when Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kinds_Expression_Attribute
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Parenthesis_Expression
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Function_Call =>
+            return Expr;
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_By_All_Name =>
+            return Expr;
+         when Iir_Kind_Error =>
+            return Expr;
+         when others =>
+            Error_Kind ("check_is_expression", Expr);
+            --N := Get_Type (Expr);
+            --return Expr;
+      end case;
+   end Check_Is_Expression;
+
+   function Check_Implicit_Conversion (Targ_Type : Iir; Expr : Iir)
+                                      return Boolean
+   is
+      Expr_Type : Iir;
+      Targ_Indexes : Iir_List;
+      Expr_Indexes : Iir_List;
+      Targ_Index : Iir;
+      Expr_Index : Iir;
+   begin
+      --  Handle errors.
+      if Targ_Type = Null_Iir or else Expr = Null_Iir then
+         return True;
+      end if;
+      if Get_Kind (Targ_Type) /= Iir_Kind_Array_Subtype_Definition
+        or else Get_Constraint_State (Targ_Type) /= Fully_Constrained
+      then
+         return True;
+      end if;
+      Expr_Type := Get_Type (Expr);
+      if Expr_Type = Null_Iir
+        or else Get_Kind (Expr_Type) /= Iir_Kind_Array_Subtype_Definition
+        or else Get_Constraint_State (Expr_Type) /= Fully_Constrained
+      then
+         return True;
+      end if;
+      Targ_Indexes := Get_Index_Subtype_List (Targ_Type);
+      Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
+      for I in Natural loop
+         Targ_Index := Get_Index_Type (Targ_Indexes, I);
+         Expr_Index := Get_Index_Type (Expr_Indexes, I);
+         exit when Targ_Index = Null_Iir and Expr_Index = Null_Iir;
+         if Targ_Index = Null_Iir or Expr_Index = Null_Iir then
+            --  Types does not match.
+            raise Internal_Error;
+         end if;
+         if Get_Type_Staticness (Targ_Index) = Locally
+           and then Get_Type_Staticness (Expr_Index) = Locally
+         then
+            if Eval_Discrete_Type_Length (Targ_Index)
+              /= Eval_Discrete_Type_Length (Expr_Index)
+            then
+               return False;
+            end if;
+         end if;
+      end loop;
+      return True;
+   end Check_Implicit_Conversion;
+
+   -- Find a type compatible with A_TYPE in TYPE_LIST (which can be an
+   -- overload list or a simple type) and return it.
+   -- In case of failure, return null.
+   function Search_Overloaded_Type (Type_List: Iir; A_Type: Iir)
+     return Iir
+   is
+      Type_List_List : Iir_List;
+      El: Iir;
+      Com : Iir;
+      Res : Iir;
+   begin
+      if not Is_Overload_List (Type_List) then
+         return Get_Common_Basetype (Get_Base_Type (Type_List),
+                                     Get_Base_Type (A_Type));
+      else
+         Type_List_List := Get_Overload_List (Type_List);
+         Res := Null_Iir;
+         for I in Natural loop
+            El := Get_Nth_Element (Type_List_List, I);
+            exit when El = Null_Iir;
+            Com := Get_Common_Basetype (Get_Base_Type (El),
+                                        Get_Base_Type (A_Type));
+            if Com /= Null_Iir then
+               if Res = Null_Iir then
+                  Res := Com;
+               else
+                  --  Several compatible types.
+                  return Null_Iir;
+               end if;
+            end if;
+         end loop;
+         return Res;
+      end if;
+   end Search_Overloaded_Type;
+
+   --  LIST1, LIST2 are either a type node or an overload list of types.
+   --  Return THE type which is compatible with LIST1 are LIST2.
+   --  Return null_iir if there is no such type or if there are several types.
+   function Search_Compatible_Type (List1, List2 : Iir) return Iir
+   is
+      List1_List : Iir_List;
+      Res : Iir;
+      El : Iir;
+      Tmp : Iir;
+   begin
+      if Is_Overload_List (List1) then
+         List1_List := Get_Overload_List (List1);
+         Res := Null_Iir;
+         for I in Natural loop
+            El := Get_Nth_Element (List1_List, I);
+            exit when El = Null_Iir;
+            Tmp := Search_Overloaded_Type (List2, El);
+            if Tmp /= Null_Iir then
+               if Res = Null_Iir then
+                  Res := Tmp;
+               else
+                  --  Several types match.
+                  return Null_Iir;
+               end if;
+            end if;
+         end loop;
+         return Res;
+      else
+         return Search_Overloaded_Type (List2, List1);
+      end if;
+   end Search_Compatible_Type;
+
+   -- Semantize the range expression EXPR.
+   -- If A_TYPE is not null_iir, EXPR is expected to be of type A_TYPE.
+   -- LRM93 3.2.1.1
+   -- FIXME: avoid to run it on an already semantized node, be careful
+   --  with range_type_expr.
+   function Sem_Simple_Range_Expression
+     (Expr: Iir_Range_Expression; A_Type: Iir; Any_Dir : Boolean)
+      return Iir_Range_Expression
+   is
+      Base_Type: Iir;
+      Left, Right: Iir;
+      Left_Type, Right_Type : Iir;
+      Expr_Type : Iir;
+   begin
+      Expr_Type := Get_Type (Expr);
+      Left := Get_Left_Limit (Expr);
+      Right := Get_Right_Limit (Expr);
+
+      if Expr_Type = Null_Iir then
+         --  Pass 1.
+
+         if A_Type = Null_Iir then
+            Base_Type := Null_Iir;
+         else
+            Base_Type := Get_Base_Type (A_Type);
+         end if;
+
+         --  Analyze left and right bounds.
+         Right := Sem_Expression_Ov (Right, Base_Type);
+         Left := Sem_Expression_Ov (Left, Base_Type);
+
+         if Left = Null_Iir or else Right = Null_Iir then
+            --  Error.
+            return Null_Iir;
+         end if;
+
+         Left_Type := Get_Type (Left);
+         Right_Type := Get_Type (Right);
+         --  Check for string or aggregate literals
+         --  FIXME: improve error message
+         if Left_Type = Null_Iir then
+            Error_Msg_Sem ("bad expression for a scalar", Left);
+            return Null_Iir;
+         end if;
+         if Right_Type = Null_Iir then
+            Error_Msg_Sem ("bad expression for a scalar", Right);
+            return Null_Iir;
+         end if;
+
+         if Is_Overload_List (Left_Type)
+           or else Is_Overload_List (Right_Type)
+         then
+            if Base_Type /= Null_Iir then
+               --  Cannot happen, since sem_expression_ov should resolve
+               --  ambiguties if a type is given.
+               raise Internal_Error;
+            end if;
+
+            --  Try to find a common type.
+            Expr_Type := Search_Compatible_Type (Left_Type, Right_Type);
+            if Expr_Type = Null_Iir then
+               if Compatibility_Types1 (Universal_Integer_Type_Definition,
+                                        Left_Type)
+                 and then
+                 Compatibility_Types1 (Universal_Integer_Type_Definition,
+                                       Right_Type)
+               then
+                  Expr_Type := Universal_Integer_Type_Definition;
+               elsif Compatibility_Types1 (Universal_Real_Type_Definition,
+                                           Left_Type)
+                 and then
+                 Compatibility_Types1 (Universal_Real_Type_Definition,
+                                       Right_Type)
+               then
+                  Expr_Type := Universal_Real_Type_Definition;
+               else
+                  --  FIXME: handle overload
+                  Error_Msg_Sem
+                    ("left and right expressions of range are not compatible",
+                     Expr);
+                  return Null_Iir;
+               end if;
+            end if;
+            Left := Sem_Expression (Left, Expr_Type);
+            Right := Sem_Expression (Right, Expr_Type);
+            if Left = Null_Iir or else Right = Null_Iir then
+               return Null_Iir;
+            end if;
+         else
+            Expr_Type := Get_Common_Basetype (Get_Base_Type (Left_Type),
+                                              Get_Base_Type (Right_Type));
+            if Expr_Type = Null_Iir then
+               Error_Msg_Sem
+                 ("left and right expressions of range are not compatible",
+                  Expr);
+               return Null_Iir;
+            end if;
+         end if;
+
+         --  The type of the range is known, finish analysis.
+      else
+         --  Second call.
+
+         pragma Assert (A_Type /= Null_Iir);
+
+         if Is_Overload_List (Expr_Type) then
+            --  FIXME: resolve overload
+            raise Internal_Error;
+         else
+            if not Are_Types_Compatible (Expr_Type, A_Type) then
+               Error_Msg_Sem
+                 ("type of range doesn't match expected type", Expr);
+               return Null_Iir;
+            end if;
+
+            return Expr;
+         end if;
+      end if;
+
+      Left := Eval_Expr_If_Static (Left);
+      Right := Eval_Expr_If_Static (Right);
+      Set_Left_Limit (Expr, Left);
+      Set_Right_Limit (Expr, Right);
+      Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Left),
+                                      Get_Expr_Staticness (Right)));
+
+      if A_Type /= Null_Iir
+        and then not Are_Types_Compatible (Expr_Type, A_Type)
+      then
+         Error_Msg_Sem ("type of range doesn't match expected type", Expr);
+         return Null_Iir;
+      end if;
+
+      Set_Type (Expr, Expr_Type);
+      if Get_Kind (Get_Base_Type (Expr_Type))
+        not in Iir_Kinds_Scalar_Type_Definition
+      then
+         Error_Msg_Sem ("type of range is not a scalar type", Expr);
+         return Null_Iir;
+      end if;
+
+      if Get_Expr_Staticness (Expr) = Locally
+        and then Get_Type_Staticness (Expr_Type) = Locally
+        and then Get_Kind (Expr_Type) in Iir_Kinds_Subtype_Definition
+      then
+         Eval_Check_Range (Expr, Expr_Type, Any_Dir);
+      end if;
+
+      return Expr;
+   end Sem_Simple_Range_Expression;
+
+   -- The result can be:
+   --  a subtype definition
+   --  a range attribute
+   --  a range type definition
+   -- LRM93 3.2.1.1
+   -- FIXME: avoid to run it on an already semantized node, be careful
+   --  with range_type_expr.
+   function Sem_Range_Expression (Expr: Iir; A_Type: Iir; Any_Dir : Boolean)
+                                 return Iir
+   is
+      Res : Iir;
+      Res_Type : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Range_Expression =>
+            Res := Sem_Simple_Range_Expression (Expr, A_Type, Any_Dir);
+            if Res = Null_Iir then
+               return Null_Iir;
+            end if;
+            Res_Type := Get_Type (Res);
+
+         when Iir_Kinds_Denoting_Name
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Parenthesis_Name =>
+            if Get_Named_Entity (Expr) = Null_Iir then
+               Sem_Name (Expr);
+            end if;
+            Res := Name_To_Range (Expr);
+            if Res = Error_Mark then
+               return Null_Iir;
+            end if;
+
+            case Get_Kind (Res) is
+               when Iir_Kind_Simple_Name
+                 | Iir_Kind_Selected_Name =>
+                  pragma Assert (Get_Kind (Get_Named_Entity (Res))
+                                   in Iir_Kinds_Type_Declaration);
+                  Res_Type := Get_Type (Get_Named_Entity (Res));
+               when Iir_Kind_Range_Array_Attribute
+                 | Iir_Kind_Reverse_Range_Array_Attribute =>
+                  Res_Type := Get_Type (Res);
+               when others =>
+                  Error_Msg_Sem ("name must denote a range", Expr);
+                  return Null_Iir;
+            end case;
+            if A_Type /= Null_Iir
+              and then Get_Base_Type (Res_Type) /= Get_Base_Type (A_Type)
+            then
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            end if;
+
+         when others =>
+            Error_Msg_Sem ("range expression required", Expr);
+            return Null_Iir;
+      end case;
+
+      if Get_Kind (Res_Type) not in Iir_Kinds_Scalar_Type_Definition then
+         Error_Msg_Sem (Disp_Node (Res) & " is not a range type", Expr);
+         return Null_Iir;
+      end if;
+
+      Res := Eval_Range_If_Static (Res);
+
+      if A_Type /= Null_Iir
+        and then Get_Type_Staticness (A_Type) = Locally
+        and then Get_Kind (A_Type) in Iir_Kinds_Subtype_Definition
+      then
+         if Get_Expr_Staticness (Res) = Locally then
+            Eval_Check_Range (Res, A_Type, Any_Dir);
+         end if;
+      end if;
+      return Res;
+   end Sem_Range_Expression;
+
+   function Sem_Discrete_Range_Expression
+     (Expr: Iir; A_Type: Iir; Any_Dir : Boolean)
+     return Iir
+   is
+      Res : Iir;
+      Res_Type : Iir;
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Subtype_Definition then
+         Res := Sem_Types.Sem_Subtype_Indication (Expr);
+         if Res = Null_Iir then
+            return Null_Iir;
+         end if;
+
+         Res_Type := Res;
+         if A_Type /= Null_Iir
+           and then (not Are_Types_Compatible
+                       (A_Type, Get_Type_Of_Subtype_Indication (Res)))
+         then
+            --  A_TYPE is known when analyzing an index_constraint within
+            --  a subtype indication.
+            Error_Msg_Sem ("subtype " & Disp_Node (Res)
+                             & " doesn't match expected type "
+                             & Disp_Node (A_Type), Expr);
+            --  FIXME: override type of RES ?
+         end if;
+      else
+         Res := Sem_Range_Expression (Expr, A_Type, Any_Dir);
+
+         if Res = Null_Iir then
+            return Null_Iir;
+         end if;
+
+         Res_Type := Get_Type (Res);
+      end if;
+
+      --  Check the type is discrete.
+      if Get_Kind (Res_Type) not in Iir_Kinds_Discrete_Type_Definition then
+         if Get_Kind (Res_Type) /= Iir_Kind_Error then
+            --  FIXME: avoid that test with error.
+            if Get_Kind (Res) not in Iir_Kinds_Denoting_Name then
+               Error_Msg_Sem ("range is not discrete", Res);
+            else
+               Error_Msg_Sem
+                 (Disp_Node (Res) & " is not a discrete range type", Expr);
+            end if;
+         end if;
+         return Null_Iir;
+      end if;
+
+      return Res;
+   end Sem_Discrete_Range_Expression;
+
+   function Sem_Discrete_Range_Integer (Expr: Iir) return Iir
+   is
+      Res : Iir;
+      Range_Type : Iir;
+   begin
+      Res := Sem_Discrete_Range_Expression (Expr, Null_Iir, True);
+      if Res = Null_Iir then
+         return Null_Iir;
+      end if;
+      if Get_Kind (Expr) /= Iir_Kind_Range_Expression then
+         return Res;
+      end if;
+
+      Range_Type := Get_Type (Res);
+      if Range_Type = Convertible_Integer_Type_Definition then
+         --  LRM 3.2.1.1  Index constraints and discrete ranges
+         --  For a discrete range used in a constrained array
+         --  definition and defined by a range, an implicit
+         --  conversion to the predefined type INTEGER is assumed
+         --  if each bound is either a numeric literal or an
+         --  attribute, and the type of both bounds (prior to the
+         --  implicit conversion) is the type universal_integer.
+
+         --  FIXME: catch phys/phys.
+         Set_Type (Res, Integer_Type_Definition);
+         if Get_Expr_Staticness (Res) = Locally then
+            Eval_Check_Range (Res, Integer_Subtype_Definition, True);
+         end if;
+      elsif Range_Type = Universal_Integer_Type_Definition then
+         if Vhdl_Std >= Vhdl_08 then
+            --  LRM08 5.3.2.2
+            --  For a discrete range used in a constrained array definition
+            --  and defined by a range, an implicit conversion to the
+            --  predefined type INTEGER is assumed if the type of both bounds
+            --  (prior the implicit conversion) is the type universal_integer.
+            null;
+         elsif Vhdl_Std = Vhdl_93c then
+            --  GHDL: this is not allowed, however often used:
+            --  eg: for i in 0 to v'length + 1 loop
+            --  eg: for i in -1 to 1 loop
+
+            --  Be tolerant.
+            Warning_Msg_Sem ("universal integer bound must be numeric literal "
+                             & "or attribute", Res);
+         else
+            Error_Msg_Sem ("universal integer bound must be numeric literal "
+                           & "or attribute", Res);
+         end if;
+         Set_Type (Res, Integer_Type_Definition);
+      end if;
+      return Res;
+   end Sem_Discrete_Range_Integer;
+
+   procedure Set_Function_Call_Staticness (Expr : Iir; Imp : Iir)
+   is
+      Staticness : Iir_Staticness;
+   begin
+      --  LRM93 7.4.1 (Locally Static Primaries)
+      --  4. a function call whose function name denotes an implicitly
+      --     defined operator, and whose actual parameters are each
+      --     locally static expressions;
+      --
+      --  LRM93 7.4.2 (Globally Static Primaries)
+      --  9. a function call whose function name denotes a pure function,
+      --     and whose actual parameters are each globally static
+      --     expressions.
+      case Get_Kind (Expr) is
+         when Iir_Kinds_Monadic_Operator =>
+            Staticness := Get_Expr_Staticness (Get_Operand (Expr));
+         when Iir_Kinds_Dyadic_Operator =>
+            Staticness := Min (Get_Expr_Staticness (Get_Left (Expr)),
+                               Get_Expr_Staticness (Get_Right (Expr)));
+         when Iir_Kind_Function_Call =>
+            Staticness := Locally;
+            declare
+               Assoc : Iir;
+            begin
+               Assoc := Get_Parameter_Association_Chain (Expr);
+               while Assoc /= Null_Iir loop
+                  if Get_Kind (Assoc) /= Iir_Kind_Association_Element_Open then
+                     Staticness := Min
+                       (Get_Expr_Staticness (Get_Actual (Assoc)),
+                        Staticness);
+                  end if;
+                  Assoc := Get_Chain (Assoc);
+               end loop;
+            end;
+         when Iir_Kind_Procedure_Call =>
+            return;
+         when others =>
+            Error_Kind ("set_function_call_staticness (1)", Expr);
+      end case;
+      case Get_Kind (Imp) is
+         when Iir_Kind_Implicit_Function_Declaration =>
+            if Get_Implicit_Definition (Imp)
+              not in Iir_Predefined_Pure_Functions
+            then
+               --  Predefined functions such as Now, Endfile are not static.
+               Staticness := None;
+            end if;
+         when Iir_Kind_Function_Declaration =>
+            if Get_Pure_Flag (Imp) then
+               Staticness := Min (Staticness, Globally);
+            else
+               Staticness := None;
+            end if;
+         when others =>
+            Error_Kind ("set_function_call_staticness (2)", Imp);
+      end case;
+      Set_Expr_Staticness (Expr, Staticness);
+   end Set_Function_Call_Staticness;
+
+   --  Add CALLEE in the callees list of SUBPRG (which must be a subprg decl).
+   procedure Add_In_Callees_List (Subprg : Iir; Callee : Iir)
+   is
+      Holder : constant Iir := Get_Callees_List_Holder (Subprg);
+      List : Iir_List;
+   begin
+      List := Get_Callees_List (Holder);
+      if List = Null_Iir_List then
+         List := Create_Iir_List;
+         Set_Callees_List (Holder, List);
+      end if;
+      --  FIXME: May use a flag in IMP to speed up the
+      --  add operation.
+      Add_Element (List, Callee);
+   end Add_In_Callees_List;
+
+   --  Check purity rules when SUBPRG calls CALLEE.
+   --  Both SUBPRG and CALLEE are subprogram declarations.
+   --  Update purity_state/impure_depth of SUBPRG if it is a procedure.
+   procedure Sem_Call_Purity_Check (Subprg : Iir; Callee : Iir; Loc : Iir)
+   is
+   begin
+      if Callee = Subprg then
+         return;
+      end if;
+
+      --  Handle easy cases.
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            if not Get_Pure_Flag (Subprg) then
+               return;
+            end if;
+         when Iir_Kind_Procedure_Declaration =>
+            if Get_Purity_State (Subprg) = Impure then
+               return;
+            end if;
+         when Iir_Kinds_Process_Statement =>
+            return;
+         when others =>
+            Error_Kind ("sem_call_purity_check(0)", Subprg);
+      end case;
+
+      case Get_Kind (Callee) is
+         when Iir_Kind_Function_Declaration =>
+            if Get_Pure_Flag (Callee) then
+               --  Pure functions may be called anywhere.
+               return;
+            end if;
+            --  CALLEE is impure.
+            case Get_Kind (Subprg) is
+               when Iir_Kind_Function_Declaration =>
+                  Error_Pure (Subprg, Callee, Loc);
+               when Iir_Kind_Procedure_Declaration =>
+                  Set_Purity_State (Subprg, Impure);
+               when others =>
+                  Error_Kind ("sem_call_purity_check(1)", Subprg);
+            end case;
+         when Iir_Kind_Procedure_Declaration =>
+            declare
+               Depth : Iir_Int32;
+               Callee_Body : Iir;
+               Subprg_Body : Iir;
+            begin
+               Callee_Body := Get_Subprogram_Body (Callee);
+               Subprg_Body := Get_Subprogram_Body (Subprg);
+               --  Get purity depth of callee, if possible.
+               case Get_Purity_State (Callee) is
+                  when Pure =>
+                     return;
+                  when Impure =>
+                     Depth := Iir_Depth_Impure;
+                  when Maybe_Impure =>
+                     if Callee_Body = Null_Iir then
+                        --  Cannot be 'maybe_impure' if no body!
+                        raise Internal_Error;
+                     end if;
+                     Depth := Get_Impure_Depth (Callee_Body);
+                  when Unknown =>
+                     --  Add in list.
+                     Add_In_Callees_List (Subprg, Callee);
+
+                     if Callee_Body /= Null_Iir then
+                        Depth := Get_Impure_Depth (Callee_Body);
+                     else
+                        return;
+                     end if;
+               end case;
+               case Get_Kind (Subprg) is
+                  when Iir_Kind_Function_Declaration =>
+                     if Depth = Iir_Depth_Impure then
+                        Error_Pure (Subprg, Callee, Loc);
+                     else
+                        if Depth < Get_Subprogram_Depth (Subprg) then
+                           Error_Pure (Subprg, Callee, Loc);
+                        end if;
+                     end if;
+                  when Iir_Kind_Procedure_Declaration =>
+                     if Depth = Iir_Depth_Impure then
+                        Set_Purity_State (Subprg, Impure);
+                        --  FIXME: free callee list ? (wait state).
+                     else
+                        --  Set depth to the worst.
+                        if Depth < Get_Impure_Depth (Subprg_Body) then
+                           Set_Impure_Depth (Subprg_Body, Depth);
+                        end if;
+                     end if;
+                  when others =>
+                     Error_Kind ("sem_call_purity_check(2)", Subprg);
+               end case;
+            end;
+         when others =>
+            Error_Kind ("sem_call_purity_check", Callee);
+      end case;
+   end Sem_Call_Purity_Check;
+
+   procedure Sem_Call_Wait_Check (Subprg : Iir; Callee : Iir; Loc : Iir)
+   is
+      procedure Error_Wait is
+      begin
+         Error_Msg_Sem
+           (Disp_Node (Subprg) & " must not contain wait statement, but calls",
+            Loc);
+         Error_Msg_Sem
+           (Disp_Node (Callee) & " which has (indirectly) a wait statement",
+            Callee);
+         --Error_Msg_Sem
+         --  ("(indirect) wait statement not allowed in " & Where, Loc);
+      end Error_Wait;
+   begin
+      pragma Assert (Get_Kind (Callee) = Iir_Kind_Procedure_Declaration);
+
+      case Get_Wait_State (Callee) is
+         when False =>
+            return;
+         when True =>
+            null;
+         when Unknown =>
+            Add_In_Callees_List (Subprg, Callee);
+            return;
+      end case;
+
+      --  LRM 8.1
+      --  It is an error if a wait statement appears [...] in a procedure that
+      --  has a parent that is a function subprogram.
+      --
+      --  Furthermore, it is an error if a wait statement appears [...] in a
+      --  procedure that has a parent that is such a process statement.
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Sensitized_Process_Statement =>
+            Error_Wait;
+            return;
+         when Iir_Kind_Process_Statement =>
+            return;
+         when Iir_Kind_Function_Declaration =>
+            Error_Wait;
+            return;
+         when Iir_Kind_Procedure_Declaration =>
+            if Is_Subprogram_Method (Subprg) then
+               Error_Wait;
+            else
+               Set_Wait_State (Subprg, True);
+            end if;
+         when others =>
+            Error_Kind ("sem_call_wait_check", Subprg);
+      end case;
+   end Sem_Call_Wait_Check;
+
+   procedure Sem_Call_All_Sensitized_Check
+     (Subprg : Iir; Callee : Iir; Loc : Iir)
+   is
+   begin
+      --  No need to deal with 'process (all)' if standard predates it.
+      if Vhdl_Std < Vhdl_08 then
+         return;
+      end if;
+
+      --  If subprogram called is pure, then there is no signals reference.
+      case Get_Kind (Callee) is
+         when Iir_Kind_Function_Declaration =>
+            if Get_Pure_Flag (Callee) then
+               return;
+            end if;
+         when Iir_Kind_Procedure_Declaration =>
+            if Get_Purity_State (Callee) = Pure then
+               return;
+            end if;
+         when others =>
+            Error_Kind ("sem_call_all_sensitized_check", Callee);
+      end case;
+
+      case Get_All_Sensitized_State (Callee) is
+         when Invalid_Signal =>
+            case Get_Kind (Subprg) is
+               when Iir_Kind_Sensitized_Process_Statement =>
+                  if Get_Sensitivity_List (Subprg) = Iir_List_All then
+                     --  LRM08 11.3
+                     --
+                     --  It is an error if a process statement with the
+                     --  reserved word ALL as its process sensitivity list
+                     --  is the parent of a subprogram declared in a design
+                     --  unit other than that containing the process statement
+                     --  and the subprogram reads an explicitly declared
+                     --  signal that is not a formal signal parameter or
+                     --  member of a formal signal parameter of the
+                     --  subprogram or of any of its parents.  Similarly,
+                     --  it is an error if such subprogram reads an implicit
+                     --  signal whose explicit ancestor is not a formal signal
+                     --  parameter or member of a formal parameter of
+                     --  the subprogram or of any of its parents.
+                     Error_Msg_Sem
+                       ("all-sensitized " & Disp_Node (Subprg)
+                          & " can't call " & Disp_Node (Callee), Loc);
+                     Error_Msg_Sem
+                       (" (as this subprogram reads (indirectly) a signal)",
+                        Loc);
+                  end if;
+               when Iir_Kind_Process_Statement =>
+                  return;
+               when Iir_Kind_Function_Declaration
+                 | Iir_Kind_Procedure_Declaration =>
+                  Set_All_Sensitized_State (Subprg, Invalid_Signal);
+               when others =>
+                  Error_Kind ("sem_call_all_sensitized_check", Subprg);
+            end case;
+         when Read_Signal =>
+            --  Put this subprogram in callees list as it may read a signal.
+            --  Used by canon to build the sensitivity list.
+            Add_In_Callees_List (Subprg, Callee);
+            if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
+               if Get_All_Sensitized_State (Subprg) < Read_Signal then
+                  Set_All_Sensitized_State (Subprg, Read_Signal);
+               end if;
+            end if;
+         when Unknown =>
+            --  Put this subprogram in callees list as it may read a signal.
+            --  Used by canon to build the sensitivity list.
+            Add_In_Callees_List (Subprg, Callee);
+         when No_Signal =>
+            null;
+      end case;
+   end Sem_Call_All_Sensitized_Check;
+
+   --  Set IMP as the implementation to being called by EXPR.
+   --  If the context is a subprogram or a process (ie, if current_subprogram
+   --  is not NULL), then mark IMP as callee of current_subprogram, and
+   --  update states.
+   procedure Sem_Subprogram_Call_Finish (Expr : Iir; Imp : Iir)
+   is
+      Subprg : constant Iir := Get_Current_Subprogram;
+   begin
+      Set_Function_Call_Staticness (Expr, Imp);
+      Mark_Subprogram_Used (Imp);
+
+      --  Check purity/wait/passive.
+
+      if Subprg = Null_Iir then
+         --  Not inside a suprogram or a process.
+         return;
+      end if;
+      if Subprg = Imp then
+         --  Recursive call.
+         return;
+      end if;
+
+      case Get_Kind (Imp) is
+         when Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            if Get_Implicit_Definition (Imp) in Iir_Predefined_Pure_Functions
+            then
+               return;
+            end if;
+         when Iir_Kind_Function_Declaration =>
+            Sem_Call_Purity_Check (Subprg, Imp, Expr);
+            Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr);
+         when Iir_Kind_Procedure_Declaration =>
+            Sem_Call_Purity_Check (Subprg, Imp, Expr);
+            Sem_Call_Wait_Check (Subprg, Imp, Expr);
+            Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr);
+            --  Check passive.
+            if Get_Passive_Flag (Imp) = False then
+               case Get_Kind (Subprg) is
+                  when Iir_Kinds_Process_Statement =>
+                     if Get_Passive_Flag (Subprg) then
+                        Error_Msg_Sem
+                          (Disp_Node (Subprg)
+                           & " is passive, but calls non-passive "
+                           & Disp_Node (Imp), Expr);
+                     end if;
+                  when others =>
+                     null;
+               end case;
+            end if;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Sem_Subprogram_Call_Finish;
+
+   --  EXPR is a function or procedure call.
+   function Sem_Subprogram_Call_Stage1
+     (Expr : Iir; A_Type : Iir; Is_Func_Call : Boolean)
+     return Iir
+   is
+      Imp : Iir;
+      Nbr_Inter: Natural;
+      A_Func: Iir;
+      Imp_List: Iir_List;
+      Assoc_Chain: Iir;
+      Inter_Chain : Iir;
+      Res_Type: Iir_List;
+      Inter: Iir;
+      Match : Boolean;
+   begin
+      --  Sem_Name has gathered all the possible names for the prefix of this
+      --  call.  Reduce this list to only names that match the types.
+      Nbr_Inter := 0;
+      Imp := Get_Implementation (Expr);
+      Imp_List := Get_Overload_List (Imp);
+      Assoc_Chain := Get_Parameter_Association_Chain (Expr);
+
+      for I in Natural loop
+         A_Func := Get_Nth_Element (Imp_List, I);
+         exit when A_Func = Null_Iir;
+
+         case Get_Kind (A_Func) is
+            when Iir_Kinds_Functions_And_Literals =>
+               if not Is_Func_Call then
+                  --  The identifier of a function call must be a function or
+                  --  an enumeration literal.
+                  goto Continue;
+               end if;
+            when Iir_Kinds_Procedure_Declaration =>
+               if Is_Func_Call then
+                  --  The identifier of a procedure call must be a procedure.
+                  goto Continue;
+               end if;
+            when others =>
+               Error_Kind ("sem_subprogram_call_stage1", A_Func);
+         end case;
+
+         --  Keep this interpretation only if compatible.
+         if A_Type = Null_Iir
+           or else Compatibility_Nodes (A_Type, Get_Return_Type (A_Func))
+         then
+            Sem_Association_Chain
+              (Get_Interface_Declaration_Chain (A_Func),
+               Assoc_Chain, False, Missing_Parameter, Expr, Match);
+            if Match then
+               Replace_Nth_Element (Imp_List, Nbr_Inter, A_Func);
+               Nbr_Inter := Nbr_Inter + 1;
+            end if;
+         end if;
+
+         << Continue >> null;
+      end loop;
+      Set_Nbr_Elements (Imp_List, Nbr_Inter);
+
+      -- Set_Implementation (Expr, Inter_List);
+      -- A set of possible functions to call is in INTER_LIST.
+      -- Create a set of possible return type in RES_TYPE.
+      case Nbr_Inter is
+         when 0 =>
+            --  FIXME: display subprogram name.
+            Error_Msg_Sem
+              ("cannot resolve overloading for subprogram call", Expr);
+            return Null_Iir;
+
+         when 1 =>
+            --  Simple case: no overloading.
+            Inter := Get_First_Element (Imp_List);
+            Free_Overload_List (Imp);
+            Set_Implementation (Expr, Inter);
+            if Is_Func_Call then
+               Set_Type (Expr, Get_Return_Type (Inter));
+            end if;
+            Inter_Chain := Get_Interface_Declaration_Chain (Inter);
+            Sem_Association_Chain
+              (Inter_Chain, Assoc_Chain,
+               True, Missing_Parameter, Expr, Match);
+            Set_Parameter_Association_Chain (Expr, Assoc_Chain);
+            if not Match then
+               raise Internal_Error;
+            end if;
+            Check_Subprogram_Associations (Inter_Chain, Assoc_Chain);
+            Sem_Subprogram_Call_Finish (Expr, Inter);
+            return Expr;
+
+         when others =>
+            if Is_Func_Call then
+               if A_Type /= Null_Iir then
+                  -- Cannot find a single interpretation for a given
+                  -- type.
+                  Error_Overload (Expr);
+                  Disp_Overload_List (Imp_List, Expr);
+                  return Null_Iir;
+               end if;
+
+               --  Create the list of types for the result.
+               Res_Type := Create_Iir_List;
+               for I in 0 .. Nbr_Inter - 1 loop
+                  Add_Element
+                    (Res_Type,
+                     Get_Return_Type (Get_Nth_Element (Imp_List, I)));
+               end loop;
+
+               if Get_Nbr_Elements (Res_Type) = 1 then
+                  -- several implementations but one profile.
+                  Error_Overload (Expr);
+                  Disp_Overload_List (Imp_List, Expr);
+                  return Null_Iir;
+               end if;
+               Set_Type (Expr, Create_Overload_List (Res_Type));
+            else
+               --  For a procedure call, the context does't help to resolve
+               --  overload.
+               Error_Overload (Expr);
+               Disp_Overload_List (Imp_List, Expr);
+            end if;
+            return Expr;
+      end case;
+   end Sem_Subprogram_Call_Stage1;
+
+   -- For a procedure call, A_TYPE must be null.
+   --  Associations must have already been semantized by sem_association_list.
+   function Sem_Subprogram_Call (Expr: Iir; A_Type: Iir) return Iir
+   is
+      Is_Func: constant Boolean := Get_Kind (Expr) = Iir_Kind_Function_Call;
+      Res_Type: Iir;
+      Res: Iir;
+      Inter_List: Iir;
+      Param_Chain : Iir;
+      Inter: Iir;
+      Assoc_Chain : Iir;
+      Match : Boolean;
+   begin
+      if Is_Func then
+         Res_Type := Get_Type (Expr);
+      end if;
+
+      if not Is_Func or else Res_Type = Null_Iir then
+         -- First call to sem_subprogram_call.
+         -- Create the list of possible implementations and possible
+         -- return types, according to arguments and A_TYPE.
+
+         -- Select possible interpretations among all interpretations.
+         -- NOTE: the list of possible implementations was already created
+         --  during the transformation of iir_kind_parenthesis_name to
+         --  iir_kind_function_call.
+         Inter_List := Get_Implementation (Expr);
+         if Get_Kind (Inter_List) = Iir_Kind_Error then
+            return Null_Iir;
+         elsif Is_Overload_List (Inter_List) then
+            --  Subprogram name is overloaded.
+            return Sem_Subprogram_Call_Stage1 (Expr, A_Type, Is_Func);
+         else
+            --  Only one interpretation for the subprogram name.
+            if Is_Func then
+               if Get_Kind (Inter_List) not in Iir_Kinds_Function_Declaration
+               then
+                  Error_Msg_Sem ("name does not designate a function", Expr);
+                  return Null_Iir;
+               end if;
+            else
+               if Get_Kind (Inter_List) not in Iir_Kinds_Procedure_Declaration
+               then
+                  Error_Msg_Sem ("name does not designate a procedure", Expr);
+                  return Null_Iir;
+               end if;
+            end if;
+
+            Assoc_Chain := Get_Parameter_Association_Chain (Expr);
+            Param_Chain := Get_Interface_Declaration_Chain (Inter_List);
+            Sem_Association_Chain
+              (Param_Chain, Assoc_Chain,
+               True, Missing_Parameter, Expr, Match);
+            Set_Parameter_Association_Chain (Expr, Assoc_Chain);
+            if not Match then
+               --  No need to disp an error message, this is done by
+               --  sem_subprogram_arguments.
+               return Null_Iir;
+            end if;
+            if Is_Func then
+               Set_Type (Expr, Get_Return_Type (Inter_List));
+            end if;
+            Check_Subprogram_Associations (Param_Chain, Assoc_Chain);
+            Set_Implementation (Expr, Inter_List);
+            Sem_Subprogram_Call_Finish (Expr, Inter_List);
+            return Expr;
+         end if;
+      end if;
+
+      --  Second call to Sem_Function_Call (only for functions).
+      pragma Assert (Is_Func);
+      pragma Assert (A_Type /= Null_Iir);
+
+      -- The implementation list was set.
+      -- The return type was set.
+      -- A_TYPE is not null, A_TYPE is *the* return type.
+
+      Inter_List := Get_Implementation (Expr);
+
+      -- Find a single implementation.
+      Res := Null_Iir;
+      if Is_Overload_List (Inter_List) then
+         -- INTER_LIST is a list of possible declaration to call.
+         -- Find one, based on the return type A_TYPE.
+         for I in Natural loop
+            Inter := Get_Nth_Element (Get_Overload_List (Inter_List), I);
+            exit when Inter = Null_Iir;
+            if Are_Basetypes_Compatible
+              (A_Type, Get_Base_Type (Get_Return_Type (Inter)))
+            then
+               if Res /= Null_Iir then
+                  Error_Overload (Expr);
+                  Disp_Overload_List (Get_Overload_List (Inter_List), Expr);
+                  return Null_Iir;
+               else
+                  Res := Inter;
+               end if;
+            end if;
+         end loop;
+      else
+         if Are_Basetypes_Compatible
+           (A_Type, Get_Base_Type (Get_Return_Type (Inter_List)))
+         then
+            Res := Inter_List;
+         end if;
+      end if;
+      if Res = Null_Iir then
+         Not_Match (Expr, A_Type);
+         return Null_Iir;
+      end if;
+
+      -- Clean up.
+      if Res_Type /= Null_Iir and then Is_Overload_List (Res_Type) then
+         Free_Iir (Res_Type);
+      end if;
+
+      if Is_Overload_List (Inter_List) then
+         Free_Iir (Inter_List);
+      end if;
+
+      --  Simple case: this is not a call to a function, but an enumeration
+      --  literal.
+      if Get_Kind (Res) = Iir_Kind_Enumeration_Literal then
+         -- Free_Iir (Expr);
+         return Res;
+      end if;
+
+      -- Set types.
+      Set_Type (Expr, Get_Return_Type (Res));
+      Assoc_Chain := Get_Parameter_Association_Chain (Expr);
+      Param_Chain := Get_Interface_Declaration_Chain (Res);
+      Sem_Association_Chain
+        (Param_Chain, Assoc_Chain, True, Missing_Parameter, Expr, Match);
+      Set_Parameter_Association_Chain (Expr, Assoc_Chain);
+      if not Match then
+         return Null_Iir;
+      end if;
+      Check_Subprogram_Associations (Param_Chain, Assoc_Chain);
+      Set_Implementation (Expr, Res);
+      Sem_Subprogram_Call_Finish (Expr, Res);
+      return Expr;
+   end Sem_Subprogram_Call;
+
+   procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir)
+   is
+      Imp: Iir;
+      Name : Iir;
+      Parameters_Chain : Iir;
+      Param : Iir;
+      Formal : Iir;
+      Prefix : Iir;
+      Inter : Iir;
+   begin
+      Name := Get_Prefix (Call);
+      --  FIXME: check for denoting name.
+      Sem_Name (Name);
+
+      --  Return now if the procedure declaration wasn't found.
+      Imp := Get_Named_Entity (Name);
+      if Is_Error (Imp) then
+         return;
+      end if;
+      Set_Implementation (Call, Imp);
+
+      Name_To_Method_Object (Call, Name);
+      Parameters_Chain := Get_Parameter_Association_Chain (Call);
+      if Sem_Actual_Of_Association_Chain (Parameters_Chain) = False then
+         return;
+      end if;
+      if Sem_Subprogram_Call (Call, Null_Iir) /= Call then
+         return;
+      end if;
+      Imp := Get_Implementation (Call);
+      if Is_Overload_List (Imp) then
+         --  Failed to resolve overload.
+         return;
+      end if;
+      Set_Named_Entity (Name, Imp);
+      Set_Prefix (Call, Finish_Sem_Name (Name));
+
+      --  LRM 2.1.1.2 Signal Parameters
+      --  A process statement contains a driver for each actual signal
+      --  associated with a formal signal parameter of mode OUT or INOUT in
+      --  a subprogram call.
+      --  Similarly, a subprogram contains a driver for each formal signal
+      --  parameter of mode OUT or INOUT declared in its subrogram
+      --  specification.
+      Param := Parameters_Chain;
+      Inter := Get_Interface_Declaration_Chain (Imp);
+      while Param /= Null_Iir loop
+         Formal := Get_Formal (Param);
+         if Formal = Null_Iir then
+            Formal := Inter;
+            Inter := Get_Chain (Inter);
+         else
+            Formal := Get_Base_Name (Formal);
+            Inter := Null_Iir;
+         end if;
+         if Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration
+           and then Get_Mode (Formal) in Iir_Out_Modes
+         then
+            Prefix := Name_To_Object (Get_Actual (Param));
+            if Prefix /= Null_Iir then
+               case Get_Kind (Get_Object_Prefix (Prefix)) is
+                  when Iir_Kind_Signal_Declaration
+                    | Iir_Kind_Interface_Signal_Declaration =>
+                     Prefix := Get_Longuest_Static_Prefix (Prefix);
+                     Sem_Stmts.Sem_Add_Driver (Prefix, Stmt);
+                  when others =>
+                     null;
+               end case;
+            end if;
+         end if;
+         Param := Get_Chain (Param);
+      end loop;
+   end Sem_Procedure_Call;
+
+   --  List must be an overload list containing subprograms declarations.
+   --  Try to resolve overload and return the uniq interpretation if one,
+   --  NULL_IIR otherwise.
+   --
+   --  If there are two functions, one primitive of a universal
+   --  type and the other not, return the primitive of the universal type.
+   --  This rule is *not* from LRM (but from Ada) and allows to resolve
+   --  common cases such as:
+   --    constant c1 : integer := - 4; -- or '+', 'abs'
+   --    constant c2 : integer := 2 ** 3;
+   --    constant c3 : integer := 3 - 2; -- or '+', '*', '/'...
+   function Get_Non_Implicit_Subprogram (List : Iir_List) return Iir
+   is
+      El : Iir;
+      Res : Iir;
+      Ref_Type : Iir;
+   begin
+      --  Conditions:
+      --  1. All the possible functions must return boolean.
+      --  2. There is only one implicit function for universal or real.
+      Res := Null_Iir;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if Get_Base_Type (Get_Return_Type (El)) /= Boolean_Type_Definition
+         then
+            return Null_Iir;
+         end if;
+
+         if Get_Kind (El) = Iir_Kind_Implicit_Function_Declaration then
+            Ref_Type := Get_Type_Reference (El);
+            if Ref_Type = Universal_Integer_Type_Declaration
+              or Ref_Type = Universal_Real_Type_Declaration
+            then
+               if Res = Null_Iir then
+                  Res := El;
+               else
+                  return Null_Iir;
+               end if;
+            end if;
+         end if;
+      end loop;
+      return Res;
+   end Get_Non_Implicit_Subprogram;
+
+   --  Honor the -fexplicit flag.
+   --  If LIST is composed of 2 declarations that matches the 'explicit' rule,
+   --   return the explicit declaration.
+   --  Otherwise, return NULL_IIR.
+   function Get_Explicit_Subprogram (List : Iir_List) return Iir
+   is
+      Sub1 : Iir;
+      Sub2 : Iir;
+      Res : Iir;
+   begin
+      if Get_Nbr_Elements (List) /= 2 then
+         return Null_Iir;
+      end if;
+
+      Sub1 := Get_Nth_Element (List, 0);
+      Sub2 := Get_Nth_Element (List, 1);
+
+      --  One must be an implicit declaration, the other must be an explicit
+      --  declaration.
+      if Get_Kind (Sub1) = Iir_Kind_Implicit_Function_Declaration then
+         if Get_Kind (Sub2) /= Iir_Kind_Function_Declaration then
+            return Null_Iir;
+         end if;
+         Res := Sub2;
+      elsif Get_Kind (Sub1) = Iir_Kind_Function_Declaration then
+         if Get_Kind (Sub2) /= Iir_Kind_Implicit_Function_Declaration then
+            return Null_Iir;
+         end if;
+         Res := Sub1;
+      else
+         Error_Kind ("get_explicit_subprogram", Sub1);
+      end if;
+
+      --  They must have the same profile.
+      if Get_Subprogram_Hash (Sub1) /= Get_Subprogram_Hash (Sub2)
+        or else not Is_Same_Profile (Sub1, Sub2)
+      then
+         return Null_Iir;
+      end if;
+
+      --  They must be declared in a package.
+      if Get_Kind (Get_Parent (Sub1)) /= Iir_Kind_Package_Declaration
+        or else Get_Kind (Get_Parent (Sub2)) /= Iir_Kind_Package_Declaration
+      then
+         return Null_Iir;
+      end if;
+
+      return Res;
+   end Get_Explicit_Subprogram;
+
+   --  Set when the -fexplicit option was adviced.
+   Explicit_Advice_Given : Boolean := False;
+
+   function Sem_Operator (Expr : Iir; Res_Type : Iir; Arity : Positive)
+      return Iir
+   is
+      Operator : Name_Id;
+      Left, Right: Iir;
+      Interpretation : Name_Interpretation_Type;
+      Decl : Iir;
+      Overload_List : Iir_List;
+      Overload : Iir;
+      Res_Type_List : Iir;
+      Full_Compat : Iir;
+
+      -- LEFT and RIGHT must be set.
+      function Set_Uniq_Interpretation (Decl : Iir) return Iir
+      is
+         Interface_Chain : Iir;
+         Err : Boolean;
+      begin
+         Set_Type (Expr, Get_Return_Type (Decl));
+         Interface_Chain := Get_Interface_Declaration_Chain (Decl);
+         Err := False;
+         if Is_Overloaded (Left) then
+            Left := Sem_Expression_Ov
+              (Left, Get_Base_Type (Get_Type (Interface_Chain)));
+            if Left = Null_Iir then
+               Err := True;
+            else
+               if Arity = 1 then
+                  Set_Operand (Expr, Left);
+               else
+                  Set_Left (Expr, Left);
+               end if;
+            end if;
+         end if;
+         Check_Read (Left);
+         if Arity = 2 then
+            if Is_Overloaded (Right) then
+               Right := Sem_Expression_Ov
+                 (Right,
+                  Get_Base_Type (Get_Type (Get_Chain (Interface_Chain))));
+               if Right = Null_Iir then
+                  Err := True;
+               else
+                  Set_Right (Expr, Right);
+               end if;
+            end if;
+            Check_Read (Right);
+         end if;
+         Destroy_Iir_List (Overload_List);
+         if not Err then
+            Set_Implementation (Expr, Decl);
+            Sem_Subprogram_Call_Finish (Expr, Decl);
+            return Eval_Expr_If_Static (Expr);
+         else
+            return Expr;
+         end if;
+      end Set_Uniq_Interpretation;
+
+      --  Note: operator and implementation node of expr must be set.
+      procedure Error_Operator_Overload (List : Iir_List) is
+      begin
+         Error_Msg_Sem ("operator """ & Name_Table.Image (Operator)
+                        & """ is overloaded", Expr);
+         Disp_Overload_List (List, Expr);
+      end Error_Operator_Overload;
+
+      Interface_Chain : Iir;
+   begin
+      if Arity = 1 then
+         Left := Get_Operand (Expr);
+         Right := Null_Iir;
+      else
+         Left := Get_Left (Expr);
+         Right := Get_Right (Expr);
+      end if;
+      Operator := Iirs_Utils.Get_Operator_Name (Expr);
+
+      if Get_Type (Expr) = Null_Iir then
+         --  First pass.
+         --  Semantize operands.
+         --  FIXME: should try to semantize right operand even if semantization
+         --  of left operand has failed ??
+         if Get_Type (Left) = Null_Iir then
+            Left := Sem_Expression_Ov (Left, Null_Iir);
+            if Left = Null_Iir then
+               return Null_Iir;
+            end if;
+            if Arity = 1 then
+               Set_Operand (Expr, Left);
+            else
+               Set_Left (Expr, Left);
+            end if;
+         end if;
+         if Arity = 2 and then Get_Type (Right) = Null_Iir then
+            Right := Sem_Expression_Ov (Right, Null_Iir);
+            if Right = Null_Iir then
+               return Null_Iir;
+            end if;
+            Set_Right (Expr, Right);
+         end if;
+
+         Overload_List := Create_Iir_List;
+
+         --  Try to find an implementation among user defined function
+         Interpretation := Get_Interpretation (Operator);
+         while Valid_Interpretation (Interpretation) loop
+            Decl := Get_Non_Alias_Declaration (Interpretation);
+
+            --  It is compatible with operand types ?
+            if Get_Kind (Decl) not in Iir_Kinds_Function_Declaration then
+               raise Internal_Error;
+            end if;
+
+            --  LRM08 12.3 Visibility
+            --  [...] or all visible declarations denote the same named entity.
+            --
+            --  GHDL: If DECL has already been seen, then skip it.
+            if Get_Seen_Flag (Decl) then
+               goto Next;
+            end if;
+
+            --  Check return type.
+            if Res_Type /= Null_Iir
+              and then
+              not Are_Types_Compatible (Res_Type, Get_Return_Type (Decl))
+            then
+               goto Next;
+            end if;
+
+            Interface_Chain := Get_Interface_Declaration_Chain (Decl);
+
+            --  Check arity.
+
+            --  LRM93 2.5.2 Operator overloading
+            --  The subprogram specification of a unary operator must have
+            --  a single parameter [...]
+            --  The subprogram specification of a binary operator must have
+            --  two parameters [...]
+            --
+            --  GHDL: So even in presence of default expression in a parameter,
+            --  a unary operation has to match with a binary operator.
+            if Iir_Chains.Get_Chain_Length (Interface_Chain) /= Arity then
+               goto Next;
+            end if;
+
+            -- Check operands.
+            if not Is_Expr_Compatible (Get_Type (Interface_Chain), Left) then
+               goto Next;
+            end if;
+            if Arity = 2 then
+               if not Is_Expr_Compatible
+                 (Get_Type (Get_Chain (Interface_Chain)), Right)
+               then
+                  goto Next;
+               end if;
+            end if;
+
+            --  Match.
+            Set_Seen_Flag (Decl, True);
+            Append_Element (Overload_List, Decl);
+
+            << Next >> null;
+            Interpretation := Get_Next_Interpretation (Interpretation);
+         end loop;
+
+         --  Clear seen_flags.
+         for I in Natural loop
+            Decl := Get_Nth_Element (Overload_List, I);
+            exit when Decl = Null_Iir;
+            Set_Seen_Flag (Decl, False);
+         end loop;
+
+         --  The list of possible implementations was computed.
+         case Get_Nbr_Elements (Overload_List) is
+            when 0 =>
+               Error_Msg_Sem
+                 ("no function declarations for " & Disp_Node (Expr), Expr);
+               Destroy_Iir_List (Overload_List);
+               return Null_Iir;
+
+            when 1 =>
+               Decl := Get_First_Element (Overload_List);
+               return Set_Uniq_Interpretation (Decl);
+
+            when others =>
+               --  Preference for universal operator.
+               --  This roughly corresponds to:
+               --
+               --  LRM 7.3.5
+               --  An implicit conversion of a convertible universal operand
+               --  is applied if and only if the innermost complete context
+               --  determines a unique (numeric) target type for the implicit
+               --  conversion, and there is no legal interpretation of this
+               --  context without this conversion.
+               if Arity = 2 then
+                  Decl := Get_Non_Implicit_Subprogram (Overload_List);
+                  if Decl /= Null_Iir then
+                     return Set_Uniq_Interpretation (Decl);
+                  end if;
+               end if;
+
+               Set_Implementation (Expr, Create_Overload_List (Overload_List));
+
+               --  Create the list of possible return types, if it is not yet
+               --  determined.
+               if Res_Type = Null_Iir then
+                  Res_Type_List := Create_List_Of_Types (Overload_List);
+                  if Is_Overload_List (Res_Type_List) then
+                     --  There are many possible return types.
+                     --  Try again.
+                     Set_Type (Expr, Res_Type_List);
+                     return Expr;
+                  end if;
+               end if;
+
+               --  The return type is known.
+               --  Search for explicit subprogram.
+
+               --  It was impossible to find one solution.
+               Error_Operator_Overload (Overload_List);
+
+               --  Give an advice.
+               if not Flags.Flag_Explicit
+                 and then not Explicit_Advice_Given
+                 and then Flags.Vhdl_Std < Vhdl_08
+               then
+                  Decl := Get_Explicit_Subprogram (Overload_List);
+                  if Decl /= Null_Iir then
+                     Error_Msg_Sem
+                       ("(you may want to use the -fexplicit option)", Expr);
+                     Explicit_Advice_Given := True;
+                  end if;
+               end if;
+
+               return Null_Iir;
+         end case;
+      else
+         --  Second pass
+         --  Find the uniq implementation for this call.
+         Overload := Get_Implementation (Expr);
+         Overload_List := Get_Overload_List (Overload);
+         Full_Compat := Null_Iir;
+         for I in Natural loop
+            Decl := Get_Nth_Element (Overload_List, I);
+            exit when Decl = Null_Iir;
+            --  FIXME: wrong: compatibilty with return type and args.
+            if Are_Types_Compatible (Get_Return_Type (Decl), Res_Type) then
+               if Full_Compat /= Null_Iir then
+                  Error_Operator_Overload (Overload_List);
+                  return Null_Iir;
+               else
+                  Full_Compat := Decl;
+               end if;
+            end if;
+         end loop;
+         Free_Iir (Overload);
+         Overload := Get_Type (Expr);
+         Free_Overload_List (Overload);
+         return Set_Uniq_Interpretation (Full_Compat);
+      end if;
+   end Sem_Operator;
+
+   --  Semantize LIT whose elements must be of type EL_TYPE, and return
+   --  the length.
+   --  FIXME: the errors are reported, but there is no mark of that.
+   function Sem_String_Literal (Lit: Iir; El_Type : Iir) return Natural
+   is
+      function Find_Literal (Etype : Iir_Enumeration_Type_Definition;
+                             C : Character)
+        return Iir_Enumeration_Literal
+      is
+         Inter : Name_Interpretation_Type;
+         Id : Name_Id;
+         Decl : Iir;
+      begin
+         Id := Name_Table.Get_Identifier (C);
+         Inter := Get_Interpretation (Id);
+         while Valid_Interpretation (Inter) loop
+            Decl := Get_Declaration (Inter);
+            if Get_Kind (Decl) = Iir_Kind_Enumeration_Literal
+              and then Get_Type (Decl) = Etype
+            then
+               return Decl;
+            end if;
+            Inter := Get_Next_Interpretation (Inter);
+         end loop;
+         --  Character C is not visible...
+         if Find_Name_In_List (Get_Enumeration_Literal_List (Etype), Id)
+           = Null_Iir
+         then
+            --  ... because it is not defined.
+            Error_Msg_Sem
+              ("type " & Disp_Node (Etype) & " does not define character '"
+               & C & "'", Lit);
+         else
+            --  ... because it is not visible.
+            Error_Msg_Sem ("character '" & C & "' of type "
+                           & Disp_Node (Etype) & " is not visible", Lit);
+         end if;
+         return Null_Iir;
+      end Find_Literal;
+
+      Ptr : String_Fat_Acc;
+      El : Iir;
+      pragma Unreferenced (El);
+      Len : Nat32;
+   begin
+      Len := Get_String_Length (Lit);
+
+      if Get_Kind (Lit) = Iir_Kind_Bit_String_Literal then
+         Set_Bit_String_0 (Lit, Find_Literal (El_Type, '0'));
+         Set_Bit_String_1 (Lit, Find_Literal (El_Type, '1'));
+      else
+         Ptr := Get_String_Fat_Acc (Lit);
+
+         --  For a string_literal, check all characters of the string is a
+         --  literal of the type.
+         --  Always check, for visibility.
+         for I in 1 .. Len loop
+            El := Find_Literal (El_Type, Ptr (I));
+         end loop;
+      end if;
+
+      Set_Expr_Staticness (Lit, Locally);
+
+      return Natural (Len);
+   end Sem_String_Literal;
+
+   procedure Sem_String_Literal (Lit: Iir)
+   is
+      Lit_Type : constant Iir := Get_Type (Lit);
+      Lit_Base_Type : constant Iir := Get_Base_Type (Lit_Type);
+
+      -- The subtype created for the literal.
+      N_Type: Iir;
+      -- type of the index of the array type.
+      Index_Type: Iir;
+      Len : Natural;
+      El_Type : Iir;
+   begin
+      El_Type := Get_Base_Type (Get_Element_Subtype (Lit_Base_Type));
+      Len := Sem_String_Literal (Lit, El_Type);
+
+      if Get_Constraint_State (Lit_Type) = Fully_Constrained then
+         --  The type of the context is constrained.
+         Index_Type := Get_Index_Type (Lit_Type, 0);
+         if Get_Type_Staticness (Index_Type) = Locally then
+            if Eval_Discrete_Type_Length (Index_Type) /= Iir_Int64 (Len) then
+               Error_Msg_Sem ("string length does not match that of "
+                                & Disp_Node (Index_Type), Lit);
+            end if;
+         else
+            --  FIXME: emit a warning because of dubious construct (the type
+            --  of the string is not locally constrained) ?
+            null;
+         end if;
+      else
+         -- Context type is not constained.  Set type of the string literal,
+         -- according to LRM93 7.3.2.2.
+         N_Type := Create_Unidim_Array_By_Length
+           (Lit_Base_Type, Iir_Int64 (Len), Lit);
+         Set_Type (Lit, N_Type);
+         Set_Literal_Subtype (Lit, N_Type);
+      end if;
+   end Sem_String_Literal;
+
+   generic
+      --  Compare two elements, return true iff OP1 < OP2.
+      with function Lt (Op1, Op2 : Natural) return Boolean;
+
+      --  Swap two elements.
+      with procedure Swap (From : Natural; To : Natural);
+   package Heap_Sort is
+      --  Heap sort the N elements.
+      procedure Sort (N : Natural);
+   end Heap_Sort;
+
+   package body Heap_Sort is
+      --  An heap is an almost complete binary tree whose each edge is less
+      --  than or equal as its decendent.
+
+      --  Bubble down element I of a partially ordered heap of length N in
+      --  array ARR.
+      procedure Bubble_Down (I, N : Natural)
+      is
+         Child : Natural;
+         Parent : Natural := I;
+      begin
+         loop
+            Child := 2 * Parent;
+            if Child < N and then Lt (Child, Child + 1) then
+               Child := Child + 1;
+            end if;
+            exit when Child > N;
+            exit when not Lt (Parent, Child);
+            Swap (Parent, Child);
+            Parent := Child;
+         end loop;
+      end Bubble_Down;
+
+      --  Heap sort of ARR.
+      procedure Sort (N : Natural)
+      is
+      begin
+         --  Heapify
+         for I in reverse 1 .. N / 2 loop
+            Bubble_Down (I, N);
+         end loop;
+
+         --  Sort
+         for I in reverse 2 .. N loop
+            Swap (1, I);
+            Bubble_Down (1, I - 1);
+         end loop;
+      end Sort;
+   end Heap_Sort;
+
+   procedure Sem_String_Choices_Range (Choice_Chain : Iir; Sel : Iir)
+   is
+      --  True if others choice is present.
+      Has_Others : Boolean;
+
+      --  Number of simple choices.
+      Nbr_Choices : Natural;
+
+      --  Type of SEL.
+      Sel_Type : Iir;
+
+      --  Type of the element of SEL.
+      Sel_El_Type : Iir;
+      --  Number of literals in the element type.
+      Sel_El_Length : Iir_Int64;
+
+      --  Length of SEL (number of characters in SEL).
+      Sel_Length : Iir_Int64;
+
+      --  Array of choices.
+      Arr : Iir_Array_Acc;
+      Index : Natural;
+
+      --  True if length of a choice mismatches
+      Has_Length_Error : Boolean := False;
+
+      El : Iir;
+
+      --  Compare two elements of ARR.
+      --  Return true iff OP1 < OP2.
+      function Lt (Op1, Op2 : Natural) return Boolean is
+      begin
+         return Compare_String_Literals (Get_Choice_Expression (Arr (Op1)),
+                                         Get_Choice_Expression (Arr (Op2)))
+           = Compare_Lt;
+      end Lt;
+
+      function Eq (Op1, Op2 : Natural) return Boolean is
+      begin
+         return Compare_String_Literals (Get_Choice_Expression (Arr (Op1)),
+                                         Get_Choice_Expression (Arr (Op2)))
+           = Compare_Eq;
+      end Eq;
+
+      procedure Swap (From : Natural; To : Natural)
+      is
+         Tmp : Iir;
+      begin
+         Tmp := Arr (To);
+         Arr (To) := Arr (From);
+         Arr (From) := Tmp;
+      end Swap;
+
+      package Str_Heap_Sort is new Heap_Sort (Lt => Lt, Swap => Swap);
+
+      procedure Sem_Simple_Choice (Choice : Iir)
+      is
+         Expr : Iir;
+      begin
+         --  LRM93 8.8
+         --  In such case, each choice appearing in any of the case statement
+         --  alternative must be a locally static expression whose value is of
+         --  the same length as that of the case expression.
+         Expr := Sem_Expression (Get_Choice_Expression (Choice), Sel_Type);
+         if Expr = Null_Iir then
+            Has_Length_Error := True;
+            return;
+         end if;
+         Set_Choice_Expression (Choice, Expr);
+         if Get_Expr_Staticness (Expr) < Locally then
+            Error_Msg_Sem ("choice must be locally static expression", Expr);
+            Has_Length_Error := True;
+            return;
+         end if;
+         Expr := Eval_Expr (Expr);
+         Set_Choice_Expression (Choice, Expr);
+         if Get_Kind (Expr) = Iir_Kind_Overflow_Literal then
+            Error_Msg_Sem
+              ("bound error during evaluation of choice expression", Expr);
+            Has_Length_Error := True;
+         elsif Eval_Discrete_Type_Length
+           (Get_String_Type_Bound_Type (Get_Type (Expr))) /= Sel_Length
+         then
+            Has_Length_Error := True;
+            Error_Msg_Sem
+              ("value not of the same length of the case expression", Expr);
+            return;
+         end if;
+      end Sem_Simple_Choice;
+   begin
+      --  LRM93 8.8
+      --  If the expression is of one-dimensional character array type, then
+      --  the expression must be one of the following:
+      --  FIXME: to complete.
+      Sel_Type := Get_Type (Sel);
+      if not Is_One_Dimensional_Array_Type (Sel_Type) then
+         Error_Msg_Sem
+           ("expression must be discrete or one-dimension array subtype", Sel);
+         return;
+      end if;
+      if Get_Type_Staticness (Sel_Type) /= Locally then
+         Error_Msg_Sem ("array type must be locally static", Sel);
+         return;
+      end if;
+      Sel_Length := Eval_Discrete_Type_Length
+        (Get_String_Type_Bound_Type (Sel_Type));
+      Sel_El_Type := Get_Element_Subtype (Sel_Type);
+      Sel_El_Length := Eval_Discrete_Type_Length (Sel_El_Type);
+
+      Has_Others := False;
+      Nbr_Choices := 0;
+      El := Choice_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Choice_By_None =>
+               raise Internal_Error;
+            when Iir_Kind_Choice_By_Range =>
+               Error_Msg_Sem
+                 ("range choice are not allowed for non-discrete type", El);
+            when Iir_Kind_Choice_By_Expression =>
+               Nbr_Choices := Nbr_Choices + 1;
+               Sem_Simple_Choice (El);
+            when Iir_Kind_Choice_By_Others =>
+               if Has_Others then
+                  Error_Msg_Sem ("duplicate others choice", El);
+               elsif Get_Chain (El) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("choice others must be the last alternative", El);
+               end if;
+               Has_Others := True;
+            when others =>
+               Error_Kind ("sem_string_choices_range", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      --  Null choices.
+      if Sel_Length = 0 then
+         return;
+      end if;
+      if Has_Length_Error then
+         return;
+      end if;
+
+      --  LRM 8.8
+      --
+      --  If the expression is the name of an object whose subtype is locally
+      --  static, wether a scalar type or an array type, then each value of the
+      --  subtype must be represented once and only once in the set of choices
+      --  of the case statement and no other value is allowed; [...]
+
+      -- 1. Allocate Arr and fill it
+      Arr := new Iir_Array (1 .. Nbr_Choices);
+      Index := 0;
+      El := Choice_Chain;
+      while El /= Null_Iir loop
+         if Get_Kind (El) = Iir_Kind_Choice_By_Expression then
+            Index := Index + 1;
+            Arr (Index) := El;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      -- 2. Sort Arr
+      Str_Heap_Sort.Sort (Nbr_Choices);
+
+      -- 3. Check for duplicate choices
+      for I in 1 .. Nbr_Choices - 1 loop
+         if Eq (I, I + 1) then
+            Error_Msg_Sem ("duplicate choice with choice at " &
+                             Disp_Location (Arr (I + 1)),
+                           Arr (I));
+            exit;
+         end if;
+      end loop;
+
+      -- 4. Free Arr
+      Free (Arr);
+
+      --  Check for missing choice.
+      --  Do not try to compute the expected number of choices as this can
+      --  easily overflow.
+      if not Has_Others then
+         declare
+            Nbr : Iir_Int64 := Iir_Int64 (Nbr_Choices);
+         begin
+            for I in 1 .. Sel_Length loop
+               Nbr := Nbr / Sel_El_Length;
+               if Nbr = 0 then
+                  Error_Msg_Sem ("missing choice(s)", Choice_Chain);
+                  exit;
+               end if;
+            end loop;
+         end;
+      end if;
+   end Sem_String_Choices_Range;
+
+   procedure Sem_Choices_Range
+     (Choice_Chain : in out Iir;
+      Sub_Type : Iir;
+      Is_Sub_Range : Boolean;
+      Is_Case_Stmt : Boolean;
+      Loc : Location_Type;
+      Low : out Iir;
+      High : out Iir)
+   is
+      --  Number of positionnal choice.
+      Nbr_Pos : Iir_Int64;
+
+      --  Number of named choices.
+      Nbr_Named : Natural;
+
+      --  True if others choice is present.
+      Has_Others : Boolean;
+
+      Has_Error : Boolean;
+
+      --  True if SUB_TYPE has bounds.
+      Type_Has_Bounds : Boolean;
+
+      Arr : Iir_Array_Acc;
+      Index : Natural;
+      Pos_Max : Iir_Int64;
+      El : Iir;
+      Prev_El : Iir;
+
+      --  Staticness of the current choice.
+      Choice_Staticness : Iir_Staticness;
+
+      --  Staticness of all the choices.
+      Staticness : Iir_Staticness;
+
+      function Replace_By_Range_Choice (Name : Iir; Range_Type : Iir)
+                                       return Boolean
+      is
+         N_Choice : Iir;
+         Name1 : Iir;
+      begin
+         if not Are_Types_Compatible (Range_Type, Sub_Type) then
+            Not_Match (Name, Sub_Type);
+            return False;
+         end if;
+
+         Name1 := Finish_Sem_Name (Name);
+         N_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+         Location_Copy (N_Choice, El);
+         Set_Chain (N_Choice, Get_Chain (El));
+         Set_Associated_Expr (N_Choice, Get_Associated_Expr (El));
+         Set_Associated_Chain (N_Choice, Get_Associated_Chain (El));
+         Set_Same_Alternative_Flag (N_Choice, Get_Same_Alternative_Flag (El));
+         Set_Choice_Range (N_Choice, Eval_Range_If_Static (Name1));
+         Set_Choice_Staticness (N_Choice, Get_Type_Staticness (Range_Type));
+         Free_Iir (El);
+
+         if Prev_El = Null_Iir then
+            Choice_Chain := N_Choice;
+         else
+            Set_Chain (Prev_El, N_Choice);
+         end if;
+         El := N_Choice;
+
+         return True;
+      end Replace_By_Range_Choice;
+
+      --  Semantize a simple (by expression or by range) choice.
+      --  Return FALSE in case of error.
+      function Sem_Simple_Choice return Boolean
+      is
+         Expr : Iir;
+         Ent : Iir;
+      begin
+         if Get_Kind (El) = Iir_Kind_Choice_By_Range then
+            Expr := Get_Choice_Range (El);
+            Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type, True);
+            if Expr = Null_Iir then
+               return False;
+            end if;
+            Expr := Eval_Range_If_Static (Expr);
+            Set_Choice_Range (El, Expr);
+         else
+            Expr := Get_Choice_Expression (El);
+            case Get_Kind (Expr) is
+               when Iir_Kind_Selected_Name
+                 | Iir_Kind_Simple_Name
+                 | Iir_Kind_Character_Literal
+                 | Iir_Kind_Parenthesis_Name
+                 | Iir_Kind_Selected_By_All_Name
+                 | Iir_Kind_Attribute_Name =>
+                  Sem_Name (Expr);
+                  Ent := Get_Named_Entity (Expr);
+                  if Ent = Error_Mark then
+                     return False;
+                  end if;
+
+                  --  So range or expression ?
+                  --  FIXME: share code with sem_name for slice/index.
+                  case Get_Kind (Ent) is
+                     when Iir_Kind_Range_Array_Attribute
+                       | Iir_Kind_Reverse_Range_Array_Attribute
+                       | Iir_Kind_Range_Expression =>
+                        return Replace_By_Range_Choice (Expr, Ent);
+                     when Iir_Kind_Subtype_Declaration
+                       | Iir_Kind_Type_Declaration =>
+                        Ent := Is_Type_Name (Expr);
+                        Set_Expr_Staticness (Expr, Get_Type_Staticness (Ent));
+                        return Replace_By_Range_Choice (Expr, Ent);
+                     when others =>
+                        Expr := Name_To_Expression
+                          (Expr, Get_Base_Type (Sub_Type));
+                  end case;
+               when others =>
+                  Expr := Sem_Expression_Ov (Expr, Get_Base_Type (Sub_Type));
+            end case;
+            if Expr = Null_Iir then
+               return False;
+            end if;
+            Expr := Eval_Expr_If_Static (Expr);
+            Set_Choice_Expression (El, Expr);
+         end if;
+         Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
+         return True;
+      end Sem_Simple_Choice;
+
+      --  Get low limit of ASSOC.
+      --  First, get the expression of the association, then the low limit.
+      --  ASSOC may be either association_by_range (in this case the low limit
+      --   is to be fetched), or association_by_expression (and the low limit
+      --   is the expression).
+      function Get_Low (Assoc : Iir) return Iir
+      is
+         Expr : Iir;
+      begin
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_Expression =>
+               return Get_Choice_Expression (Assoc);
+            when Iir_Kind_Choice_By_Range =>
+               Expr := Get_Choice_Range (Assoc);
+               case Get_Kind (Expr) is
+                  when Iir_Kind_Range_Expression =>
+                     case Get_Direction (Expr) is
+                        when Iir_To =>
+                           return Get_Left_Limit (Expr);
+                        when Iir_Downto =>
+                           return Get_Right_Limit (Expr);
+                     end case;
+                  when others =>
+                     return Expr;
+               end case;
+            when others =>
+               Error_Kind ("get_low", Assoc);
+         end case;
+      end Get_Low;
+
+      function Get_High (Assoc : Iir) return Iir
+      is
+         Expr : Iir;
+      begin
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_Expression =>
+               return Get_Choice_Expression (Assoc);
+            when Iir_Kind_Choice_By_Range =>
+               Expr := Get_Choice_Range (Assoc);
+               case Get_Kind (Expr) is
+                  when Iir_Kind_Range_Expression =>
+                     case Get_Direction (Expr) is
+                        when Iir_To =>
+                           return Get_Right_Limit (Expr);
+                        when Iir_Downto =>
+                           return Get_Left_Limit (Expr);
+                     end case;
+                  when others =>
+                     return Expr;
+               end case;
+            when others =>
+               Error_Kind ("get_high", Assoc);
+         end case;
+      end Get_High;
+
+      --  Compare two elements of ARR.
+      --  Return true iff OP1 < OP2.
+      function Lt (Op1, Op2 : Natural) return Boolean is
+      begin
+         return
+           Eval_Pos (Get_Low (Arr (Op1))) < Eval_Pos (Get_Low (Arr (Op2)));
+      end Lt;
+
+      --  Swap two elements of ARR.
+      procedure Swap (From : Natural; To : Natural)
+      is
+         Tmp : Iir;
+      begin
+         Tmp := Arr (To);
+         Arr (To) := Arr (From);
+         Arr (From) := Tmp;
+      end Swap;
+
+      package Disc_Heap_Sort is new Heap_Sort (Lt => Lt, Swap => Swap);
+   begin
+      Low := Null_Iir;
+      High := Null_Iir;
+
+      --  First:
+      --  semantize the choices
+      --  compute the range of positionnal choices
+      --  compute the number of choice elements (extracted from lists).
+      --  check for others presence.
+      Nbr_Pos := 0;
+      Nbr_Named := 0;
+      Has_Others := False;
+      Has_Error := False;
+      Staticness := Locally;
+      El := Choice_Chain;
+      Prev_El := Null_Iir;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Choice_By_None =>
+               Nbr_Pos := Nbr_Pos + 1;
+            when Iir_Kind_Choice_By_Expression
+              | Iir_Kind_Choice_By_Range =>
+               if Sem_Simple_Choice then
+                  Choice_Staticness := Get_Choice_Staticness (El);
+                  Staticness := Min (Staticness, Choice_Staticness);
+                  if Choice_Staticness /= Locally
+                    and then Is_Case_Stmt
+                  then
+                     --  FIXME: explain why
+                     Error_Msg_Sem ("choice is not locally static", El);
+                  end if;
+               else
+                  Has_Error := True;
+               end if;
+               Nbr_Named := Nbr_Named + 1;
+            when Iir_Kind_Choice_By_Name =>
+               --  It is not possible to have such a choice in an array
+               --  aggregate.
+               --  Should have been caught previously.
+               raise Internal_Error;
+            when Iir_Kind_Choice_By_Others =>
+               if Has_Others then
+                  Error_Msg_Sem ("duplicate others choice", El);
+               elsif Get_Chain (El) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("choice others should be the last alternative", El);
+               end if;
+               Has_Others := True;
+            when others =>
+               Error_Kind ("sem_choices_range", El);
+         end case;
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+
+      if Has_Error then
+         --  Nothing can be done here...
+         return;
+      end if;
+      if Nbr_Pos > 0 and then Nbr_Named > 0 then
+         --  LRM93 7.3.2.2
+         --  Apart from the final element with the single choice OTHERS, the
+         --  rest (if any) of the element associations of an array aggregate
+         --  must be either all positionnal or all named.
+         Error_Msg_Sem
+           ("element associations must be all positional or all named", Loc);
+         return;
+      end if;
+
+      --  For a positional aggregate.
+      if Nbr_Pos > 0 then
+         --  Check number of elements match, but only if it is possible.
+         if Get_Type_Staticness (Sub_Type) /= Locally then
+            return;
+         end if;
+         Pos_Max := Eval_Discrete_Type_Length (Sub_Type);
+         if (not Has_Others and not Is_Sub_Range)
+           and then Nbr_Pos < Pos_Max
+         then
+            Error_Msg_Sem ("not enough elements associated", Loc);
+         elsif Nbr_Pos > Pos_Max then
+            Error_Msg_Sem ("too many elements associated", Loc);
+         end if;
+         return;
+      end if;
+
+      --  Second:
+      --  Create the list of choices
+      if Nbr_Named = 0 and then Has_Others then
+         --  This is only a others association.
+         return;
+      end if;
+      if Staticness /= Locally then
+         --  Emit a message for aggregrate.  The message has already been
+         --  emitted for a case stmt.
+         --  FIXME: what about individual associations?
+         if not Is_Case_Stmt then
+            --  LRM93 §7.3.2.2
+            --  A named association of an array aggregate is allowed to have
+            --  a choice that is not locally static, or likewise a choice that
+            --  is a null range, only if the aggregate includes a single
+            --  element association and the element association has a single
+            --  choice.
+            if Nbr_Named > 1 or Has_Others then
+               Error_Msg_Sem ("not static choice exclude others choice", Loc);
+            end if;
+         end if;
+         return;
+      end if;
+
+      --  Set TYPE_HAS_BOUNDS
+      case Get_Kind (Sub_Type) is
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            Type_Has_Bounds := True;
+         when Iir_Kind_Integer_Type_Definition =>
+            Type_Has_Bounds := False;
+         when others =>
+            Error_Kind ("sem_choice_range(3)", Sub_Type);
+      end case;
+
+      Arr := new Iir_Array (1 .. Nbr_Named);
+      Index := 0;
+
+      declare
+         procedure Add_Choice (Choice : Iir; A_Type : Iir)
+         is
+            Ok : Boolean;
+            Expr : Iir;
+         begin
+            Ok := True;
+            if Type_Has_Bounds
+              and then Get_Type_Staticness (A_Type) = Locally
+            then
+               if Get_Kind (Choice) = Iir_Kind_Choice_By_Range then
+                  Expr := Get_Choice_Range (Choice);
+                  if Get_Expr_Staticness (Expr) = Locally then
+                     Ok := Eval_Is_Range_In_Bound (Expr, A_Type, True);
+                  end if;
+               else
+                  Expr := Get_Choice_Expression (Choice);
+                  if Get_Expr_Staticness (Expr) = Locally then
+                     Ok := Eval_Is_In_Bound (Expr, A_Type);
+                  end if;
+               end if;
+               if not Ok then
+                  Error_Msg_Sem
+                    (Disp_Node (Expr) & " out of index range", Choice);
+               end if;
+            end if;
+            if Ok then
+               Index := Index + 1;
+               Arr (Index) := Choice;
+            end if;
+         end Add_Choice;
+      begin
+         --  Fill the array.
+         El := Choice_Chain;
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Choice_By_None =>
+                  --  Only named associations are considered.
+                  raise Internal_Error;
+               when Iir_Kind_Choice_By_Expression
+                 | Iir_Kind_Choice_By_Range =>
+                  Add_Choice (El, Sub_Type);
+               when Iir_Kind_Choice_By_Others =>
+                  null;
+               when others =>
+                  Error_Kind ("sem_choices_range(2)", El);
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end;
+
+      --  Third:
+      --  Sort the list
+      Disc_Heap_Sort.Sort (Index);
+
+      --  Set low and high bounds.
+      if Index > 0 then
+         Low := Get_Low (Arr (1));
+         High := Get_High (Arr (Index));
+      else
+         Low := Null_Iir;
+         High := Null_Iir;
+      end if;
+
+      --  Fourth:
+      --  check for lacking choice (if no others)
+      --  check for overlapping choices
+      declare
+         --  Emit an error message for absence of choices in position L to H
+         --  of index type BT at location LOC.
+         procedure Error_No_Choice (Bt : Iir;
+                                    L, H : Iir_Int64;
+                                    Loc : Location_Type)
+         is
+         begin
+            if L = H then
+               Error_Msg_Sem ("no choice for " & Disp_Discrete (Bt, L), Loc);
+            else
+               Error_Msg_Sem
+                 ("no choices for " & Disp_Discrete (Bt, L)
+                     & " to " & Disp_Discrete (Bt, H), Loc);
+            end if;
+         end Error_No_Choice;
+
+         --  Lowest and highest bounds.
+         Lb, Hb : Iir;
+         Pos : Iir_Int64;
+         Pos_Max : Iir_Int64;
+         E_Pos : Iir_Int64;
+
+         Bt : Iir;
+      begin
+         Bt := Get_Base_Type (Sub_Type);
+         if not Is_Sub_Range
+           and then Get_Type_Staticness (Sub_Type) = Locally
+           and then Type_Has_Bounds
+         then
+            Get_Low_High_Limit (Get_Range_Constraint (Sub_Type), Lb, Hb);
+         else
+            Lb := Low;
+            Hb := High;
+         end if;
+         --  Checks all values between POS and POS_MAX are handled.
+         Pos := Eval_Pos (Lb);
+         Pos_Max := Eval_Pos (Hb);
+         if Pos > Pos_Max then
+            --  Null range.
+            Free (Arr);
+            return;
+         end if;
+         for I in 1 .. Index loop
+            E_Pos := Eval_Pos (Get_Low (Arr (I)));
+            if E_Pos > Pos_Max then
+               --  Choice out of bound, already handled.
+               Error_No_Choice (Bt, Pos, Pos_Max, Get_Location (Arr (I)));
+               --  Avoid other errors.
+               Pos := Pos_Max + 1;
+               exit;
+            end if;
+            if Pos < E_Pos and then not Has_Others then
+               Error_No_Choice (Bt, Pos, E_Pos - 1, Get_Location (Arr (I)));
+            elsif Pos > E_Pos then
+               if Pos + 1 = E_Pos then
+                  Error_Msg_Sem
+                    ("duplicate choice for " & Disp_Discrete (Bt, Pos),
+                     Arr (I));
+               else
+                  Error_Msg_Sem
+                    ("duplicate choices for " & Disp_Discrete (Bt, E_Pos)
+                     & " to " & Disp_Discrete (Bt, Pos), Arr (I));
+               end if;
+            end if;
+            Pos := Eval_Pos (Get_High (Arr (I))) + 1;
+         end loop;
+         if Pos /= Pos_Max + 1 and then not Has_Others then
+            Error_No_Choice (Bt, Pos, Pos_Max, Loc);
+         end if;
+      end;
+
+      Free (Arr);
+   end Sem_Choices_Range;
+
+--    -- Find out the MIN and the MAX of an all named association choice list.
+--    -- It also returns the number of elements associed (counting range).
+--    procedure Sem_Find_Min_Max_Association_Choice_List
+--      (List: Iir_Association_Choices_List;
+--       Min: out Iir;
+--       Max: out Iir;
+--       Length: out natural)
+--    is
+--       Min_Res: Iir := null;
+--       Max_Res: Iir := null;
+--       procedure Update_With_Value (Val: Iir) is
+--       begin
+--          if Min_Res = null then
+--             Min_Res := Val;
+--             Max_Res := Val;
+--          elsif Get_Value (Val) < Get_Value (Min_Res) then
+--             Min_Res := Val;
+--          elsif Get_Value (Val) > Get_Value (Max_Res) then
+--             Max_Res := Val;
+--          end if;
+--       end Update_With_Value;
+
+--       Number_Elements: Natural;
+
+--       procedure Update (Choice: Iir) is
+--          Left, Right: Iir;
+--          Expr: Iir;
+--       begin
+--          case Get_Kind (Choice) is
+--             when Iir_Kind_Choice_By_Expression =>
+--                Update_With_Value (Get_Expression (Choice));
+--                Number_Elements := Number_Elements + 1;
+--             when Iir_Kind_Choice_By_Range =>
+--                Expr := Get_Expression (Choice);
+--                Left := Get_Left_Limit (Expr);
+--                Right := Get_Right_Limit (Expr);
+--                Update_With_Value (Left);
+--                Update_With_Value (Right);
+--                -- There can't be null range.
+--                case Get_Direction (Expr) is
+--                   when Iir_To =>
+--                      Number_Elements := Number_Elements +
+--                        Natural (Get_Value (Right) - Get_Value (Left) + 1);
+--                   when Iir_Downto =>
+--                      Number_Elements := Number_Elements +
+--                        Natural (Get_Value (Left) - Get_Value (Right) + 1);
+--                end case;
+--             when others =>
+--             Error_Kind ("sem_find_min_max_association_choice_list", Choice);
+--          end case;
+--       end Update;
+
+--       El: Iir;
+--       Sub_List: Iir_Association_Choices_List;
+--       Sub_El: Iir;
+--    begin
+--       Number_Elements := 0;
+--       for I in Natural loop
+--          El := Get_Nth_Element (List, I);
+--          exit when El = null;
+--          case Get_Kind (El) is
+--             when Iir_Kind_Choice_By_List =>
+--                Sub_List := Get_Choice_List (El);
+--                for J in Natural loop
+--                   Sub_El := Get_Nth_Element (Sub_List, J);
+--                   exit when Sub_El = null;
+--                   Update (Sub_El);
+--                end loop;
+--             when others =>
+--                Update (El);
+--          end case;
+--       end loop;
+--       Min := Min_Res;
+--       Max := Max_Res;
+--       Length := Number_Elements;
+--    end Sem_Find_Min_Max_Association_Choice_List;
+
+   -- Perform semantisation on a (sub)aggregate AGGR, which is of type
+   -- A_TYPE.
+   -- return FALSE is case of failure
+   function Sem_Record_Aggregate (Aggr: Iir_Aggregate; A_Type: Iir)
+     return boolean
+   is
+      Base_Type : constant Iir := Get_Base_Type (A_Type);
+      El_List : constant Iir_List := Get_Elements_Declaration_List (Base_Type);
+
+      --  Type of the element.
+      El_Type : Iir;
+
+      Matches: Iir_Array (0 .. Get_Nbr_Elements (El_List) - 1);
+      Ok : Boolean;
+
+      --  Add a choice for element REC_EL.
+      --  Checks the element is not already associated.
+      --  Checks type of expression is compatible with type of element.
+      procedure Add_Match (El : Iir; Rec_El : Iir_Element_Declaration)
+      is
+         Ass_Type : Iir;
+         Pos : constant Natural := Natural (Get_Element_Position (Rec_El));
+      begin
+         if Matches (Pos) /= Null_Iir then
+            Error_Msg_Sem
+              (Disp_Node (Matches (Pos)) & " was already associated", El);
+            Ok := False;
+            return;
+         end if;
+         Matches (Pos) := El;
+
+         --  LRM 7.3.2.1  Record aggregates
+         --  An element association with more than once choice, [...], is
+         --  only allowed if the elements specified are all of the same type.
+         Ass_Type := Get_Type (Rec_El);
+         if El_Type = Null_Iir then
+            El_Type := Ass_Type;
+         elsif not Are_Types_Compatible (El_Type, Ass_Type) then
+            Error_Msg_Sem ("elements are not of the same type", El);
+            Ok := False;
+         end if;
+      end Add_Match;
+
+      --  Semantize a simple choice: extract the record element corresponding
+      --  to the expression, and create a choice_by_name.
+      --  FIXME: should mutate the node.
+      function Sem_Simple_Choice (Ass : Iir) return Iir
+      is
+         N_El : Iir;
+         Expr : Iir;
+         Aggr_El : Iir_Element_Declaration;
+      begin
+         Expr := Get_Choice_Expression (Ass);
+         if Get_Kind (Expr) /= Iir_Kind_Simple_Name then
+            Error_Msg_Sem ("element association must be a simple name", Ass);
+            Ok := False;
+            return Ass;
+         end if;
+         Aggr_El := Find_Name_In_List
+           (Get_Elements_Declaration_List (Base_Type), Get_Identifier (Expr));
+         if Aggr_El = Null_Iir then
+            Error_Msg_Sem
+              ("record has no such element " & Disp_Node (Ass), Ass);
+            Ok := False;
+            return Ass;
+         end if;
+
+         N_El := Create_Iir (Iir_Kind_Choice_By_Name);
+         Location_Copy (N_El, Ass);
+         Set_Choice_Name (N_El, Aggr_El);
+         Set_Associated_Expr (N_El, Get_Associated_Expr (Ass));
+         Set_Associated_Chain (N_El, Get_Associated_Chain (Ass));
+         Set_Chain (N_El, Get_Chain (Ass));
+         Set_Same_Alternative_Flag (N_El, Get_Same_Alternative_Flag (Ass));
+
+         Xref_Ref (Expr, Aggr_El);
+         Free_Iir (Ass);
+         Free_Iir (Expr);
+         Add_Match (N_El, Aggr_El);
+         return N_El;
+      end Sem_Simple_Choice;
+
+      Assoc_Chain : Iir;
+      El, Prev_El : Iir;
+      Expr: Iir;
+      Has_Named : Boolean;
+      Rec_El_Index : Natural;
+      Value_Staticness : Iir_Staticness;
+   begin
+      Ok := True;
+      Assoc_Chain := Get_Association_Choices_Chain (Aggr);
+      Matches := (others => Null_Iir);
+      Value_Staticness := Locally;
+
+      El_Type := Null_Iir;
+      Has_Named := False;
+      Rec_El_Index := 0;
+      Prev_El := Null_Iir;
+      El := Assoc_Chain;
+      while El /= Null_Iir loop
+         Expr := Get_Associated_Expr (El);
+
+         --  If there is an associated expression with the choice, then the
+         --  choice is a new alternative, and has no expected type.
+         if Expr /= Null_Iir then
+            El_Type := Null_Iir;
+         end if;
+
+         case Get_Kind (El) is
+            when Iir_Kind_Choice_By_None =>
+               if Has_Named then
+                  Error_Msg_Sem ("positional association after named one", El);
+                  Ok := False;
+               elsif Rec_El_Index > Matches'Last then
+                  Error_Msg_Sem ("too many elements", El);
+                  exit;
+               else
+                  Add_Match (El, Get_Nth_Element (El_List, Rec_El_Index));
+                  Rec_El_Index := Rec_El_Index + 1;
+               end if;
+            when Iir_Kind_Choice_By_Expression =>
+               Has_Named := True;
+               El := Sem_Simple_Choice (El);
+               --  This creates a choice_by_name, which replaces the
+               --  choice_by_expression.
+               if Prev_El = Null_Iir then
+                  Set_Association_Choices_Chain (Aggr, El);
+               else
+                  Set_Chain (Prev_El, El);
+               end if;
+            when Iir_Kind_Choice_By_Others =>
+               Has_Named := True;
+               if Get_Chain (El) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("choice others must be the last alternative", El);
+               end if;
+               declare
+                  Found : Boolean := False;
+               begin
+                  for I in Matches'Range loop
+                     if Matches (I) = Null_Iir then
+                        Add_Match (El, Get_Nth_Element (El_List, I));
+                        Found := True;
+                     end if;
+                  end loop;
+                  if not Found then
+                     Error_Msg_Sem ("no element for choice others", El);
+                     Ok := False;
+                  end if;
+               end;
+            when others =>
+               Error_Kind ("sem_record_aggregate", El);
+         end case;
+
+         --  Semantize the expression associated.
+         if Expr /= Null_Iir then
+            if El_Type /= Null_Iir then
+               Expr := Sem_Expression (Expr, El_Type);
+               if Expr /= Null_Iir then
+                  Set_Associated_Expr (El, Eval_Expr_If_Static (Expr));
+                  Value_Staticness := Min (Value_Staticness,
+                                           Get_Expr_Staticness (Expr));
+               else
+                  Ok := False;
+               end if;
+            else
+               --  This case is not possible unless there is an error.
+               if Ok then
+                  raise Internal_Error;
+               end if;
+            end if;
+         end if;
+
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+
+      --  Check for missing associations.
+      for I in Matches'Range loop
+         if Matches (I) = Null_Iir then
+            Error_Msg_Sem
+              ("no value for " & Disp_Node (Get_Nth_Element (El_List, I)),
+               Aggr);
+            Ok := False;
+         end if;
+      end loop;
+      Set_Value_Staticness (Aggr, Value_Staticness);
+      Set_Expr_Staticness (Aggr, Min (Globally, Value_Staticness));
+      return Ok;
+   end Sem_Record_Aggregate;
+
+   --  Information for each dimension of an aggregate.
+   type Array_Aggr_Info is record
+      --  False if one sub-aggregate has no others choices.
+      --  If FALSE, the dimension is constrained.
+      Has_Others : Boolean := True;
+
+      --  True if one sub-aggregate is by named/by position.
+      Has_Named : Boolean := False;
+      Has_Positional : Boolean := False;
+
+      --  True if one sub-aggregate is dynamic.
+      Has_Dynamic : Boolean := False;
+
+      --  LOW and HIGH limits for the dimension.
+      Low : Iir := Null_Iir;
+      High : Iir := Null_Iir;
+
+      --  Minimum length of the dimension.  This is a minimax.
+      Min_Length : Natural := 0;
+
+      --  If not NULL_IIR, this is the bounds of the dimension.
+      --  If every dimension has bounds, then the aggregate is constrained.
+      Index_Subtype : Iir := Null_Iir;
+
+      --  True if there is an error.
+      Error : Boolean := False;
+   end record;
+
+   type Array_Aggr_Info_Arr is array (Natural range <>) of Array_Aggr_Info;
+
+   --  Semantize an array aggregate AGGR of *base type* A_TYPE.
+   --  The type of the array is computed into A_SUBTYPE.
+   --  DIM is the dimension index in A_TYPE.
+   --  Return FALSE in case of error.
+   procedure Sem_Array_Aggregate_Type_1 (Aggr: Iir;
+                                         A_Type: Iir;
+                                         Infos : in out Array_Aggr_Info_Arr;
+                                         Constrained : Boolean;
+                                         Dim: Natural)
+   is
+      Assoc_Chain : Iir;
+      Choice: Iir;
+      Is_Positional: Tri_State_Type;
+      Has_Positional_Choice: Boolean;
+      Low, High : Iir;
+      Index_List : Iir_List;
+      Has_Others : Boolean;
+
+      Len : Natural;
+
+      --  Type of the index (this is also the type of the choices).
+      Index_Type : Iir;
+
+      --Index_Subtype : Iir;
+      Index_Subtype_Constraint : Iir_Range_Expression;
+      Index_Constraint : Iir_Range_Expression; -- FIXME: 'range.
+      Choice_Staticness : Iir_Staticness;
+
+      Info : Array_Aggr_Info renames Infos (Dim);
+   begin
+      Index_List := Get_Index_Subtype_List (A_Type);
+      Index_Type := Get_Index_Type (Index_List, Dim - 1);
+
+      --  Sem choices.
+      case Get_Kind (Aggr) is
+         when Iir_Kind_Aggregate =>
+            Assoc_Chain := Get_Association_Choices_Chain (Aggr);
+            Sem_Choices_Range (Assoc_Chain, Index_Type, not Constrained, False,
+                               Get_Location (Aggr), Low, High);
+            Set_Association_Choices_Chain (Aggr, Assoc_Chain);
+
+            --  Update infos.
+            if Low /= Null_Iir
+              and then (Info.Low = Null_Iir
+                        or else Eval_Pos (Low) < Eval_Pos (Info.Low))
+            then
+               Info.Low := Low;
+            end if;
+            if High /= Null_Iir
+              and then (Info.High = Null_Iir
+                        or else Eval_Pos (High) > Eval_Pos (Info.High))
+            then
+               Info.High := High;
+            end if;
+
+            --  Determine if the aggregate is positionnal or named;
+            --    and compute choice staticness.
+            Is_Positional := Unknown;
+            Choice_Staticness := Locally;
+            Has_Positional_Choice := False;
+            Has_Others := False;
+            Len := 0;
+            Choice := Assoc_Chain;
+            while Choice /= Null_Iir loop
+               case Get_Kind (Choice) is
+                  when Iir_Kind_Choice_By_Range
+                    | Iir_Kind_Choice_By_Expression =>
+                     Is_Positional := False;
+                     Choice_Staticness :=
+                       Iirs.Min (Choice_Staticness,
+                                 Get_Choice_Staticness (Choice));
+                     --  FIXME: not true for range.
+                     Len := Len + 1;
+                  when Iir_Kind_Choice_By_None =>
+                     Has_Positional_Choice := True;
+                     Len := Len + 1;
+                  when Iir_Kind_Choice_By_Others =>
+                     if not Constrained then
+                        Error_Msg_Sem ("'others' choice not allowed for an "
+                                       & "aggregate in this context", Aggr);
+                        Infos (Dim).Error := True;
+                        return;
+                     end if;
+                     Has_Others := True;
+                  when others =>
+                     Error_Kind ("sem_array_aggregate_type", Choice);
+               end case;
+               --  LRM93 7.3.2.2
+               --  Apart from the final element with the single choice
+               --  OTHERS, the rest (if any) of the element
+               --  associations of an array aggregate must be either
+               --  all positionnal or all named.
+               if Has_Positional_Choice then
+                  if Is_Positional = False then
+                     --  The error has already been emited
+                     --  by sem_choices_range.
+                     Infos (Dim).Error := True;
+                     return;
+                  end if;
+                  Is_Positional := True;
+               end if;
+               Choice := Get_Chain (Choice);
+            end loop;
+
+            Info.Min_Length := Integer'Max (Info.Min_Length, Len);
+
+            if Choice_Staticness = Unknown then
+               --  This is possible when a choice is erroneous.
+               Infos (Dim).Error := True;
+               return;
+            end if;
+
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            Len := Sem_String_Literal
+              (Aggr, Get_Base_Type (Get_Element_Subtype (A_Type)));
+            Assoc_Chain := Null_Iir;
+            Info.Min_Length := Integer'Max (Info.Min_Length, Len);
+            Is_Positional := True;
+            Has_Others := False;
+            Choice_Staticness := Locally;
+
+         when others =>
+            Error_Kind ("sem_array_aggregate_type_1", Aggr);
+      end case;
+
+      if Is_Positional = True then
+         Info.Has_Positional := True;
+      end if;
+      if Is_Positional = False then
+         Info.Has_Named := True;
+      end if;
+      if not Has_Others then
+         Info.Has_Others := False;
+      end if;
+
+      --  LRM93 7.3.2.2
+      --  A named association of an array aggregate is allowed to have a choice
+      --  that is not locally static, [or likewise a choice that is a null
+      --  range], only if the aggregate includes a single element association
+      --  and this element association has a single choice.
+      if Is_Positional = False and then Choice_Staticness /= Locally then
+         Choice := Assoc_Chain;
+         if not Is_Chain_Length_One (Assoc_Chain) or else
+           (Get_Kind (Choice) /= Iir_Kind_Choice_By_Expression
+            and then Get_Kind (Choice) /= Iir_Kind_Choice_By_Range)
+         then
+            Error_Msg_Sem ("non-locally static choice for an aggregate is "
+                           & "allowed only if only choice", Aggr);
+            Infos (Dim).Error := True;
+            return;
+         end if;
+         Info.Has_Dynamic := True;
+      end if;
+
+      --  Compute bounds of the index if there is no index subtype.
+      if Info.Index_Subtype = Null_Iir and then Has_Others = False then
+         --  LRM93 7.3.2.2
+         --  the direction of the index subtype of the aggregate is that of the
+         --  index subtype of the base type of the aggregate.
+
+         if Is_Positional = True then
+            --  LRM93 7.3.2.2
+            --  For a positionnal aggregate, [...] the leftmost bound is given
+            --  by S'LEFT where S is the index subtype of the base type of the
+            --  array; [...] the rightmost bound is determined by the direction
+            --  of the index subtype and the number of element.
+            if Get_Type_Staticness (Index_Type) = Locally then
+               Info.Index_Subtype := Create_Range_Subtype_By_Length
+                 (Index_Type, Iir_Int64 (Len), Get_Location (Aggr));
+            end if;
+         else
+            --  Create an index subtype.
+            case Get_Kind (Index_Type) is
+               when Iir_Kind_Integer_Subtype_Definition =>
+                  Info.Index_Subtype := Create_Iir (Get_Kind (Index_Type));
+               when Iir_Kind_Enumeration_Type_Definition
+                 | Iir_Kind_Enumeration_Subtype_Definition =>
+                  Info.Index_Subtype :=
+                    Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               when others =>
+                  Error_Kind ("sem_array_aggregate_type2", Index_Type);
+            end case;
+            Location_Copy (Info.Index_Subtype, Aggr);
+            Set_Base_Type (Info.Index_Subtype, Get_Base_Type (Index_Type));
+            Index_Constraint := Get_Range_Constraint (Index_Type);
+
+            --  LRM93 7.3.2.2
+            --  If the aggregate appears in one of the above contexts, then the
+            --  direction of the index subtype of the aggregate is that of the
+            --  corresponding constrained array subtype; [...]
+            Index_Subtype_Constraint := Create_Iir (Iir_Kind_Range_Expression);
+            Location_Copy (Index_Subtype_Constraint, Aggr);
+            Set_Range_Constraint
+              (Info.Index_Subtype, Index_Subtype_Constraint);
+            Set_Type_Staticness (Info.Index_Subtype, Choice_Staticness);
+            Set_Expr_Staticness (Index_Subtype_Constraint, Choice_Staticness);
+
+            --  LRM93 7.3.2.2
+            --  For an aggregate that has named associations, the leftmost and
+            --  the rightmost bounds are determined by the direction of the
+            --  index subtype of the aggregate and the smallest and largest
+            --  choice given.
+            if Choice_Staticness = Locally then
+               if Low = Null_Iir or High = Null_Iir then
+                  --  Avoid error propagation.
+                  Set_Range_Constraint (Info.Index_Subtype,
+                                        Get_Range_Constraint (Index_Type));
+                  Free_Iir (Index_Subtype_Constraint);
+               else
+                  Set_Direction (Index_Subtype_Constraint,
+                                 Get_Direction (Index_Constraint));
+                  case Get_Direction (Index_Constraint) is
+                     when Iir_To =>
+                        Set_Left_Limit (Index_Subtype_Constraint, Low);
+                        Set_Right_Limit (Index_Subtype_Constraint, High);
+                     when Iir_Downto =>
+                        Set_Left_Limit (Index_Subtype_Constraint, High);
+                        Set_Right_Limit (Index_Subtype_Constraint, Low);
+                  end case;
+               end if;
+            else
+               --  Dynamic aggregate.
+               declare
+                  Expr : Iir;
+                  Choice : Iir;
+               begin
+                  Choice := Assoc_Chain;
+                  case Get_Kind (Choice) is
+                     when Iir_Kind_Choice_By_Expression =>
+                        Expr := Get_Choice_Expression (Choice);
+                        Set_Direction (Index_Subtype_Constraint,
+                                       Get_Direction (Index_Constraint));
+                        Set_Left_Limit (Index_Subtype_Constraint, Expr);
+                        Set_Right_Limit (Index_Subtype_Constraint, Expr);
+                     when Iir_Kind_Choice_By_Range =>
+                        Expr := Get_Choice_Range (Choice);
+                        Set_Range_Constraint (Info.Index_Subtype, Expr);
+                        -- FIXME: avoid allocation-free.
+                        Free_Iir (Index_Subtype_Constraint);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end;
+            end if;
+         end if;
+         --Set_Type_Staticness
+         --  (A_Subtype, Iirs.Min (Get_Type_Staticness (A_Subtype),
+         --                        Get_Type_Staticness (Index_Subtype)));
+         --Append_Element (Get_Index_List (A_Subtype), Index_Subtype);
+      elsif Has_Others = False then
+         --  Check the subaggregate bounds are the same.
+         if Is_Positional = True then
+            if Eval_Pos (Eval_Discrete_Range_Left (Get_Range_Constraint
+                                                   (Info.Index_Subtype)))
+              /= Eval_Pos (Eval_Discrete_Range_Left (Get_Range_Constraint
+                                                     (Index_Type)))
+            then
+               Error_Msg_Sem ("subaggregate bounds mismatch", Aggr);
+            else
+               if Eval_Discrete_Type_Length (Info.Index_Subtype)
+                 /= Iir_Int64 (Len)
+               then
+                  Error_Msg_Sem ("subaggregate length mismatch", Aggr);
+               end if;
+            end if;
+         else
+            declare
+               L, H : Iir;
+            begin
+               Get_Low_High_Limit
+                 (Get_Range_Constraint (Info.Index_Subtype), L, H);
+               if Eval_Pos (L) /= Eval_Pos (Low)
+                 or else Eval_Pos (H) /= Eval_Pos (H)
+               then
+                  Error_Msg_Sem ("subagregate bounds mismatch", Aggr);
+               end if;
+            end;
+         end if;
+      end if;
+
+      --  Semantize aggregate elements.
+      if Dim = Get_Nbr_Elements (Index_List) then
+         --  A type has been found for AGGR, semantize AGGR as if it was
+         --  an aggregate with a subtype.
+
+         if Get_Kind (Aggr) = Iir_Kind_Aggregate then
+            -- LRM93 7.3.2.2:
+            --   the expression of each element association must be of the
+            --   element type.
+            declare
+               El : Iir;
+               Element_Type : Iir;
+               Expr : Iir;
+               Value_Staticness : Iir_Staticness;
+               Expr_Staticness : Iir_Staticness;
+            begin
+               Element_Type := Get_Element_Subtype (A_Type);
+               El := Assoc_Chain;
+               Value_Staticness := Locally;
+               while El /= Null_Iir loop
+                  Expr := Get_Associated_Expr (El);
+                  if Expr /= Null_Iir then
+                     Expr := Sem_Expression (Expr, Element_Type);
+                     if Expr /= Null_Iir then
+                        Expr_Staticness := Get_Expr_Staticness (Expr);
+                        Set_Expr_Staticness
+                          (Aggr, Min (Get_Expr_Staticness (Aggr),
+                                      Expr_Staticness));
+                        Set_Associated_Expr (El, Eval_Expr_If_Static (Expr));
+
+                        --  FIXME: handle name/others in translate.
+                        --  if Get_Kind (Expr) = Iir_Kind_Aggregate then
+                        --     Expr_Staticness := Get_Value_Staticness (Expr);
+                        --  end if;
+                        Value_Staticness := Min (Value_Staticness,
+                                                 Expr_Staticness);
+                     else
+                        Info.Error := True;
+                     end if;
+                  end if;
+                  El := Get_Chain (El);
+               end loop;
+               Set_Value_Staticness (Aggr, Value_Staticness);
+            end;
+         end if;
+      else
+         declare
+            Assoc : Iir;
+            Value_Staticness : Iir_Staticness;
+         begin
+            Assoc := Null_Iir;
+            Choice := Assoc_Chain;
+            Value_Staticness := Locally;
+            while Choice /= Null_Iir loop
+               if Get_Associated_Expr (Choice) /= Null_Iir then
+                  Assoc := Get_Associated_Expr (Choice);
+               end if;
+               case Get_Kind (Assoc) is
+                  when Iir_Kind_Aggregate =>
+                     Sem_Array_Aggregate_Type_1
+                       (Assoc, A_Type, Infos, Constrained, Dim + 1);
+                     Value_Staticness := Min (Value_Staticness,
+                                              Get_Value_Staticness (Assoc));
+                  when Iir_Kind_String_Literal
+                    | Iir_Kind_Bit_String_Literal =>
+                     if Dim + 1 = Get_Nbr_Elements (Index_List) then
+                        Sem_Array_Aggregate_Type_1
+                          (Assoc, A_Type, Infos, Constrained, Dim + 1);
+                     else
+                        Error_Msg_Sem
+                          ("string literal not allowed here", Assoc);
+                        Infos (Dim + 1).Error := True;
+                     end if;
+                  when others =>
+                     Error_Msg_Sem ("sub-aggregate expected", Assoc);
+                     Infos (Dim + 1).Error := True;
+               end case;
+               Choice := Get_Chain (Choice);
+            end loop;
+            Set_Value_Staticness (Aggr, Value_Staticness);
+         end;
+      end if;
+   end Sem_Array_Aggregate_Type_1;
+
+   --  Semantize an array aggregate whose type is AGGR_TYPE.
+   --  If CONSTRAINED is true, then the aggregate appears in one of the
+   --  context and can have an 'others' choice.
+   --  If CONSTRAINED is false, the aggregate can not have an 'others' choice.
+   --  Create a subtype for this aggregate.
+   --  Return NULL_IIR in case of error, or AGGR if not.
+   function Sem_Array_Aggregate_Type
+     (Aggr : Iir; Aggr_Type : Iir; Constrained : Boolean)
+     return Iir
+   is
+      A_Subtype: Iir;
+      Base_Type : Iir;
+      Index_List : constant Iir_List := Get_Index_Subtype_List (Aggr_Type);
+      Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
+      Infos : Array_Aggr_Info_Arr (1 .. Nbr_Dim);
+      Aggr_Constrained : Boolean;
+      Info, Prev_Info : Iir_Aggregate_Info;
+   begin
+      --  Semantize the aggregate.
+      Sem_Array_Aggregate_Type_1 (Aggr, Aggr_Type, Infos, Constrained, 1);
+
+      Aggr_Constrained := True;
+      for I in Infos'Range loop
+         --  Return now in case of error.
+         if Infos (I).Error then
+            return Null_Iir;
+         end if;
+         if Infos (I).Index_Subtype = Null_Iir then
+            Aggr_Constrained := False;
+         end if;
+      end loop;
+      Base_Type := Get_Base_Type (Aggr_Type);
+
+      --  FIXME: should reuse AGGR_TYPE iff AGGR_TYPE is fully constrained
+      --  and statically match the subtype of the aggregate.
+      if Aggr_Constrained then
+         A_Subtype := Create_Array_Subtype (Base_Type, Get_Location (Aggr));
+         for I in Infos'Range loop
+            Append_Element (Get_Index_Subtype_List (A_Subtype),
+                            Infos (I).Index_Subtype);
+            Set_Type_Staticness
+              (A_Subtype,
+               Iirs.Min (Get_Type_Staticness (A_Subtype),
+                         Get_Type_Staticness (Infos (I).Index_Subtype)));
+         end loop;
+         Set_Index_Constraint_Flag (A_Subtype, True);
+         Set_Constraint_State (A_Subtype, Fully_Constrained);
+         Set_Type (Aggr, A_Subtype);
+         Set_Literal_Subtype (Aggr, A_Subtype);
+      else
+         --  Free unused indexes subtype.
+         for I in Infos'Range loop
+            declare
+               St : constant Iir := Infos (I).Index_Subtype;
+            begin
+               if St /= Null_Iir then
+                  Free_Iir (Get_Range_Constraint (St));
+                  Free_Iir (St);
+               end if;
+            end;
+         end loop;
+      end if;
+
+      Prev_Info := Null_Iir;
+      for I in Infos'Range loop
+         --  Create info and link.
+         Info := Create_Iir (Iir_Kind_Aggregate_Info);
+         if I = 1 then
+            Set_Aggregate_Info (Aggr, Info);
+         else
+            Set_Sub_Aggregate_Info (Prev_Info, Info);
+         end if;
+         Prev_Info := Info;
+
+         --  Fill info.
+         Set_Aggr_Dynamic_Flag (Info, Infos (I).Has_Dynamic);
+         Set_Aggr_Named_Flag (Info, Infos (I).Has_Named);
+         Set_Aggr_Low_Limit (Info, Infos (I).Low);
+         Set_Aggr_High_Limit (Info, Infos (I).High);
+         Set_Aggr_Min_Length (Info, Iir_Int32 (Infos (I).Min_Length));
+         Set_Aggr_Others_Flag (Info, Infos (I).Has_Others);
+      end loop;
+      return Aggr;
+   end Sem_Array_Aggregate_Type;
+
+   --  Semantize aggregate EXPR whose type is expected to be A_TYPE.
+   --  A_TYPE cannot be null_iir (this case is handled in sem_expression_ov)
+   function Sem_Aggregate (Expr: Iir_Aggregate; A_Type: Iir)
+                          return Iir_Aggregate is
+   begin
+      pragma Assert (A_Type /= Null_Iir);
+
+      --  An aggregate is at most globally static.
+      Set_Expr_Staticness (Expr, Globally);
+
+      Set_Type (Expr, A_Type); -- FIXME: should free old type
+      case Get_Kind (A_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            return Sem_Array_Aggregate_Type
+              (Expr, A_Type, Get_Index_Constraint_Flag (A_Type));
+         when Iir_Kind_Array_Type_Definition =>
+            return Sem_Array_Aggregate_Type (Expr, A_Type, False);
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            if not Sem_Record_Aggregate (Expr, A_Type) then
+               return Null_Iir;
+            end if;
+            return Expr;
+         when others =>
+            Error_Msg_Sem ("type " & Disp_Node (A_Type) & " is not composite",
+                           Expr);
+            return Null_Iir;
+      end case;
+   end Sem_Aggregate;
+
+   -- Transform LIT into a physical_literal.
+   -- LIT can be either a not semantized physical literal or
+   --  a simple name that is a physical unit.  In the later case, a physical
+   --  literal is created.
+   function Sem_Physical_Literal (Lit: Iir) return Iir
+   is
+      Unit_Name : Iir;
+      Unit_Type : Iir;
+      Res: Iir;
+   begin
+      case Get_Kind (Lit) is
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal =>
+            Unit_Name := Get_Unit_Name (Lit);
+            Res := Lit;
+         when Iir_Kind_Unit_Declaration =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Location_Copy (Res, Lit);
+            Set_Value (Res, 1);
+            Unit_Name := Null_Iir;
+            raise Program_Error;
+         when Iir_Kinds_Denoting_Name =>
+            Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+            Location_Copy (Res, Lit);
+            Set_Value (Res, 1);
+            Unit_Name := Lit;
+         when others =>
+            Error_Kind ("sem_physical_literal", Lit);
+      end case;
+      Unit_Name := Sem_Denoting_Name (Unit_Name);
+      if Get_Kind (Get_Named_Entity (Unit_Name)) /= Iir_Kind_Unit_Declaration
+      then
+         Error_Class_Match (Unit_Name, "unit");
+         Set_Named_Entity (Unit_Name, Create_Error_Name (Unit_Name));
+      end if;
+      Set_Unit_Name (Res, Unit_Name);
+      Unit_Type := Get_Type (Unit_Name);
+      Set_Type (Res, Unit_Type);
+
+      -- LRM93 7.4.2
+      -- 1. a literal of type TIME.
+      --
+      -- LRM93 7.4.1
+      -- 1. a literal of any type other than type TIME;
+      Set_Expr_Staticness (Res, Get_Expr_Staticness (Unit_Name));
+      --Eval_Check_Constraints (Res);
+      return Res;
+   end Sem_Physical_Literal;
+
+   --  Semantize an allocator by expression or an allocator by subtype.
+   function Sem_Allocator (Expr : Iir; A_Type : Iir) return Iir
+   is
+      Arg: Iir;
+      Arg_Type : Iir;
+   begin
+      Set_Expr_Staticness (Expr, None);
+
+      Arg_Type := Get_Allocator_Designated_Type (Expr);
+
+      if Arg_Type = Null_Iir then
+         --  Expression was not analyzed.
+         case Iir_Kinds_Allocator (Get_Kind (Expr)) is
+            when Iir_Kind_Allocator_By_Expression =>
+               Arg := Get_Expression (Expr);
+               pragma Assert (Get_Kind (Arg) = Iir_Kind_Qualified_Expression);
+               Arg := Sem_Expression (Arg, Null_Iir);
+               if Arg = Null_Iir then
+                  return Null_Iir;
+               end if;
+               Check_Read (Arg);
+               Set_Expression (Expr, Arg);
+               Arg_Type := Get_Type (Arg);
+            when Iir_Kind_Allocator_By_Subtype =>
+               Arg := Get_Subtype_Indication (Expr);
+               Arg := Sem_Types.Sem_Subtype_Indication (Arg);
+               Set_Subtype_Indication (Expr, Arg);
+               Arg := Get_Type_Of_Subtype_Indication (Arg);
+               if Arg = Null_Iir then
+                  return Null_Iir;
+               end if;
+               --  LRM93 7.3.6
+               --  If an allocator includes a subtype indication and if the
+               --  type of the object created is an array type, then the
+               --  subtype indication must either denote a constrained
+               --  subtype or include an explicit index constraint.
+               if not Is_Fully_Constrained_Type (Arg) then
+                  Error_Msg_Sem
+                    ("allocator of unconstrained " &
+                       Disp_Node (Arg) & " is not allowed", Expr);
+               end if;
+               --  LRM93 7.3.6
+               --  A subtype indication that is part of an allocator must
+               --  not include a resolution function.
+               if Is_Anonymous_Type_Definition (Arg)
+                 and then Get_Resolution_Indication (Arg) /= Null_Iir
+               then
+                  Error_Msg_Sem ("subtype indication must not include"
+                                   & " a resolution function", Expr);
+               end if;
+               Arg_Type := Arg;
+         end case;
+         Set_Allocator_Designated_Type (Expr, Arg_Type);
+      end if;
+
+      --  LRM 7.3.6 Allocators
+      --  The type of the access value returned by an allocator must be
+      --  determinable solely from the context, but using the fact that the
+      --  value returned is of an access type having the named designated
+      --  type.
+      if A_Type = Null_Iir then
+         --  Type of the context is not yet known.
+         return Expr;
+      else
+         if not Is_Allocator_Type (A_Type, Expr) then
+            if Get_Kind (A_Type) /= Iir_Kind_Access_Type_Definition then
+               if Get_Kind (A_Type) /= Iir_Kind_Error then
+                  Error_Msg_Sem ("expected type is not an access type", Expr);
+               end if;
+            else
+               Not_Match (Expr, A_Type);
+            end if;
+            return Null_Iir;
+         end if;
+         Set_Type (Expr, A_Type);
+         return Expr;
+      end if;
+   end Sem_Allocator;
+
+   procedure Check_Read_Aggregate (Aggr : Iir)
+   is
+      pragma Unreferenced (Aggr);
+   begin
+      --  FIXME: todo.
+      null;
+   end Check_Read_Aggregate;
+
+   --  Check EXPR can be read.
+   procedure Check_Read (Expr : Iir)
+   is
+      Obj : Iir;
+   begin
+      if Expr = Null_Iir then
+         return;
+      end if;
+
+      Obj := Expr;
+      loop
+         case Get_Kind (Obj) is
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Interface_Constant_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_Attribute_Value
+              | Iir_Kind_Iterator_Declaration
+              | Iir_Kind_Guard_Signal_Declaration =>
+               return;
+            when Iir_Kinds_Quantity_Declaration =>
+               return;
+            when Iir_Kind_File_Declaration
+              | Iir_Kind_Interface_File_Declaration =>
+               --  LRM 4.3.2  Interface declarations
+               --  The value of an object is said to be read [...]
+               --   -  When the object is a file and a READ operation is
+               --      performed on the file.
+               return;
+            when Iir_Kind_Object_Alias_Declaration =>
+               Obj := Get_Name (Obj);
+            when Iir_Kind_Interface_Signal_Declaration
+              | Iir_Kind_Interface_Variable_Declaration =>
+               case Get_Mode (Obj) is
+                  when Iir_In_Mode
+                    | Iir_Inout_Mode
+                    | Iir_Buffer_Mode =>
+                     null;
+                  when Iir_Out_Mode
+                    | Iir_Linkage_Mode =>
+                     Error_Msg_Sem (Disp_Node (Obj) & " cannot be read", Expr);
+                  when Iir_Unknown_Mode =>
+                     raise Internal_Error;
+               end case;
+               return;
+            when Iir_Kind_Enumeration_Literal
+              | Iir_Kind_Physical_Int_Literal
+              | Iir_Kind_Physical_Fp_Literal
+              | Iir_Kind_String_Literal
+              | Iir_Kind_Bit_String_Literal
+              | Iir_Kind_Character_Literal
+              | Iir_Kind_Integer_Literal
+              | Iir_Kind_Floating_Point_Literal
+              | Iir_Kind_Null_Literal
+              | Iir_Kind_Unit_Declaration
+              | Iir_Kind_Simple_Aggregate
+              | Iir_Kind_Overflow_Literal =>
+               return;
+            when Iir_Kinds_Monadic_Operator
+              | Iir_Kinds_Dyadic_Operator
+              | Iir_Kind_Function_Call =>
+               return;
+            when Iir_Kind_Parenthesis_Expression =>
+               Obj := Get_Expression (Obj);
+            when Iir_Kind_Qualified_Expression =>
+               return;
+            when Iir_Kind_Type_Conversion
+              | Iir_Kind_Allocator_By_Expression
+              | Iir_Kind_Allocator_By_Subtype
+              | Iir_Kind_Implicit_Dereference
+              | Iir_Kind_Dereference
+              | Iir_Kind_Attribute_Name =>
+               return;
+            when Iir_Kinds_Scalar_Type_Attribute
+              | Iir_Kinds_Type_Attribute
+              | Iir_Kinds_Array_Attribute
+              | Iir_Kind_Image_Attribute
+              | Iir_Kind_Value_Attribute
+              | Iir_Kinds_Name_Attribute
+              | Iir_Kinds_Signal_Attribute
+              | Iir_Kinds_Signal_Value_Attribute =>
+               return;
+            when Iir_Kind_Aggregate =>
+               Check_Read_Aggregate (Obj);
+               return;
+            when Iir_Kind_Indexed_Name
+              | Iir_Kind_Slice_Name
+              | Iir_Kind_Selected_Element =>
+               --  FIXME: speed up using Base_Name
+               --  Obj := Get_Base_Name (Obj);
+               Obj := Get_Prefix (Obj);
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               Obj := Get_Named_Entity (Obj);
+            when Iir_Kind_Error =>
+               return;
+            when others =>
+               Error_Kind ("check_read", Obj);
+         end case;
+      end loop;
+   end Check_Read;
+
+   procedure Check_Update (Expr : Iir)
+   is
+      pragma Unreferenced (Expr);
+   begin
+      null;
+   end Check_Update;
+
+   --  Emit an error if the constant EXPR is deferred and cannot be used in
+   --  the current context.
+   procedure Check_Constant_Restriction (Expr : Iir; Loc : Iir)
+   is
+      Lib : Iir;
+      Cur_Lib : Iir;
+   begin
+      --  LRM93 §2.6
+      --  Within a package declaration that contains the declaration
+      --  of a deferred constant, and within the body of that package,
+      --  before the end of the corresponding full declaration, the
+      --  use of a name that denotes the deferred constant is only
+      --  allowed in the default expression for a local generic,
+      --  local port or formal parameter.
+      if Get_Deferred_Declaration_Flag (Expr) = False
+        or else Get_Deferred_Declaration (Expr) /= Null_Iir
+      then
+         --  The constant declaration is not deferred
+         --  or the it has been fully declared.
+         return;
+      end if;
+
+      Lib := Get_Parent (Expr);
+      if Get_Kind (Lib) = Iir_Kind_Design_Unit then
+         Lib := Get_Library_Unit (Lib);
+         --  FIXME: the parent of the constant is the library unit or
+         --  the design unit ?
+         raise Internal_Error;
+      end if;
+      Cur_Lib := Get_Library_Unit (Sem.Get_Current_Design_Unit);
+      if (Get_Kind (Cur_Lib) = Iir_Kind_Package_Declaration
+          and then Lib = Cur_Lib)
+        or else (Get_Kind (Cur_Lib) = Iir_Kind_Package_Body
+                 and then Get_Package (Cur_Lib) = Lib)
+      then
+         Error_Msg_Sem ("invalid use of a deferred constant", Loc);
+      end if;
+   end Check_Constant_Restriction;
+
+   -- Set semantic to EXPR.
+   --  Replace simple_name with the referenced node,
+   --  Set type to nodes,
+   --  Resolve overloading
+
+   -- If A_TYPE is not null, then EXPR must be of type A_TYPE.
+   -- Return null in case of error.
+   function Sem_Expression_Ov (Expr: Iir; A_Type1: Iir) return Iir
+   is
+      A_Type: Iir;
+   begin
+--     -- Avoid to run sem_expression_ov when a node was already semantized
+--     -- except to resolve overload.
+--     if Get_Type (Expr) /= Null_Iir then
+--        --  EXPR was already semantized.
+--        if A_Type1 = null or else not Is_Overload_List (Get_Type (Expr)) then
+--           --  This call to sem_expression_ov do not add any informations.
+--           Check_Restrictions (Expr, Restriction);
+--           return Expr;
+--        end if;
+--        -- This is an overload list that will be reduced.
+--     end if;
+
+      -- A_TYPE must be a type definition and not a subtype.
+      if A_Type1 /= Null_Iir then
+         A_Type := Get_Base_Type (A_Type1);
+         if A_Type /= A_Type1 then
+            raise Internal_Error;
+         end if;
+      else
+         A_Type := Null_Iir;
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Attribute_Name =>
+            declare
+               E : Iir;
+            begin
+               E := Get_Named_Entity (Expr);
+               if E = Null_Iir then
+                  Sem_Name (Expr);
+                  E := Get_Named_Entity (Expr);
+                  if E = Null_Iir then
+                     raise Internal_Error;
+                  end if;
+               end if;
+               if E = Error_Mark then
+                  return Null_Iir;
+               end if;
+               if Get_Kind (E) = Iir_Kind_Constant_Declaration
+                 and then not Deferred_Constant_Allowed
+               then
+                  Check_Constant_Restriction (E, Expr);
+               end if;
+               E := Name_To_Expression (Expr, A_Type);
+               return E;
+            end;
+
+         when Iir_Kinds_Monadic_Operator =>
+            return Sem_Operator (Expr, A_Type, 1);
+
+         when Iir_Kinds_Dyadic_Operator =>
+            return Sem_Operator (Expr, A_Type, 2);
+
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kinds_Object_Declaration =>
+            -- All these case have already a type.
+            if Get_Type (Expr) = Null_Iir then
+               return Null_Iir;
+            end if;
+            if A_Type /= Null_Iir
+              and then not Are_Basetypes_Compatible
+              (A_Type, Get_Base_Type (Get_Type (Expr)))
+            then
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            end if;
+            return Expr;
+
+         when Iir_Kind_Integer_Literal =>
+            Set_Expr_Staticness (Expr, Locally);
+            if A_Type = Null_Iir then
+               Set_Type (Expr, Convertible_Integer_Type_Definition);
+               return Expr;
+            elsif Get_Kind (A_Type) = Iir_Kind_Integer_Type_Definition then
+               Set_Type (Expr, A_Type);
+               return Expr;
+            else
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            end if;
+
+         when Iir_Kind_Floating_Point_Literal =>
+            Set_Expr_Staticness (Expr, Locally);
+            if A_Type = Null_Iir then
+               Set_Type (Expr, Convertible_Real_Type_Definition);
+               return Expr;
+            elsif Get_Kind (A_Type) = Iir_Kind_Floating_Type_Definition then
+               Set_Type (Expr, A_Type);
+               return Expr;
+            else
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            end if;
+
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Unit_Declaration =>
+            declare
+               Res: Iir;
+            begin
+               Res := Sem_Physical_Literal (Expr);
+               if Res = Null_Iir then
+                  return Null_Iir;
+               end if;
+               if A_Type /= Null_Iir and then Get_Type (Res) /= A_Type then
+                  Not_Match (Res, A_Type);
+                  return Null_Iir;
+               end if;
+               return Res;
+            end;
+
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            --  LRM93 7.3.1 Literals
+            --  The type of a string or bit string literal must be
+            --  determinable solely from the context in whcih the literal
+            --  appears, excluding the literal itself [...]
+            if A_Type = Null_Iir then
+               return Expr;
+            end if;
+
+            if not Is_String_Literal_Type (A_Type, Expr) then
+               Not_Match (Expr, A_Type);
+               return Null_Iir;
+            else
+               Replace_Type (Expr, A_Type);
+               Sem_String_Literal (Expr);
+               return Expr;
+            end if;
+
+         when Iir_Kind_Null_Literal =>
+            Set_Expr_Staticness (Expr, Locally);
+            --  GHDL: the LRM doesn't explain how the type of NULL is
+            --  determined.  Use the same rule as string or aggregates.
+            if A_Type = Null_Iir then
+               return Expr;
+            end if;
+            if not Is_Null_Literal_Type (A_Type) then
+               Error_Msg_Sem ("null literal can only be access type", Expr);
+               return Null_Iir;
+            else
+               Set_Type (Expr, A_Type);
+               return Expr;
+            end if;
+
+         when Iir_Kind_Aggregate =>
+            --  LRM93 7.3.2 Aggregates
+            --  The type of an aggregate must be determinable solely from the
+            --  context in which the aggregate appears, excluding the aggregate
+            --  itself but [...]
+            if A_Type = Null_Iir then
+               return Expr;
+            else
+               return Sem_Aggregate (Expr, A_Type);
+            end if;
+
+         when Iir_Kind_Parenthesis_Expression =>
+            declare
+               Sub_Expr : Iir;
+            begin
+               Sub_Expr := Get_Expression (Expr);
+               Sub_Expr := Sem_Expression_Ov (Sub_Expr, A_Type1);
+               if Sub_Expr = Null_Iir then
+                  return Null_Iir;
+               end if;
+               Set_Expression (Expr, Sub_Expr);
+               Set_Type (Expr, Get_Type (Sub_Expr));
+               Set_Expr_Staticness (Expr, Get_Expr_Staticness (Sub_Expr));
+               return Expr;
+            end;
+
+         when Iir_Kind_Qualified_Expression =>
+            declare
+               N_Type: Iir;
+               Res: Iir;
+            begin
+               N_Type := Sem_Type_Mark (Get_Type_Mark (Expr));
+               Set_Type_Mark (Expr, N_Type);
+               N_Type := Get_Type (N_Type);
+               Set_Type (Expr, N_Type);
+               if A_Type /= Null_Iir
+                 and then not Are_Types_Compatible (A_Type, N_Type)
+               then
+                  Not_Match (Expr, A_Type);
+                  return Null_Iir;
+               end if;
+               Res := Sem_Expression (Get_Expression (Expr), N_Type);
+               if Res = Null_Iir then
+                  return Null_Iir;
+               end if;
+               Check_Read (Res);
+               Set_Expression (Expr, Res);
+               Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Res),
+                                               Get_Type_Staticness (N_Type)));
+               return Expr;
+            end;
+
+         when Iir_Kind_Allocator_By_Expression
+           | Iir_Kind_Allocator_By_Subtype =>
+            return Sem_Allocator (Expr, A_Type);
+
+         when Iir_Kinds_Procedure_Declaration =>
+            Error_Msg_Sem
+              (Disp_Node (Expr) & " cannot be used as an expression", Expr);
+            return Null_Iir;
+
+         when others =>
+            Error_Kind ("sem_expression_ov", Expr);
+            return Null_Iir;
+      end case;
+   end Sem_Expression_Ov;
+
+   -- If A_TYPE is not null, then EXPR must be of type A_TYPE.
+   -- Return null in case of error.
+   function Sem_Expression (Expr: Iir; A_Type: Iir) return Iir
+   is
+      A_Type1: Iir;
+      Res: Iir;
+      Expr_Type : Iir;
+   begin
+      if Check_Is_Expression (Expr, Expr) = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      -- Can't try to run sem_expression_ov when a node was already semantized
+      Expr_Type := Get_Type (Expr);
+      if Expr_Type /= Null_Iir and then not Is_Overload_List (Expr_Type) then
+         --  Checks types.
+         --  This is necessary when the first call to sem_expression was done
+         --  with A_TYPE set to NULL_IIR and results in setting the type of
+         --  EXPR.
+         if A_Type /= Null_Iir
+           and then not Are_Types_Compatible (Expr_Type, A_Type)
+         then
+            Not_Match (Expr, A_Type);
+            return Null_Iir;
+         end if;
+         return Expr;
+      end if;
+
+      -- A_TYPE must be a type definition and not a subtype.
+      if A_Type /= Null_Iir then
+         A_Type1 := Get_Base_Type (A_Type);
+      else
+         A_Type1 := Null_Iir;
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Aggregate =>
+            Res := Sem_Aggregate (Expr, A_Type);
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            if A_Type = Null_Iir then
+               Res := Sem_Expression_Ov (Expr, Null_Iir);
+            else
+               if not Is_String_Literal_Type (A_Type, Expr) then
+                  Not_Match (Expr, A_Type);
+                  return Null_Iir;
+               end if;
+               Set_Type (Expr, A_Type);
+               Sem_String_Literal (Expr);
+               return Expr;
+            end if;
+         when others =>
+            Res := Sem_Expression_Ov (Expr, A_Type1);
+      end case;
+
+      if Res /= Null_Iir and then Is_Overloaded (Res) then
+         --  FIXME: clarify between overload and not determinable from the
+         --  context.
+         Error_Overload (Expr);
+         if Get_Type (Res) /= Null_Iir then
+            Disp_Overload_List (Get_Overload_List (Get_Type (Res)), Expr);
+         end if;
+         return Null_Iir;
+      end if;
+      return Res;
+   end Sem_Expression;
+
+   function Sem_Composite_Expression (Expr : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Sem_Expression_Ov (Expr, Null_Iir);
+      if Res = Null_Iir or else Get_Type (Res) = Null_Iir then
+         return Res;
+      elsif Is_Overload_List (Get_Type (Res)) then
+         declare
+            List : constant Iir_List := Get_Overload_List (Get_Type (Res));
+            Res_Type : Iir;
+            Atype : Iir;
+         begin
+            Res_Type := Null_Iir;
+            for I in Natural loop
+               Atype := Get_Nth_Element (List, I);
+               exit when Atype = Null_Iir;
+               if Is_Aggregate_Type (Atype) then
+                  Add_Result (Res_Type, Atype);
+               end if;
+            end loop;
+
+            if Res_Type = Null_Iir then
+               Error_Overload (Expr);
+               return Null_Iir;
+            elsif Is_Overload_List (Res_Type) then
+               Error_Overload (Expr);
+               Disp_Overload_List (Get_Overload_List (Res_Type), Expr);
+               Free_Overload_List (Res_Type);
+               return Null_Iir;
+            else
+               return Sem_Expression_Ov (Expr, Res_Type);
+            end if;
+         end;
+      else
+         --  Either an error (already handled) or not overloaded.  Type
+         --  matching will be done later (when the target is analyzed).
+         return Res;
+      end if;
+   end Sem_Composite_Expression;
+
+   function Sem_Expression_Universal (Expr : Iir) return Iir
+   is
+      Expr1 : Iir;
+      Expr_Type : Iir;
+      El : Iir;
+      Res : Iir;
+      List : Iir_List;
+   begin
+      Expr1 := Sem_Expression_Ov (Expr, Null_Iir);
+      if Expr1 = Null_Iir then
+         return Null_Iir;
+      end if;
+      Expr_Type := Get_Type (Expr1);
+      if Expr_Type = Null_Iir then
+         --  FIXME: improve message
+         Error_Msg_Sem ("bad expression for a scalar", Expr);
+         return Null_Iir;
+      end if;
+      if not Is_Overload_List (Expr_Type) then
+         return Expr1;
+      end if;
+
+      List := Get_Overload_List (Expr_Type);
+      Res := Null_Iir;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if El = Universal_Integer_Type_Definition
+           or El = Convertible_Integer_Type_Definition
+           or El = Universal_Real_Type_Definition
+           or El = Convertible_Real_Type_Definition
+         then
+            if Res = Null_Iir then
+               Res := El;
+            else
+               Error_Overload (Expr1);
+               Disp_Overload_List (List, Expr1);
+               return Null_Iir;
+            end if;
+         end if;
+      end loop;
+      if Res = Null_Iir then
+         Error_Overload (Expr1);
+         Disp_Overload_List (List, Expr1);
+         return Null_Iir;
+      end if;
+      return Sem_Expression_Ov (Expr1, Res);
+   end Sem_Expression_Universal;
+
+   function Sem_Case_Expression (Expr : Iir) return Iir
+   is
+      Expr1 : Iir;
+      Expr_Type : Iir;
+      El : Iir;
+      Res : Iir;
+      List : Iir_List;
+   begin
+      Expr1 := Sem_Expression_Ov (Expr, Null_Iir);
+      if Expr1 = Null_Iir then
+         return Null_Iir;
+      end if;
+      Expr_Type := Get_Type (Expr1);
+      if Expr_Type = Null_Iir then
+         --  Possible only if the type cannot be determined without the
+         --  context (aggregate or string literal).
+         Error_Msg_Sem
+           ("cannot determine the type of choice expression", Expr);
+         if Get_Kind (Expr1) = Iir_Kind_Aggregate then
+            Error_Msg_Sem
+              ("(use a qualified expression of the form T'(xxx).)", Expr);
+         end if;
+         return Null_Iir;
+      end if;
+      if not Is_Overload_List (Expr_Type) then
+         return Expr1;
+      end if;
+
+      --  In case of overload, try to find one match.
+      --  FIXME: match only character types.
+
+      --  LRM93 8.8  Case statement
+      --  This type must be determinable independently of the context in which
+      --  the expression occurs, but using the fact that the expression must be
+      --  of a discrete type or a one-dimensional character array type.
+      List := Get_Overload_List (Expr_Type);
+      Res := Null_Iir;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if Get_Kind (El) in Iir_Kinds_Discrete_Type_Definition
+           or else Is_One_Dimensional_Array_Type (El)
+         then
+            if Res = Null_Iir then
+               Res := El;
+            else
+               Error_Overload (Expr1);
+               Disp_Overload_List (List, Expr1);
+               return Null_Iir;
+            end if;
+         end if;
+      end loop;
+      if Res = Null_Iir then
+         Error_Overload (Expr1);
+         Disp_Overload_List (List, Expr1);
+         return Null_Iir;
+      end if;
+      return Sem_Expression_Ov (Expr1, Get_Base_Type (Res));
+   end Sem_Case_Expression;
+
+   function Sem_Condition (Cond : Iir) return Iir
+   is
+      Res : Iir;
+      Op : Iir;
+   begin
+      if Vhdl_Std < Vhdl_08 then
+         Res := Sem_Expression (Cond, Boolean_Type_Definition);
+
+         Check_Read (Res);
+         return Res;
+      else
+         --  LRM08 9.2.9
+         --  If, without overload resolution (see 12.5), the expression is
+         --  of type BOOLEAN defined in package STANDARD, or if, assuming a
+         --  rule requiring the expression to be of type BOOLEAN defined in
+         --  package STANDARD, overload resolution can determine at least one
+         --  interpretation of each constituent of the innermost complete
+         --  context including the expression, then the condition operator is
+         --  not applied.
+
+         --  GHDL: what does the second alternative mean ?  Any example ?
+
+         Res := Sem_Expression_Ov (Cond, Null_Iir);
+
+         if Res = Null_Iir then
+            return Res;
+         end if;
+
+         if not Is_Overloaded (Res)
+           and then Get_Type (Res) = Boolean_Type_Definition
+         then
+            Check_Read (Res);
+            return Res;
+         end if;
+
+         --  LRM08 9.2.9
+         --  Otherwise, the condition operator is implicitely applied, and the
+         --  type of the expresion with the implicit application shall be
+         --  BOOLEAN defined in package STANDARD.
+
+         Op := Create_Iir (Iir_Kind_Condition_Operator);
+         Location_Copy (Op, Res);
+         Set_Operand (Op, Res);
+
+         Res := Sem_Operator (Op, Boolean_Type_Definition, 1);
+         Check_Read (Res);
+         return Res;
+      end if;
+   end Sem_Condition;
+
+end Sem_Expr;
diff --git a/src/sem_expr.ads b/src/sem_expr.ads
new file mode 100644
index 000000000..a0422e727
--- /dev/null
+++ b/src/sem_expr.ads
@@ -0,0 +1,178 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Sem_Expr is
+   -- Set semantic to EXPR.
+   --  Replace simple_name with the referenced node,
+   --  Set type to nodes,
+   --  Resolve overloading
+
+   Deferred_Constant_Allowed : Boolean := False;
+
+   -- Semantize an expression (other than a range) with a possible overloading.
+   -- Sem_expression_ov (and therefore sem_expression) must be called *once*
+   -- for each expression node with A_TYPE1 not null and at most *once* with
+   -- A_TYPE1 null.
+   --
+   -- When A_TYPE1 is null, sem_expression_ov find all possible types
+   -- of the expression.  If there is only one possible type (ie, overloading
+   -- is non-existant or solved), then the type of the expression is set,
+   -- and the node is completly semantized.  Sem_expression_ov must not
+   -- be called for such a node.
+   -- If there is several possible types (ie overloaded), then the type is
+   -- set with a list of overload.  To finishes the semantisation,
+   -- sem_expression_ov must be called again with A_TYPE1 set to the
+   -- expected type.
+   --
+   -- If A_TYPE1 is set, sem_expression_ov must finishes the semantisation
+   -- of the expression, and set its type, which is not necessary a base type.
+   -- A_TYPE1 must be a base type.
+   --
+   -- In case of error, it displays a message and return null.
+   -- In case of success, it returns the semantized expression, which can
+   -- be different from EXPR (eg, a character literal is transformed into an
+   -- enumeration literal).
+   function Sem_Expression_Ov (Expr: Iir; A_Type1: Iir) return Iir;
+
+   -- If A_TYPE is not null, then EXPR must be of type A_TYPE.
+   -- Return null in case of error.
+   function Sem_Expression (Expr: Iir; A_Type: Iir) return Iir;
+
+   --  Same as Sem_Expression, but also implicitly choose an universal type
+   --  if overloaded.
+   function Sem_Expression_Universal (Expr : Iir) return Iir;
+
+   --  Same as Sem_Expression but specialized for a case expression.
+   --  (Handle specific overloading rules).
+   function Sem_Case_Expression (Expr : Iir) return Iir;
+
+   --  Sem COND as a condition.
+   --  In VHDL08, this follows 9.2.9 Condition operator.
+   --  In VHDL87 and 93, type of COND must be a boolean.
+   --  A check is made that COND can be read.
+   function Sem_Condition (Cond : Iir) return Iir;
+
+   --  Same as Sem_Expression but knowing that the type of EXPR must be a
+   --  composite type.  Used for expressions in assignment statement when the
+   --  target is an aggregate.
+   function Sem_Composite_Expression (Expr : Iir) return Iir;
+
+   --  Check EXPR can be read.
+   procedure Check_Read (Expr : Iir);
+
+   --  Check EXPR can be updated.
+   procedure Check_Update (Expr : Iir);
+
+   --  Check the type of EXPR can be implicitly converted to TARG_TYPE, ie
+   --  if TARG_TYPE is a constrained array subtype, number of elements matches.
+   --  Return FALSE in case of error.
+   --  If TARG_TYPE or EXPR is NULL_IIR, silently returns TRUE.
+   function Check_Implicit_Conversion (Targ_Type : Iir; Expr : Iir)
+                                      return Boolean;
+
+   -- For a procedure call, A_TYPE must be null.
+   function Sem_Subprogram_Call (Expr: Iir; A_Type: Iir) return Iir;
+
+   --  If EXPR is a node for an expression, then return EXPR.
+   --  Otherwise, emit an error message using LOC as location
+   --   and return NULL_IIR.
+   --  If EXPR is NULL_IIR, NULL_IIR is silently returned.
+   function Check_Is_Expression (Expr : Iir; Loc : Iir) return Iir;
+
+   --  Semantize a procedure_call or a concurrent_procedure_call_statement.
+   --  A procedure call is not an expression but because most of the code
+   --  for procedure call is common with function call, procedure calls are
+   --  handled in this package.
+   procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir);
+
+   --  Analyze a range (ie a range attribute or a range expression).  If
+   --  ANY_DIR is true, the range can't be a null range (slice vs subtype,
+   --  used in static evaluation). A_TYPE may be Null_Iir.
+   --  Return Null_Iir in case of error, or EXPR analyzed (and evaluated if
+   --  possible).
+   function Sem_Range_Expression (Expr: Iir; A_Type: Iir; Any_Dir : Boolean)
+     return Iir;
+
+   --  Analyze a discrete range.  If ANY_DIR is true, the range can't be a
+   --  null range (slice vs subtype -- used in static evaluation). A_TYPE may
+   --  be Null_Iir. Return Null_Iir in case of error.
+   function Sem_Discrete_Range_Expression
+     (Expr: Iir; A_Type: Iir; Any_Dir: Boolean) return Iir;
+
+   --  Semantize a discrete range and convert to integer if both bounds are
+   --  universal integer types, according to rules of LRM 3.2.1.1
+   function Sem_Discrete_Range_Integer (Expr: Iir) return Iir;
+
+   --  Transform LIT into a physical_literal.
+   --  LIT can be either a not semantized physical literal or
+   --  a simple name that is a physical unit.  In the later case, a physical
+   --  literal is created.
+   function Sem_Physical_Literal (Lit: Iir) return Iir;
+
+   --  CHOICES_LIST is a list of choices (none, expression, range, list or
+   --    others).
+   --  If IS_SUB_RANGE is true, then SUB_TYPE may not be fully convered,
+   --    otherwise, SUB_TYPE must be fully covered.
+   --    This is used when the subtype of an aggregate must be determined.
+   --  SUB_TYPE is the discrete subtype.
+   --  Emit a message if:
+   --  * the SUB_TYPE is not fully covered by the choices
+   --  * the choices are not mutually exclusif (an element is present twice)
+   --  * OTHERS is not the last choice, or is present several times.
+   --
+   --  If there is at least one named choice, LOW and HIGH are set with the
+   --  lowest and highest index.
+   --  If LOW and HIGH are set, they are locally static.
+   --
+   --  Unidimensional strings are not handled here but by
+   --  sem_string_choices_range.
+   --
+   --  TODO:
+   --  * be smarter if only positional choices (do not create the list).
+   --  * smarter messages.
+   procedure Sem_Choices_Range
+     (Choice_Chain : in out Iir;
+      Sub_Type : Iir;
+      Is_Sub_Range : Boolean;
+      Is_Case_Stmt : Boolean;
+      Loc : Location_Type;
+      Low : out Iir;
+      High : out Iir);
+
+   --  Semantize CHOICE_LIST when the choice expression SEL is of a
+   --  one-dimensional character array type.
+   procedure Sem_String_Choices_Range (Choice_Chain : Iir; Sel : Iir);
+
+   -- LEFT are RIGHT must be really a type (not a subtype).
+   function Are_Basetypes_Compatible (Left: Iir; Right: Iir)
+     return Boolean;
+
+   --  Return TRUE iif types of LEFT and RIGHT are compatible.
+   function Are_Nodes_Compatible (Left: Iir; Right: Iir)
+     return Boolean;
+
+   --  Return TRUE iff the type of EXPR is compatible with A_TYPE
+   function Is_Expr_Compatible (A_Type : Iir; Expr : Iir) return Boolean;
+
+   --  LIST1, LIST2 are either a type node or an overload list of types.
+   --  Return THE type which is compatible with LIST1 are LIST2.
+   --  Return null_iir if there is no such type or if there are several types.
+   function Search_Compatible_Type (List1, List2 : Iir) return Iir;
+end Sem_Expr;
diff --git a/src/sem_inst.adb b/src/sem_inst.adb
new file mode 100644
index 000000000..a9ba7560e
--- /dev/null
+++ b/src/sem_inst.adb
@@ -0,0 +1,639 @@
+--  Package (and subprograms) instantiations
+
+--  When a package is instantiated, we need to 'duplicate' its declaration.
+--  This looks useless for analysis but it isn't: a type from a package
+--  instantiated twice declares two different types.  Without duplication, we
+--  need to attach to each declaration its instance, which looks more expansive
+--  that duplicating the declaration.
+--
+--  Furthermore, for generic type interface, it looks a good idea to duplicate
+--  the body (macro expansion).
+--
+--  Duplicating is not trivial: internal links must be kept and external
+--  links preserved.  A table is used to map nodes from the uninstantiated
+--  package to its duplicated node.  Links from instantiated declaration to
+--  the original declaration are also stored in that table.
+
+with GNAT.Table;
+with Nodes;
+with Nodes_Meta;
+with Types; use Types;
+with Iirs_Utils; use Iirs_Utils;
+with Errorout; use Errorout;
+
+package body Sem_Inst is
+   --  Table of origin.  This is an extension of vhdl nodes to track the
+   --  origin of a node.  If a node has a non-null origin, then the node was
+   --  instantiated for the origin node.
+   --
+   --  Furthermore, during instantiation, we need to keep track of instantiated
+   --  nodes (ie nodes created by instantiation) used by references.  As an
+   --  instance cannot be uninstantiated, there is no collisions, as soon as
+   --  such entries are cleaned after instantiation.
+   --
+   --  As an example, here are declarations of an uninstantiated package:
+   --    type Nat is range 0 to 1023;
+   --    constant N : Nat := 5;
+   --  A node Nat1 will be created from node Nat (an integer type definition).
+   --  The origin of Nat1 is Nat and this is true forever.  During
+   --  instantiation, the instance of Nat is Nat1, so that the type of N will
+   --  be set to Nat1.
+   package Origin_Table is new GNAT.Table
+     (Table_Component_Type => Iir,
+      Table_Index_Type => Iir,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   procedure Expand_Origin_Table
+   is
+      use Nodes;
+      Last : constant Iir := Iirs.Get_Last_Node;
+      El: Iir;
+   begin
+      El := Origin_Table.Last;
+      if El < Last then
+         Origin_Table.Set_Last (Last);
+         Origin_Table.Table (El + 1 .. Last) := (others => Null_Iir);
+      end if;
+   end Expand_Origin_Table;
+
+   --  This is the public function; the table may not have been extended.
+   function Get_Origin (N : Iir) return Iir
+   is
+      --  Make the '<=' operator visible.
+      use Nodes;
+   begin
+      if N <= Origin_Table.Last then
+         return Origin_Table.Table (N);
+      else
+         return Null_Iir;
+      end if;
+   end Get_Origin;
+
+   --  This is the private function: the table *must* have been extended.
+   function Get_Instance (N : Iir) return Iir
+   is
+      --  Make '<=' operator visible for the assert.
+      use Nodes;
+   begin
+      pragma Assert (N <= Origin_Table.Last);
+      return Origin_Table.Table (N);
+   end Get_Instance;
+
+   procedure Set_Origin (N : Iir; Orig : Iir) is
+   begin
+      --  As nodes are created, we need to expand origin table.
+      Expand_Origin_Table;
+
+      pragma Assert (Orig = Null_Iir
+                       or else Origin_Table.Table (N) = Null_Iir);
+      Origin_Table.Table (N) := Orig;
+   end Set_Origin;
+
+   type Instance_Entry_Type is record
+      --  Node
+      N : Iir;
+
+      --  Old value in Origin_Table.
+      Old_Origin : Iir;
+   end record;
+
+   type Instance_Index_Type is new Natural;
+
+   --  Table of previous values in Origin_Table.  The first purpose of this
+   --  table is to be able to revert the calls to Set_Instance, so that a unit
+   --  can be instantiated several times.  Keep the nodes that have been
+   --  instantiated is cheaper than walking the tree a second time.
+   --  The second purpose of this table is not yet implemented: being able to
+   --  have uninstantiated packages in instantiated packages.  In that case,
+   --  the slot in Origin_Table cannot be the origin and the instance at the
+   --  same time.
+   package Prev_Instance_Table is new GNAT.Table
+     (Table_Component_Type => Instance_Entry_Type,
+      Table_Index_Type => Instance_Index_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 256,
+      Table_Increment => 100);
+
+   procedure Set_Instance (Orig : Iir; N : Iir)
+   is
+      use Nodes;
+   begin
+      pragma Assert (Orig <= Origin_Table.Last);
+
+      --  Save the old entry
+      Prev_Instance_Table.Append
+        (Instance_Entry_Type'(N => Orig,
+                              Old_Origin => Origin_Table.Table (Orig)));
+
+      --  Set the entry.
+      Origin_Table.Table (Orig) := N;
+   end Set_Instance;
+
+   procedure Restore_Origin (Mark : Instance_Index_Type) is
+   begin
+      for I in reverse Mark + 1 .. Prev_Instance_Table.Last loop
+         declare
+            El : Instance_Entry_Type renames Prev_Instance_Table.Table (I);
+         begin
+            Origin_Table.Table (El.N) := El.Old_Origin;
+         end;
+      end loop;
+      Prev_Instance_Table.Set_Last (Mark);
+   end Restore_Origin;
+
+   --  The location to be used while instantiated nodes.
+   Instantiate_Loc : Location_Type;
+
+   function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir;
+
+   --  Instantiate a list.  Simply create a new list and instantiate nodes of
+   --  that list.
+   function Instantiate_Iir_List (L : Iir_List; Is_Ref : Boolean)
+                                 return Iir_List
+   is
+      Res : Iir_List;
+      El : Iir;
+   begin
+      case L is
+         when Null_Iir_List
+           | Iir_List_All
+           | Iir_List_Others =>
+            return L;
+         when others =>
+            Res := Create_Iir_List;
+            for I in Natural loop
+               El := Get_Nth_Element (L, I);
+               exit when El = Null_Iir;
+               Append_Element (Res, Instantiate_Iir (El, Is_Ref));
+            end loop;
+            return Res;
+      end case;
+   end Instantiate_Iir_List;
+
+   --  Instantiate a chain.  This is a special case to reduce stack depth.
+   function Instantiate_Iir_Chain (N : Iir) return Iir
+   is
+      First : Iir;
+      Last : Iir;
+      Next_N : Iir;
+      Next_R : Iir;
+   begin
+      if N = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      First := Instantiate_Iir (N, False);
+      Last := First;
+      Next_N := Get_Chain (N);
+      while Next_N /= Null_Iir loop
+         Next_R := Instantiate_Iir (Next_N, False);
+         Set_Chain (Last, Next_R);
+         Last := Next_R;
+         Next_N := Get_Chain (Next_N);
+      end loop;
+
+      return First;
+   end Instantiate_Iir_Chain;
+
+   procedure Instantiate_Iir_Field
+     (Res : Iir; N : Iir; F : Nodes_Meta.Fields_Enum)
+   is
+      use Nodes_Meta;
+   begin
+      case Get_Field_Type (F) is
+         when Type_Iir =>
+            declare
+               S : constant Iir := Get_Iir (N, F);
+               R : Iir;
+            begin
+               case Get_Field_Attribute (F) is
+                  when Attr_None =>
+                     R := Instantiate_Iir (S, False);
+                  when Attr_Ref =>
+                     R := Instantiate_Iir (S, True);
+                  when Attr_Maybe_Ref =>
+                     R := Instantiate_Iir (S, Get_Is_Ref (N));
+                  when Attr_Chain =>
+                     R := Instantiate_Iir_Chain (S);
+                  when Attr_Chain_Next =>
+                     R := Null_Iir;
+                  when Attr_Of_Ref =>
+                     --  Can only appear in list.
+                     raise Internal_Error;
+               end case;
+               Set_Iir (Res, F, R);
+            end;
+         when Type_Iir_List =>
+            declare
+               S : constant Iir_List := Get_Iir_List (N, F);
+               R : Iir_List;
+            begin
+               case Get_Field_Attribute (F) is
+                  when Attr_None =>
+                     R := Instantiate_Iir_List (S, False);
+                  when Attr_Of_Ref =>
+                     R := Instantiate_Iir_List (S, True);
+                  when others =>
+                     --  Ref is specially handled in Instantiate_Iir.
+                     --  Others cannot appear for lists.
+                     raise Internal_Error;
+               end case;
+               Set_Iir_List (Res, F, R);
+            end;
+         when Type_PSL_NFA
+           | Type_PSL_Node =>
+            --  TODO
+            raise Internal_Error;
+         when Type_String_Id =>
+            Set_String_Id (Res, F, Get_String_Id (N, F));
+         when Type_Source_Ptr =>
+            Set_Source_Ptr (Res, F, Get_Source_Ptr (N, F));
+         when Type_Date_Type
+           | Type_Date_State_Type
+           | Type_Time_Stamp_Id =>
+            --  Can this happen ?
+            raise Internal_Error;
+         when Type_Base_Type =>
+            Set_Base_Type (Res, F, Get_Base_Type (N, F));
+         when Type_Iir_Constraint =>
+            Set_Iir_Constraint (Res, F, Get_Iir_Constraint (N, F));
+         when Type_Iir_Mode =>
+            Set_Iir_Mode (Res, F, Get_Iir_Mode (N, F));
+         when Type_Iir_Index32 =>
+            Set_Iir_Index32 (Res, F, Get_Iir_Index32 (N, F));
+         when Type_Iir_Int64 =>
+            Set_Iir_Int64 (Res, F, Get_Iir_Int64 (N, F));
+         when Type_Boolean =>
+            Set_Boolean (Res, F, Get_Boolean (N, F));
+         when Type_Iir_Staticness =>
+            Set_Iir_Staticness (Res, F, Get_Iir_Staticness (N, F));
+         when Type_Iir_All_Sensitized =>
+            Set_Iir_All_Sensitized (Res, F, Get_Iir_All_Sensitized (N, F));
+         when Type_Iir_Signal_Kind =>
+            Set_Iir_Signal_Kind (Res, F, Get_Iir_Signal_Kind (N, F));
+         when Type_Tri_State_Type =>
+            Set_Tri_State_Type (Res, F, Get_Tri_State_Type (N, F));
+         when Type_Iir_Pure_State =>
+            Set_Iir_Pure_State (Res, F, Get_Iir_Pure_State (N, F));
+         when Type_Iir_Delay_Mechanism =>
+            Set_Iir_Delay_Mechanism (Res, F, Get_Iir_Delay_Mechanism (N, F));
+         when Type_Iir_Lexical_Layout_Type =>
+            Set_Iir_Lexical_Layout_Type
+              (Res, F, Get_Iir_Lexical_Layout_Type (N, F));
+         when Type_Iir_Predefined_Functions =>
+            Set_Iir_Predefined_Functions
+              (Res, F, Get_Iir_Predefined_Functions (N, F));
+         when Type_Iir_Direction =>
+            Set_Iir_Direction (Res, F, Get_Iir_Direction (N, F));
+         when Type_Location_Type =>
+            Set_Location_Type (Res, F, Instantiate_Loc);
+         when Type_Iir_Int32 =>
+            Set_Iir_Int32 (Res, F, Get_Iir_Int32 (N, F));
+         when Type_Int32 =>
+            Set_Int32 (Res, F, Get_Int32 (N, F));
+         when Type_Iir_Fp64 =>
+            Set_Iir_Fp64 (Res, F, Get_Iir_Fp64 (N, F));
+         when Type_Token_Type =>
+            Set_Token_Type (Res, F, Get_Token_Type (N, F));
+         when Type_Name_Id =>
+            Set_Name_Id (Res, F, Get_Name_Id (N, F));
+      end case;
+   end Instantiate_Iir_Field;
+
+   function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir
+   is
+      Res : Iir;
+   begin
+      --  Nothing to do for null node.
+      if N = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      --  For a reference, do not create a new node.
+      if Is_Ref then
+         Res := Get_Instance (N);
+         if Res /= Null_Iir then
+            --  There is an instance for N.
+            return Res;
+         else
+            --  Reference outside the instance.
+            return N;
+         end if;
+      end if;
+
+      declare
+         use Nodes_Meta;
+         Kind : constant Iir_Kind := Get_Kind (N);
+         Fields : constant Fields_Array := Get_Fields (Kind);
+         F : Fields_Enum;
+      begin
+         Res := Get_Instance (N);
+
+         if Kind = Iir_Kind_Interface_Constant_Declaration
+           and then Get_Identifier (N) = Null_Identifier
+           and then Res /= Null_Iir
+         then
+            --  Anonymous constant interface declarations are the only nodes
+            --  that can be shared.  Handle that very special case.
+            return Res;
+         end if;
+
+         pragma Assert (Res = Null_Iir);
+
+         --  Create a new node.
+         Res := Create_Iir (Kind);
+
+         --  The origin of this new node is N.
+         Set_Origin (Res, N);
+
+         --  And the instance of N is RES.
+         Set_Instance (N, Res);
+
+         Set_Location (Res, Instantiate_Loc);
+
+         for I in Fields'Range loop
+            F := Fields (I);
+
+            --  Fields that are handled specially.
+            case F is
+               when Field_Index_Subtype_List =>
+                  --  Index_Subtype_List is always a reference, so retrieve
+                  --  the instance of the referenced list.  This is a special
+                  --  case because there is no origins for list.
+                  declare
+                     List : Iir_List;
+                  begin
+                     case Kind is
+                        when Iir_Kind_Array_Type_Definition =>
+                           List := Get_Index_Subtype_Definition_List (Res);
+                        when Iir_Kind_Array_Subtype_Definition =>
+                           List := Get_Index_Constraint_List (Res);
+                           if List = Null_Iir_List then
+                              List := Get_Index_Subtype_List
+                                (Get_Denoted_Type_Mark (Res));
+                           end if;
+                        when others =>
+                           --  All the nodes where Index_Subtype_List appears
+                           --  are handled above.
+                           raise Internal_Error;
+                     end case;
+                     Set_Index_Subtype_List (Res, List);
+                  end;
+
+               when others =>
+                  --  Common case.
+                  Instantiate_Iir_Field (Res, N, F);
+            end case;
+         end loop;
+
+         case Kind is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               --  Subprogram body is a forward declaration.
+               Set_Subprogram_Body (Res, Null_Iir);
+            when others =>
+               --  TODO: other forward references:
+               --  incomplete constant
+               --  attribute_value
+               null;
+         end case;
+
+         return Res;
+      end;
+   end Instantiate_Iir;
+
+   --  As the scope generic interfaces extends beyond the immediate scope (see
+   --  LRM08 12.2 Scope of declarations), they must be instantiated.
+   function Instantiate_Generic_Chain (Inst : Iir; Inters : Iir) return Iir
+   is
+      Inter : Iir;
+      First : Iir;
+      Last : Iir;
+      Res : Iir;
+   begin
+      First := Null_Iir;
+      Last := Null_Iir;
+
+      Inter := Inters;
+      while Inter /= Null_Iir loop
+         --  Create a copy of the interface.  FIXME: is it really needed ?
+         Res := Create_Iir (Get_Kind (Inter));
+         Set_Location (Res, Instantiate_Loc);
+         Set_Parent (Res, Inst);
+         Set_Identifier (Res, Get_Identifier (Inter));
+         Set_Visible_Flag (Res, Get_Visible_Flag (Inter));
+
+         Set_Origin (Res, Inter);
+         Set_Instance (Inter, Res);
+
+         case Get_Kind (Res) is
+            when Iir_Kind_Interface_Constant_Declaration =>
+               Set_Type (Res, Get_Type (Inter));
+               Set_Subtype_Indication (Res, Get_Subtype_Indication (Inter));
+               Set_Mode (Res, Get_Mode (Inter));
+               Set_Lexical_Layout (Res, Get_Lexical_Layout (Inter));
+               Set_Expr_Staticness (Res, Get_Expr_Staticness (Inter));
+               Set_Name_Staticness (Res, Get_Name_Staticness (Inter));
+            when Iir_Kind_Interface_Package_Declaration =>
+               Set_Uninstantiated_Package_Name
+                 (Res, Get_Uninstantiated_Package_Name (Inter));
+            when others =>
+               Error_Kind ("instantiate_generic_chain", Res);
+         end case;
+
+         --  Append
+         if First = Null_Iir then
+            First := Res;
+         else
+            Set_Chain (Last, Res);
+         end if;
+         Last := Res;
+
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      return First;
+   end Instantiate_Generic_Chain;
+
+   procedure Set_Instance_On_Chain (Chain : Iir; Inst_Chain : Iir);
+   procedure Set_Instance_On_Iir_List (N : Iir_List; Inst : Iir_List);
+
+   procedure Set_Instance_On_Iir (N : Iir; Inst : Iir) is
+   begin
+      if N = Null_Iir then
+         pragma Assert (Inst = Null_Iir);
+         return;
+      end if;
+      pragma Assert (Inst /= Null_Iir);
+
+      declare
+         use Nodes_Meta;
+         Kind : constant Iir_Kind := Get_Kind (N);
+         Fields : constant Fields_Array := Get_Fields (Kind);
+         F : Fields_Enum;
+      begin
+         pragma Assert (Get_Kind (Inst) = Kind);
+
+         if Kind = Iir_Kind_Interface_Constant_Declaration
+           and then Get_Identifier (N) = Null_Identifier
+         then
+            --  Anonymous constant interface declarations are the only nodes
+            --  that can be shared.  Handle that very special case.
+            return;
+         end if;
+
+         --  pragma Assert (Get_Instance (N) = Null_Iir);
+         Set_Instance (N, Inst);
+
+         for I in Fields'Range loop
+            F := Fields (I);
+
+            case Get_Field_Type (F) is
+               when Type_Iir =>
+                  declare
+                     S : constant Iir := Get_Iir (N, F);
+                     S_Inst : constant Iir := Get_Iir (Inst, F);
+                  begin
+                     case Get_Field_Attribute (F) is
+                        when Attr_None =>
+                           Set_Instance_On_Iir (S, S_Inst);
+                        when Attr_Ref =>
+                           null;
+                        when Attr_Maybe_Ref =>
+                           if not Get_Is_Ref (N) then
+                              Set_Instance_On_Iir (S, S_Inst);
+                           end if;
+                        when Attr_Chain =>
+                           Set_Instance_On_Chain (S, S_Inst);
+                        when Attr_Chain_Next =>
+                           null;
+                        when Attr_Of_Ref =>
+                           --  Can only appear in list.
+                           raise Internal_Error;
+                     end case;
+                  end;
+               when Type_Iir_List =>
+                  declare
+                     S : constant Iir_List := Get_Iir_List (N, F);
+                     S_Inst : constant Iir_List := Get_Iir_List (Inst, F);
+                  begin
+                     case Get_Field_Attribute (F) is
+                        when Attr_None =>
+                           Set_Instance_On_Iir_List (S, S_Inst);
+                        when Attr_Of_Ref
+                          | Attr_Ref =>
+                           null;
+                        when others =>
+                           --  Ref is specially handled in Instantiate_Iir.
+                           --  Others cannot appear for lists.
+                           raise Internal_Error;
+                     end case;
+                  end;
+               when others =>
+                  null;
+            end case;
+         end loop;
+      end;
+   end Set_Instance_On_Iir;
+
+   procedure Set_Instance_On_Iir_List (N : Iir_List; Inst : Iir_List)
+   is
+      El : Iir;
+      El_Inst : Iir;
+   begin
+      case N is
+         when Null_Iir_List
+           | Iir_List_All
+           | Iir_List_Others =>
+            pragma Assert (Inst = N);
+            return;
+         when others =>
+            for I in Natural loop
+               El := Get_Nth_Element (N, I);
+               El_Inst := Get_Nth_Element (Inst, I);
+               exit when El = Null_Iir;
+               pragma Assert (El_Inst /= Null_Iir);
+
+               Set_Instance_On_Iir (El, El_Inst);
+            end loop;
+            pragma Assert (El_Inst = Null_Iir);
+      end case;
+   end Set_Instance_On_Iir_List;
+
+   procedure Set_Instance_On_Chain (Chain : Iir; Inst_Chain : Iir)
+   is
+      El : Iir;
+      Inst_El : Iir;
+   begin
+      El := Chain;
+      Inst_El := Inst_Chain;
+      while El /= Null_Iir loop
+         pragma Assert (Inst_El /= Null_Iir);
+         Set_Instance_On_Iir (El, Inst_El);
+         El := Get_Chain (El);
+         Inst_El := Get_Chain (Inst_El);
+      end loop;
+      pragma Assert (Inst_El = Null_Iir);
+   end Set_Instance_On_Chain;
+
+   --  In the instance, replace references (and inner references) to interface
+   --  package declaration to the associated package.
+   procedure Instantiate_Generic_Map_Chain (Inst : Iir; Pkg : Iir)
+   is
+      pragma Unreferenced (Pkg);
+      Assoc : Iir;
+   begin
+      Assoc := Get_Generic_Map_Aspect_Chain (Inst);
+      while Assoc /= Null_Iir loop
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_By_Expression
+              | Iir_Kind_Association_Element_By_Individual
+              | Iir_Kind_Association_Element_Open =>
+               null;
+            when Iir_Kind_Association_Element_Package =>
+               declare
+                  Sub_Inst : constant Iir :=
+                    Get_Named_Entity (Get_Actual (Assoc));
+                  Sub_Pkg : constant Iir := Get_Associated_Interface (Assoc);
+               begin
+                  Set_Instance (Sub_Pkg, Sub_Inst);
+                  Set_Instance_On_Chain (Get_Generic_Chain (Sub_Pkg),
+                                         Get_Generic_Chain (Sub_Inst));
+                  Set_Instance_On_Chain (Get_Declaration_Chain (Sub_Pkg),
+                                        Get_Declaration_Chain (Sub_Inst));
+               end;
+            when others =>
+               Error_Kind ("instantiate_generic_map_chain", Assoc);
+         end case;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Instantiate_Generic_Map_Chain;
+
+   procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir)
+   is
+      Header : constant Iir := Get_Package_Header (Pkg);
+      Prev_Loc : constant Location_Type := Instantiate_Loc;
+      Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
+   begin
+      Instantiate_Loc := Get_Location (Inst);
+
+      --  Be sure Get_Origin_Priv can be called on existing nodes.
+      Expand_Origin_Table;
+
+      --  For Parent: the instance of PKG is INST.
+      Set_Origin (Pkg, Inst);
+
+      Set_Generic_Chain
+        (Inst, Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Header)));
+      Instantiate_Generic_Map_Chain (Inst, Pkg);
+      Set_Declaration_Chain
+        (Inst, Instantiate_Iir_Chain (Get_Declaration_Chain (Pkg)));
+
+      Set_Origin (Pkg, Null_Iir);
+
+      Instantiate_Loc := Prev_Loc;
+      Restore_Origin (Mark);
+   end Instantiate_Package_Declaration;
+end Sem_Inst;
diff --git a/src/sem_inst.ads b/src/sem_inst.ads
new file mode 100644
index 000000000..da8cd5d27
--- /dev/null
+++ b/src/sem_inst.ads
@@ -0,0 +1,26 @@
+--  Package (and subprograms) instantiations
+
+--  When a package is instantiated, we need to 'duplicate' its declaration.
+--  This looks useless for analysis but it isn't: a type from a package
+--  instantiated twice declares two different types.  Without duplication, we
+--  need to attach to each declaration its instance, which looks more expansive
+--  that duplicating the declaration.
+--
+--  Furthermore, for generic type interface, it looks a good idea to duplicate
+--  the body (macro expansion).
+--
+--  Duplicating is not trivial: internal links must be kept and external
+--  links preserved.  A table is used to map nodes from the uninstantiated
+--  package to its duplicated node.  Links from instantiated declaration to
+--  the original declaration are also stored in that table.
+
+with Iirs; use Iirs;
+
+package Sem_Inst is
+   --  Return the origin of node N, the node from which N was instantiated.
+   --  If N is not an instance, this function returns Null_Iir.
+   function Get_Origin (N : Iir) return Iir;
+
+   --  Create declaration chain and generic declarations for INST from PKG.
+   procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir);
+end Sem_Inst;
diff --git a/src/sem_names.adb b/src/sem_names.adb
new file mode 100644
index 000000000..151e81708
--- /dev/null
+++ b/src/sem_names.adb
@@ -0,0 +1,3788 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Evaluation; use Evaluation;
+with Iirs_Utils; use Iirs_Utils;
+with Libraries;
+with Errorout; use Errorout;
+with Flags; use Flags;
+with Name_Table;
+with Std_Package; use Std_Package;
+with Types; use Types;
+with Iir_Chains; use Iir_Chains;
+with Std_Names;
+with Sem;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Expr; use Sem_Expr;
+with Sem_Stmts; use Sem_Stmts;
+with Sem_Decls; use Sem_Decls;
+with Sem_Assocs; use Sem_Assocs;
+with Sem_Types;
+with Sem_Psl;
+with Xrefs; use Xrefs;
+
+package body Sem_Names is
+   --  Finish the semantization of NAME using RES as named entity.
+   --  This is called when the semantization is finished and an uniq
+   --  interpretation has been determined (RES).
+   --
+   --  Error messages are emitted here.
+   function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir;
+
+   procedure Error_Overload (Expr: Iir) is
+   begin
+      Error_Msg_Sem ("can't resolve overload for " & Disp_Node (Expr), Expr);
+   end Error_Overload;
+
+   procedure Disp_Overload_List (List : Iir_List; Loc : Iir)
+   is
+      El : Iir;
+   begin
+      Error_Msg_Sem ("possible interpretations are:", Loc);
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Error_Msg_Sem (Disp_Subprg (El), El);
+            when Iir_Kind_Function_Call =>
+               El := Get_Implementation (El);
+               Error_Msg_Sem (Disp_Subprg (El), El);
+            when others =>
+               Error_Msg_Sem (Disp_Node (El), El);
+         end case;
+      end loop;
+   end Disp_Overload_List;
+
+   -- Create an overload list.
+   -- must be destroyed with free_iir.
+   function Get_Overload_List return Iir_Overload_List
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Overload_List);
+      return Res;
+   end Get_Overload_List;
+
+   function Create_Overload_List (List : Iir_List) return Iir_Overload_List
+   is
+      Res : Iir_Overload_List;
+   begin
+      Res := Get_Overload_List;
+      Set_Overload_List (Res, List);
+      return Res;
+   end Create_Overload_List;
+
+   procedure Free_Overload_List (N : in out Iir_Overload_List)
+   is
+      List : Iir_List;
+   begin
+      List := Get_Overload_List (N);
+      Destroy_Iir_List (List);
+      Free_Iir (N);
+      N := Null_Iir;
+   end Free_Overload_List;
+
+   function Simplify_Overload_List (List : Iir_List) return Iir
+   is
+      Res : Iir;
+      L1 : Iir_List;
+   begin
+      case Get_Nbr_Elements (List) is
+         when 0 =>
+            L1 := List;
+            Destroy_Iir_List (L1);
+            return Null_Iir;
+         when 1 =>
+            L1 := List;
+            Res := Get_First_Element (List);
+            Destroy_Iir_List (L1);
+            return Res;
+         when others =>
+            return Create_Overload_List (List);
+      end case;
+   end Simplify_Overload_List;
+
+   -- Return true if AN_IIR is an overload list.
+   function Is_Overload_List (An_Iir: Iir) return Boolean is
+   begin
+      return Get_Kind (An_Iir) = Iir_Kind_Overload_List;
+   end Is_Overload_List;
+
+   --  From the list LIST of function or enumeration literal, extract the
+   --  list of (return) types.
+   --  If there is only one type, return it.
+   --  If there is no types, return NULL.
+   --  Otherwise, return the list as an overload list.
+   function Create_List_Of_Types (List : Iir_List)
+     return Iir
+   is
+      Res_List : Iir_List;
+      Decl : Iir;
+   begin
+      --  Create the list of possible return types.
+      Res_List := Create_Iir_List;
+      for I in Natural loop
+         Decl := Get_Nth_Element (List, I);
+         exit when Decl = Null_Iir;
+         case Get_Kind (Decl) is
+            when Iir_Kinds_Function_Declaration =>
+               Add_Element (Res_List, Get_Return_Type (Decl));
+            when Iir_Kind_Enumeration_Literal
+              | Iir_Kind_Function_Call
+              | Iir_Kind_Indexed_Name
+              | Iir_Kind_Selected_Element =>
+               Add_Element (Res_List, Get_Type (Decl));
+            when others =>
+               Error_Kind ("create_list_of_types", Decl);
+         end case;
+      end loop;
+      return Simplify_Overload_List (Res_List);
+   end Create_List_Of_Types;
+
+   procedure Add_Result (Res : in out Iir; Decl : Iir)
+   is
+      Nres : Iir;
+      Nres_List : Iir_List;
+   begin
+      if Decl = Null_Iir then
+         return;
+      end if;
+      if Res = Null_Iir then
+         Res := Decl;
+      elsif Is_Overload_List (Res) then
+         Append_Element (Get_Overload_List (Res), Decl);
+      else
+         Nres_List := Create_Iir_List;
+         Nres := Create_Overload_List (Nres_List);
+         Append_Element (Nres_List, Res);
+         Append_Element (Nres_List, Decl);
+         Res := Nres;
+      end if;
+   end Add_Result;
+
+   --  Move elements of result list LIST to result list RES.
+   --  Destroy LIST if necessary.
+   procedure Add_Result_List (Res : in out Iir; List : Iir);
+   pragma Unreferenced (Add_Result_List);
+
+   procedure Add_Result_List (Res : in out Iir; List : Iir)
+   is
+      El : Iir;
+      List_List : Iir_List;
+      Res_List : Iir_List;
+   begin
+      if Res = Null_Iir then
+         Res := List;
+      elsif List = Null_Iir then
+         null;
+      elsif not Is_Overload_List (List) then
+         Add_Result (Res, List);
+      else
+         if not Is_Overload_List (Res) then
+            El := Res;
+            Res := Get_Overload_List;
+            Append_Element (Get_Overload_List (Res), El);
+         end if;
+         List_List := Get_Overload_List (List);
+         Res_List := Get_Overload_List (Res);
+         for I in Natural loop
+            El := Get_Nth_Element (List_List, I);
+            exit when El = Null_Iir;
+            Append_Element (Res_List, El);
+         end loop;
+         Free_Iir (List);
+      end if;
+   end Add_Result_List;
+
+   --  Free interpretations of LIST except KEEP.
+   procedure Sem_Name_Free_Result (List : Iir; Keep : Iir)
+   is
+      procedure Sem_Name_Free (El : Iir) is
+      begin
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Call
+              | Iir_Kind_Indexed_Name
+              | Iir_Kind_Selected_Element =>
+               Sem_Name_Free (Get_Prefix (El));
+               Free_Iir (El);
+            when Iir_Kind_Attribute_Name =>
+               Free_Iir (El);
+            when Iir_Kinds_Function_Declaration
+              | Iir_Kinds_Procedure_Declaration
+              | Iir_Kind_Enumeration_Literal =>
+               null;
+            when Iir_Kinds_Denoting_Name =>
+               null;
+            when others =>
+               Error_Kind ("sem_name_free", El);
+         end case;
+      end Sem_Name_Free;
+
+      El : Iir;
+      List_List : Iir_List;
+   begin
+      if List = Null_Iir then
+         return;
+      elsif not Is_Overload_List (List) then
+         if List /= Keep then
+            Sem_Name_Free (List);
+         end if;
+      else
+         List_List := Get_Overload_List (List);
+         for I in Natural loop
+            El := Get_Nth_Element (List_List, I);
+            exit when El = Null_Iir;
+            if El /= Keep then
+               Sem_Name_Free (El);
+            end if;
+         end loop;
+         Free_Iir (List);
+      end if;
+   end Sem_Name_Free_Result;
+
+   procedure Free_Parenthesis_Name (Name : Iir; Res : Iir)
+   is
+      Chain, Next_Chain : Iir;
+   begin
+      pragma Assert (Get_Kind (Res) /= Iir_Kind_Function_Call);
+      Chain := Get_Association_Chain (Name);
+      while Chain /= Null_Iir loop
+         Next_Chain := Get_Chain (Chain);
+         Free_Iir (Chain);
+         Chain := Next_Chain;
+      end loop;
+      Free_Iir (Name);
+   end Free_Parenthesis_Name;
+
+   --  Find all named declaration whose identifier is ID in DECL_LIST and
+   --  return it.
+   --  The result can be NULL (if no such declaration exist),
+   --  a declaration, or an overload_list containing all declarations.
+   function Find_Declarations_In_List
+     (Decl: Iir; Name : Iir_Selected_Name; Keep_Alias : Boolean)
+     return Iir
+   is
+      Res: Iir := Null_Iir;
+
+      --  If indentifier of DECL is ID, then add DECL in the result.
+      procedure Handle_Decl (Decl : Iir; Id : Name_Id) is
+      begin
+         --  Use_clauses may appear in a declaration list.
+         case Get_Kind (Decl) is
+            when Iir_Kind_Use_Clause
+              | Iir_Kind_Anonymous_Type_Declaration =>
+               return;
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               if Get_Identifier (Decl) = Id then
+                  if Keep_Alias then
+                     Add_Result (Res, Decl);
+                  else
+                     Add_Result (Res, Get_Named_Entity (Get_Name (Decl)));
+                  end if;
+               end if;
+            when others =>
+               if Get_Identifier (Decl) = Id then
+                  Add_Result (Res, Decl);
+               end if;
+         end case;
+      end Handle_Decl;
+
+      procedure Iterator_Decl is new Sem_Scopes.Iterator_Decl
+        (Arg_Type => Name_Id, Handle_Decl => Handle_Decl);
+      --procedure Iterator_Decl_List is new Sem_Scopes.Iterator_Decl_List
+      --  (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl);
+      procedure Iterator_Decl_Chain is new Sem_Scopes.Iterator_Decl_Chain
+        (Arg_Type => Name_Id, Handle_Decl => Iterator_Decl);
+
+      Id : Name_Id;
+      Decl_Body : Iir;
+   begin
+      Id := Get_Identifier (Name);
+      case Get_Kind (Decl) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            Iterator_Decl_Chain (Get_Interface_Declaration_Chain (Decl), Id);
+         when Iir_Kind_Entity_Declaration =>
+            Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id);
+            Iterator_Decl_Chain (Get_Port_Chain (Decl), Id);
+         when Iir_Kind_Architecture_Body =>
+            null;
+         when Iir_Kind_Generate_Statement =>
+            null;
+         when Iir_Kind_Package_Declaration =>
+            null;
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id);
+         when Iir_Kind_Block_Statement =>
+            declare
+               Header : constant Iir := Get_Block_Header (Decl);
+            begin
+               if Header /= Null_Iir then
+                  Iterator_Decl_Chain (Get_Generic_Chain (Header), Id);
+                  Iterator_Decl_Chain (Get_Port_Chain (Header), Id);
+               end if;
+            end;
+         when Iir_Kind_For_Loop_Statement =>
+            Handle_Decl (Get_Parameter_Specification (Decl), Id);
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement =>
+            null;
+         when others =>
+            Error_Kind ("find_declarations_in_list", Decl);
+      end case;
+
+      case Get_Kind (Decl) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            Decl_Body := Get_Subprogram_Body (Decl);
+            Iterator_Decl_Chain
+              (Get_Declaration_Chain (Decl_Body), Id);
+            Iterator_Decl_Chain
+              (Get_Sequential_Statement_Chain (Decl_Body), Id);
+         when Iir_Kind_Architecture_Body
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Block_Statement =>
+            Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
+            Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id);
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration =>
+            Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement =>
+            Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
+            Iterator_Decl_Chain (Get_Sequential_Statement_Chain (Decl), Id);
+         when Iir_Kind_For_Loop_Statement =>
+            null;
+         when others =>
+            Error_Kind ("find_declarations_in_list", Decl);
+      end case;
+      --if Res = Null_Iir then
+      --   Error_Msg_Sem ("""" & Name_Table.Image (Id) & """ not defined in "
+      --                  & Disp_Node (Decl), Name);
+      --end if;
+      return Res;
+   end Find_Declarations_In_List;
+
+   --  Create an implicit_dereference node if PREFIX is of type access.
+   --  Return PREFIX otherwise.
+   --  PARENT is used if an implicit dereference node is created, to copy
+   --  location from.
+   function Insert_Implicit_Dereference (Prefix : Iir; Parent : Iir)
+     return Iir
+   is
+      Prefix_Type : Iir;
+      Res : Iir_Implicit_Dereference;
+   begin
+      Prefix_Type := Get_Type (Prefix);
+
+      case Get_Kind (Prefix_Type) is
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            null;
+         when others =>
+            return Prefix;
+      end case;
+      Check_Read (Prefix);
+      Res := Create_Iir (Iir_Kind_Implicit_Dereference);
+      Location_Copy (Res, Parent);
+      Set_Type (Res, Get_Designated_Type (Prefix_Type));
+      Set_Prefix (Res, Prefix);
+      Set_Base_Name (Res, Res);
+      Set_Expr_Staticness (Res, None);
+      return Res;
+   end Insert_Implicit_Dereference;
+
+   --  If PREFIX is a function specification that cannot be converted to a
+   --  function call (because of lack of association), return FALSE.
+   function Maybe_Function_Call (Prefix : Iir) return Boolean
+   is
+      Inter : Iir;
+   begin
+      if Get_Kind (Prefix) not in Iir_Kinds_Function_Declaration then
+         return True;
+      end if;
+      Inter := Get_Interface_Declaration_Chain (Prefix);
+      while Inter /= Null_Iir loop
+         if Get_Default_Value (Inter) = Null_Iir then
+            return False;
+         end if;
+         Inter := Get_Chain (Inter);
+      end loop;
+      return True;
+   end Maybe_Function_Call;
+
+   procedure Name_To_Method_Object (Call : Iir; Name : Iir)
+   is
+      Prefix : Iir;
+      Obj : Iir;
+   begin
+      if Get_Kind (Name) /= Iir_Kind_Selected_Name then
+         return;
+      end if;
+
+      Prefix := Get_Prefix (Name);
+      Obj := Get_Named_Entity (Prefix);
+      if Obj /= Null_Iir
+        and then Kind_In (Obj, Iir_Kind_Variable_Declaration,
+                          Iir_Kind_Interface_Variable_Declaration)
+        and then Get_Type (Obj) /= Null_Iir
+      then
+         if Get_Kind (Get_Type (Obj)) /= Iir_Kind_Protected_Type_Declaration
+         then
+            Error_Msg_Sem ("type of the prefix should be a protected type",
+                           Prefix);
+            return;
+         end if;
+         Set_Method_Object (Call, Obj);
+      end if;
+   end Name_To_Method_Object;
+
+   --  NAME is the name of the function (and not the parenthesis name)
+   function Sem_As_Function_Call (Name : Iir; Spec : Iir; Assoc_Chain : Iir)
+                                 return Iir_Function_Call
+   is
+      Call : Iir_Function_Call;
+   begin
+      --  Check.
+      pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name);
+
+      Call := Create_Iir (Iir_Kind_Function_Call);
+      Location_Copy (Call, Name);
+      if Get_Kind (Name) = Iir_Kind_Parenthesis_Name then
+         Set_Prefix (Call, Get_Prefix (Name));
+      else
+         Set_Prefix (Call, Name);
+      end if;
+      Name_To_Method_Object (Call, Name);
+      Set_Implementation (Call, Spec);
+      Set_Parameter_Association_Chain (Call, Assoc_Chain);
+      Set_Type (Call, Get_Return_Type (Spec));
+      Set_Base_Name (Call, Call);
+      return Call;
+   end Sem_As_Function_Call;
+
+   --  If SPEC is a function specification, then return a function call,
+   --  else return SPEC.
+   function Maybe_Insert_Function_Call (Name : Iir; Spec : Iir) return Iir
+   is
+   begin
+      if Get_Kind (Spec) in Iir_Kinds_Function_Declaration then
+         return Sem_As_Function_Call (Name, Spec, Null_Iir);
+      else
+         return Spec;
+      end if;
+   end Maybe_Insert_Function_Call;
+
+   --  If PTR_TYPE is not NULL_IIR, then return an implciti dereference to
+   --  PREFIX, else return PREFIX.
+   function Maybe_Insert_Dereference (Prefix : Iir; Ptr_Type : Iir) return Iir
+   is
+      Id : Iir;
+   begin
+      if Ptr_Type /= Null_Iir then
+         Id := Create_Iir (Iir_Kind_Implicit_Dereference);
+         Location_Copy (Id, Prefix);
+         Set_Type (Id, Get_Designated_Type (Ptr_Type));
+         Set_Prefix (Id, Prefix);
+         Set_Base_Name (Id, Id);
+         return Id;
+      else
+         return Prefix;
+      end if;
+   end Maybe_Insert_Dereference;
+
+   procedure Finish_Sem_Indexed_Name (Expr : Iir)
+   is
+      Prefix : constant Iir := Get_Prefix (Expr);
+      Prefix_Type : constant Iir := Get_Type (Prefix);
+      Index_List : constant Iir_List := Get_Index_List (Expr);
+      Index_Subtype : Iir;
+      Index : Iir;
+      Expr_Staticness : Iir_Staticness;
+   begin
+      Expr_Staticness := Locally;
+
+      -- LRM93 §6.4: there must be one such expression for each index
+      -- position of the array and each expression must be of the
+      -- type of the corresponding index.
+      -- Loop on the indexes.
+      for I in Natural loop
+         Index_Subtype := Get_Index_Type (Prefix_Type, I);
+         exit when Index_Subtype = Null_Iir;
+         Index := Get_Nth_Element (Index_List, I);
+         -- The index_subtype can be an unconstrained index type.
+         Index := Check_Is_Expression (Index, Index);
+         if Index /= Null_Iir then
+            Index := Sem_Expression (Index, Get_Base_Type (Index_Subtype));
+         end if;
+         if Index /= Null_Iir then
+            if Get_Expr_Staticness (Index) = Locally
+              and then Get_Type_Staticness (Index_Subtype) = Locally
+            then
+               Index := Eval_Expr_Check (Index, Index_Subtype);
+            end if;
+            Replace_Nth_Element (Get_Index_List (Expr), I, Index);
+            Expr_Staticness := Min (Expr_Staticness,
+                                    Get_Expr_Staticness (Index));
+         else
+            Expr_Staticness := None;
+         end if;
+      end loop;
+
+      Set_Type (Expr, Get_Element_Subtype (Prefix_Type));
+
+      --  An indexed name cannot be locally static.
+      Set_Expr_Staticness
+        (Expr, Min (Globally, Min (Expr_Staticness,
+                                   Get_Expr_Staticness (Prefix))));
+
+      -- LRM93 §6.1:
+      -- a name is said to be a static name iff:
+      -- The name is an indexed name whose prefix is a static name
+      -- and every expression that appears as part of the name is a
+      -- static expression.
+      --
+      -- a name is said to be a locally static name iif:
+      -- The name is an indexed name whose prefix is a locally
+      -- static name and every expression that appears as part
+      -- of the name is a locally static expression.
+      Set_Name_Staticness (Expr, Min (Expr_Staticness,
+                                      Get_Name_Staticness (Prefix)));
+
+      Set_Base_Name (Expr, Get_Base_Name (Prefix));
+   end Finish_Sem_Indexed_Name;
+
+   procedure Finish_Sem_Dereference (Res : Iir)
+   is
+   begin
+      Set_Base_Name (Res, Res);
+      Check_Read (Get_Prefix (Res));
+      Set_Expr_Staticness (Res, None);
+      Set_Name_Staticness (Res, None);
+   end Finish_Sem_Dereference;
+
+   procedure Finish_Sem_Slice_Name (Name : Iir_Slice_Name)
+   is
+      -- The prefix of the slice
+      Prefix : constant Iir := Get_Prefix (Name);
+      Prefix_Type : constant Iir := Get_Type (Prefix);
+      Prefix_Base_Type : Iir;
+      Prefix_Bt : constant Iir := Get_Base_Type (Prefix_Type);
+      Index_List: Iir_List;
+      Index_Type: Iir;
+      Suffix: Iir;
+      Slice_Type : Iir;
+      Expr_Type : Iir;
+      Staticness : Iir_Staticness;
+      Prefix_Rng : Iir;
+   begin
+      Set_Base_Name (Name, Get_Base_Name (Prefix));
+
+      --  LRM93 §6.5: the prefix of an indexed name must be appropriate
+      --  for an array type.
+      if Get_Kind (Prefix_Bt) /= Iir_Kind_Array_Type_Definition then
+         Error_Msg_Sem ("slice can only be applied to an array", Name);
+         return;
+      end if;
+
+      -- LRM93 §6.5:
+      -- The prefix of a slice must be appropriate for a
+      -- one-dimensionnal array object.
+      Index_List := Get_Index_Subtype_List (Prefix_Type);
+      if Get_Nbr_Elements (Index_List) /= 1 then
+         Error_Msg_Sem ("slice prefix must be an unidimensional array", Name);
+         return;
+      end if;
+
+      Index_Type := Get_Index_Type (Index_List, 0);
+      Prefix_Rng := Eval_Static_Range (Index_Type);
+
+      --  LRM93 6.5
+      --  It is an error if either the bounds of the discrete range does not
+      --  belong to the index range of the prefixing array, *unless* the slice
+      --  is a null slice.
+      --
+      --  LRM93 6.5
+      --  The slice is a null slice if the discrete range is a null range.
+
+      -- LRM93 §6.5:
+      -- The bounds of the discrete range [...] must be of the
+      -- type of the index of the array.
+      Suffix := Sem_Discrete_Range_Expression
+        (Get_Suffix (Name), Index_Type, False);
+      if Suffix = Null_Iir then
+         return;
+      end if;
+      Suffix := Eval_Range_If_Static (Suffix);
+      Set_Suffix (Name, Suffix);
+
+      -- LRM93 §6.5:
+      -- It is an error if the direction of the discrete range is not
+      -- the same as that of the index range of the array denoted
+      -- by the prefix of the slice name.
+
+      -- Check this only if the type is a constrained type.
+      if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition
+        and then Get_Index_Constraint_Flag (Prefix_Type)
+        and then Get_Expr_Staticness (Suffix) = Locally
+        and then Prefix_Rng /= Null_Iir
+        and then Get_Direction (Suffix) /= Get_Direction (Prefix_Rng)
+      then
+         if False and then Flags.Vhdl_Std = Vhdl_87 then
+            -- emit a warning for a null slice.
+            Warning_Msg_Sem
+              ("direction mismatch results in a null slice", Name);
+         end if;
+         Error_Msg_Sem ("direction of the range mismatch", Name);
+      end if;
+
+      --  LRM93 §7.4.1
+      --  A slice is never a locally static expression.
+      case Get_Kind (Suffix) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Suffix := Get_Type (Suffix);
+            Staticness := Get_Type_Staticness (Suffix);
+         when Iir_Kind_Range_Expression
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            Staticness := Get_Expr_Staticness (Suffix);
+         when others =>
+            Error_Kind ("finish_sem_slice_name", Suffix);
+      end case;
+      Set_Expr_Staticness
+        (Name, Min (Min (Staticness, Get_Expr_Staticness (Prefix)), Globally));
+      Set_Name_Staticness
+        (Name, Min (Staticness, Get_Name_Staticness (Prefix)));
+
+      --  The type of the slice is a subtype of the base type whose
+      --  range contraint is the slice itself.
+      if Get_Kind (Suffix) in Iir_Kinds_Discrete_Type_Definition then
+         Slice_Type := Suffix;
+      else
+         case Get_Kind (Get_Base_Type (Index_Type)) is
+            when Iir_Kind_Integer_Type_Definition =>
+               Slice_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+            when Iir_Kind_Enumeration_Type_Definition =>
+               Slice_Type :=
+                 Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+            when others =>
+               Error_Kind ("sem_expr: slice_name", Get_Base_Type (Index_Type));
+         end case;
+         Set_Range_Constraint (Slice_Type, Suffix);
+         Set_Type_Staticness (Slice_Type, Staticness);
+         Set_Base_Type (Slice_Type, Get_Base_Type (Index_Type));
+         Set_Location (Slice_Type, Get_Location (Suffix));
+      end if;
+
+      Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      Set_Location (Expr_Type, Get_Location (Suffix));
+      Set_Index_Subtype_List (Expr_Type, Create_Iir_List);
+      Prefix_Base_Type := Get_Base_Type (Prefix_Type);
+      Set_Base_Type (Expr_Type, Prefix_Base_Type);
+      Set_Signal_Type_Flag (Expr_Type,
+                            Get_Signal_Type_Flag (Prefix_Base_Type));
+      Append_Element (Get_Index_Subtype_List (Expr_Type), Slice_Type);
+      Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type));
+      if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then
+         Set_Resolution_Indication
+           (Expr_Type, Get_Resolution_Indication (Prefix_Type));
+      else
+         Set_Resolution_Indication (Expr_Type, Null_Iir);
+      end if;
+      Set_Type_Staticness
+        (Expr_Type, Min (Get_Type_Staticness (Prefix_Type),
+                         Get_Type_Staticness (Slice_Type)));
+      Set_Type (Name, Expr_Type);
+      Set_Slice_Subtype (Name, Expr_Type);
+      Set_Index_Constraint_Flag (Expr_Type, True);
+      Set_Constraint_State (Expr_Type, Fully_Constrained);
+      if Is_Signal_Object (Prefix) then
+         Sem_Types.Set_Type_Has_Signal (Expr_Type);
+      end if;
+   end Finish_Sem_Slice_Name;
+
+   --  PREFIX is the name denoting the function declaration, and its analysis
+   --  is already finished.
+   procedure Finish_Sem_Function_Call (Call : Iir; Prefix : Iir)
+   is
+      Rtype : Iir;
+   begin
+      Set_Prefix (Call, Prefix);
+      Set_Implementation (Call, Get_Named_Entity (Prefix));
+
+      --  LRM08 8.1 Names
+      --  The name is a simple name or seleted name that does NOT denote a
+      --  function call [...]
+      --
+      --  GHDL: so function calls are never static names.
+      Set_Name_Staticness (Call, None);
+
+      --  FIXME: modify sem_subprogram_call to avoid such a type swap.
+      Rtype := Get_Type (Call);
+      Set_Type (Call, Null_Iir);
+      if Sem_Subprogram_Call (Call, Null_Iir) = Null_Iir then
+         Set_Type (Call, Rtype);
+      end if;
+   end Finish_Sem_Function_Call;
+
+   function Sem_Type_Mark (Name : Iir; Incomplete : Boolean := False)
+                          return Iir
+   is
+      Atype : Iir;
+      Res : Iir;
+   begin
+      --  The name must not have been analyzed.
+      pragma Assert (Get_Type (Name) = Null_Iir);
+
+      --  Analyze the name (if not already done).
+      if Get_Named_Entity (Name) = Null_Iir then
+         Sem_Name (Name);
+      end if;
+      Res := Finish_Sem_Name (Name);
+
+      if Get_Kind (Res) in Iir_Kinds_Denoting_Name then
+         --  Common correct case.
+         Atype := Get_Named_Entity (Res);
+         if Get_Kind (Atype) = Iir_Kind_Type_Declaration then
+            Atype := Get_Type_Definition (Atype);
+         elsif Get_Kind (Atype) = Iir_Kind_Subtype_Declaration then
+            Atype := Get_Type (Atype);
+         else
+            Error_Msg_Sem
+              ("a type mark must denote a type or a subtype", Name);
+            Atype := Create_Error_Type (Atype);
+            Set_Named_Entity (Res, Atype);
+         end if;
+      else
+         if Get_Kind (Res) /= Iir_Kind_Error then
+            Error_Msg_Sem
+              ("a type mark must be a simple or expanded name", Name);
+         end if;
+         Res := Name;
+         Atype := Create_Error_Type (Name);
+         Set_Named_Entity (Res, Atype);
+      end if;
+
+      if not Incomplete then
+         if Get_Kind (Atype) = Iir_Kind_Incomplete_Type_Definition then
+            Error_Msg_Sem
+              ("invalid use of an incomplete type definition", Name);
+            Atype := Create_Error_Type (Name);
+            Set_Named_Entity (Res, Atype);
+         end if;
+      end if;
+
+      Set_Type (Res, Atype);
+
+      return Res;
+   end Sem_Type_Mark;
+
+   procedure Finish_Sem_Array_Attribute
+     (Attr_Name : Iir; Attr : Iir; Param : Iir)
+   is
+      Parameter : Iir;
+      Prefix_Type : Iir;
+      Index_Type : Iir;
+      Prefix : Iir;
+      Prefix_Name : Iir;
+      Staticness : Iir_Staticness;
+   begin
+      --  LRM93 14.1
+      --  Parameter: A locally static expression of type universal_integer, the
+      --  value of which must not exceed the dimensionality of A.  If omitted,
+      --  it defaults to 1.
+      if Param = Null_Iir then
+         Parameter := Universal_Integer_One;
+      else
+         Parameter := Sem_Expression
+           (Param, Universal_Integer_Type_Definition);
+         if Parameter = Null_Iir then
+            Parameter := Universal_Integer_One;
+         else
+            if Get_Expr_Staticness (Parameter) /= Locally then
+               Error_Msg_Sem ("parameter must be locally static", Parameter);
+               Parameter := Universal_Integer_One;
+            end if;
+         end if;
+      end if;
+
+      Prefix_Name := Get_Prefix (Attr_Name);
+      if Is_Type_Name (Prefix_Name) /= Null_Iir then
+         Prefix := Sem_Type_Mark (Prefix_Name);
+      else
+         Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr));
+      end if;
+      Set_Prefix (Attr, Prefix);
+
+      Prefix_Type := Get_Type (Prefix);
+      if Is_Error (Prefix_Type) then
+         return;
+      end if;
+
+      declare
+         Dim : Iir_Int64;
+         Indexes_List : constant Iir_List :=
+           Get_Index_Subtype_List (Prefix_Type);
+      begin
+         Dim := Get_Value (Parameter);
+         if Dim < 1 or else Dim > Iir_Int64 (Get_Nbr_Elements (Indexes_List))
+         then
+            Error_Msg_Sem ("parameter value out of bound", Attr);
+            Parameter := Universal_Integer_One;
+            Dim := 1;
+         end if;
+         Index_Type := Get_Index_Type (Indexes_List, Natural (Dim - 1));
+      end;
+
+      case Get_Kind (Attr) is
+         when Iir_Kind_Left_Array_Attribute
+           | Iir_Kind_Right_Array_Attribute
+           | Iir_Kind_High_Array_Attribute
+           | Iir_Kind_Low_Array_Attribute =>
+            Set_Type (Attr, Index_Type);
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            Set_Type (Attr, Index_Type);
+         when Iir_Kind_Length_Array_Attribute =>
+            Set_Type (Attr, Convertible_Integer_Type_Definition);
+         when Iir_Kind_Ascending_Array_Attribute =>
+            Set_Type (Attr, Boolean_Type_Definition);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      pragma Assert (Get_Parameter (Attr) = Null_Iir);
+
+      Set_Parameter (Attr, Parameter);
+
+      --  If the corresponding type is known, save it so that it is not
+      --  necessary to extract it from the object.
+      if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition
+        and then Get_Constraint_State (Prefix_Type) = Fully_Constrained
+      then
+         Set_Index_Subtype (Attr, Index_Type);
+      end if;
+
+      --  LRM 7.4.1
+      --  A locally static range is either [...], or a range of the first form
+      --  whose prefix denotes either a locally static subtype or an object
+      --  that is of a locally static subtype.
+
+      --  LRM 7.4.2
+      --  A globally static range is either [...], or a range of the first form
+      --  whose prefix denotes either a globally static subtype or an object
+      --  that is of a globally static subtype.
+      --
+      --  A globally static subtype is either a globally static scalar subtype,
+      --  a globally static array subtype, [...]
+      --
+      --  A globally static array subtype is a constrained array subtype
+      --  formed by imposing on an unconstrained array type a globally static
+      --  index constraint.
+      Staticness := Get_Type_Staticness (Prefix_Type);
+      if Flags.Vhdl_Std = Vhdl_93c
+        and then Get_Kind (Prefix) not in Iir_Kinds_Type_Declaration
+      then
+         --  For 93c:
+         --  if the prefix is a static expression, the staticness of the
+         --   expression may be higher than the staticness of the type
+         --   (eg: generic whose type is an unconstrained array).
+         --   Also consider expression staticness.
+         Staticness := Iir_Staticness'Max (Staticness,
+                                           Get_Expr_Staticness (Prefix));
+      end if;
+      Set_Expr_Staticness (Attr, Staticness);
+   end Finish_Sem_Array_Attribute;
+
+   procedure Finish_Sem_Scalar_Type_Attribute
+     (Attr_Name : Iir; Attr : Iir; Param : Iir)
+   is
+      Prefix : Iir;
+      Prefix_Type : Iir;
+      Prefix_Bt : Iir;
+      Parameter : Iir;
+      Param_Type : Iir;
+   begin
+      if Param = Null_Iir then
+         Error_Msg_Sem (Disp_Node (Attr) & " requires a parameter", Attr);
+         return;
+      end if;
+
+      Prefix := Get_Prefix (Attr);
+      if Get_Kind (Prefix) = Iir_Kind_Attribute_Name then
+         Prefix := Finish_Sem_Name (Prefix);
+         Set_Prefix (Attr, Prefix);
+         pragma Assert (Get_Kind (Prefix) = Iir_Kind_Base_Attribute);
+      else
+         Prefix := Sem_Type_Mark (Prefix);
+      end if;
+      Set_Prefix (Attr, Prefix);
+      Free_Iir (Attr_Name);
+      Prefix_Type := Get_Type (Prefix);
+      Prefix_Bt := Get_Base_Type (Prefix_Type);
+
+      case Get_Kind (Attr) is
+         when Iir_Kind_Pos_Attribute =>
+            --  LRM93 14.1
+            --  Parameter: An expression whose type is the base type of T.
+            Parameter := Sem_Expression (Param, Prefix_Bt);
+         when Iir_Kind_Val_Attribute =>
+            --  LRM93 14.1
+            --  Parameter: An expression of any integer type.
+            Param_Type := Get_Type (Param);
+            if Is_Overload_List (Param_Type) then
+               Parameter := Sem_Expression
+                 (Param, Universal_Integer_Type_Definition);
+            else
+               if Get_Kind (Get_Base_Type (Param_Type))
+                 /= Iir_Kind_Integer_Type_Definition
+               then
+                  Error_Msg_Sem ("parameter must be an integer", Attr);
+                  return;
+               end if;
+               Parameter := Param;
+            end if;
+         when Iir_Kind_Succ_Attribute
+           | Iir_Kind_Pred_Attribute
+           | Iir_Kind_Leftof_Attribute
+           | Iir_Kind_Rightof_Attribute =>
+            --  LRM93 14.1
+            --  Parameter: An expression whose type is the base type of T.
+            Parameter := Sem_Expression (Param, Prefix_Bt);
+         when Iir_Kind_Image_Attribute =>
+            --  LRM93 14.1
+            --  Parameter: An expression whose type is the base type of T.
+            Parameter := Sem_Expression (Param, Prefix_Bt);
+         when Iir_Kind_Value_Attribute =>
+            --  Parameter: An expression of type string.
+            Parameter := Sem_Expression (Param, String_Type_Definition);
+         when others =>
+            raise Internal_Error;
+      end case;
+      if Get_Parameter (Attr) /= Null_Iir then
+         raise Internal_Error;
+      end if;
+      if Parameter = Null_Iir then
+         Set_Parameter (Attr, Param);
+         Set_Expr_Staticness (Attr, None);
+         return;
+      end if;
+      Set_Parameter (Attr, Parameter);
+      Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type),
+                                      Get_Expr_Staticness (Parameter)));
+      Set_Name_Staticness (Attr, Get_Expr_Staticness (Attr));
+   end Finish_Sem_Scalar_Type_Attribute;
+
+   procedure Finish_Sem_Signal_Attribute
+     (Attr_Name : Iir; Attr : Iir; Parameter : Iir)
+   is
+      Param : Iir;
+      Prefix : Iir;
+      Prefix_Name : Iir;
+   begin
+      Prefix_Name := Get_Prefix (Attr_Name);
+      Prefix := Finish_Sem_Name (Prefix_Name, Get_Prefix (Attr));
+      Set_Prefix (Attr, Prefix);
+      Free_Iir (Attr_Name);
+
+      if Parameter = Null_Iir then
+         return;
+      end if;
+      if Get_Kind (Attr) = Iir_Kind_Transaction_Attribute then
+         Error_Msg_Sem ("'transaction does not allow a parameter", Attr);
+      else
+         Param := Sem_Expression (Parameter, Time_Subtype_Definition);
+         if Param /= Null_Iir then
+            --  LRM93 14.1
+            --  Parameter: A static expression of type TIME [that evaluate
+            --  to a nonnegative value.]
+            if Get_Expr_Staticness (Param) = None then
+               Error_Msg_Sem
+                 ("parameter of signal attribute must be static", Param);
+            end if;
+            Set_Parameter (Attr, Param);
+         end if;
+      end if;
+   end Finish_Sem_Signal_Attribute;
+
+   function Is_Type_Abstract_Numeric (Atype : Iir) return Boolean is
+   begin
+      case Get_Kind (Atype) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Floating_Type_Definition =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Type_Abstract_Numeric;
+
+   function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean
+   is
+      Base_Type1 : constant Iir := Get_Base_Type (Type1);
+      Base_Type2 : constant Iir := Get_Base_Type (Type2);
+      Ant1, Ant2 : Boolean;
+      Index_List1, Index_List2 : Iir_List;
+      El1, El2 : Iir;
+   begin
+      --  LRM 7.3.5
+      --  In particular, a type is closely related to itself.
+      if Base_Type1 = Base_Type2 then
+         return True;
+      end if;
+
+      --  LRM 7.3.5
+      --  a) Abstract Numeric Types: Any abstract numeric type is closely
+      --     related to any other abstract numeric type.
+      Ant1 := Is_Type_Abstract_Numeric (Type1);
+      Ant2 := Is_Type_Abstract_Numeric (Type2);
+      if Ant1 and Ant2 then
+         return True;
+      end if;
+      if Ant1 or Ant2 then
+         return False;
+      end if;
+
+      --  LRM 7.3.5
+      --  b) Array Types: Two array types are closely related if and only if
+      --     The types have the same dimensionality; For each index position,
+      --     the index types are either the same or are closely related; and
+      --     The element types are the same.
+      --
+      --  No other types are closely related.
+      if not (Get_Kind (Base_Type1) = Iir_Kind_Array_Type_Definition
+              and then Get_Kind (Base_Type2) = Iir_Kind_Array_Type_Definition)
+      then
+         return False;
+      end if;
+      Index_List1 := Get_Index_Subtype_List (Base_Type1);
+      Index_List2 := Get_Index_Subtype_List (Base_Type2);
+      if Get_Nbr_Elements (Index_List1) /= Get_Nbr_Elements (Index_List2) then
+         return False;
+      end if;
+      if Get_Base_Type (Get_Element_Subtype (Base_Type1))
+        /= Get_Base_Type (Get_Element_Subtype (Base_Type2))
+      then
+         return False;
+      end if;
+      for I in Natural loop
+         El1 := Get_Index_Type (Index_List1, I);
+         exit when El1 = Null_Iir;
+         El2 := Get_Index_Type (Index_List2, I);
+         if not Are_Types_Closely_Related (El1, El2) then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Are_Types_Closely_Related;
+
+   function Sem_Type_Conversion (Loc : Iir; Type_Mark : Iir; Actual : Iir)
+                                return Iir
+   is
+      Conv_Type : constant Iir := Get_Type (Type_Mark);
+      Conv: Iir_Type_Conversion;
+      Expr: Iir;
+      Staticness : Iir_Staticness;
+   begin
+      Conv := Create_Iir (Iir_Kind_Type_Conversion);
+      Location_Copy (Conv, Loc);
+      Set_Type_Mark (Conv, Type_Mark);
+      Set_Type (Conv, Conv_Type);
+      Set_Expression (Conv, Actual);
+
+      --  Default staticness in case of error.
+      Set_Expr_Staticness (Conv, None);
+
+      --  Bail out if no actual (or invalid one).
+      if Actual = Null_Iir then
+         return Conv;
+      end if;
+
+      -- LRM93 7.3.5
+      -- Furthermore, the operand of a type conversion is not allowed to be
+      -- the literal null, an allocator, an aggregate, or a string literal.
+      case Get_Kind (Actual) is
+         when Iir_Kind_Null_Literal
+           | Iir_Kind_Aggregate
+           | Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            Error_Msg_Sem
+              (Disp_Node (Actual) & " cannot be a type conversion operand",
+               Actual);
+            return Conv;
+         when others =>
+            -- LRM93 7.3.5
+            -- The type of the operand of a type conversion must be
+            -- determinable independent of the context (in particular,
+            -- independent of the target type).
+            Expr := Sem_Expression_Universal (Actual);
+            if Expr = Null_Iir then
+               return Conv;
+            end if;
+            if Get_Kind (Expr) in Iir_Kinds_Allocator then
+               Error_Msg_Sem
+                 (Disp_Node (Expr) & " cannot be a type conversion operand",
+                  Expr);
+            end if;
+            Set_Expression (Conv, Expr);
+      end case;
+
+      --  LRM93 7.4.1 Locally Static Primaries.
+      --  9. a type conversion whose expression is a locally static expression.
+      --  LRM93 7.4.2 Globally Static Primaries.
+      --  14. a type conversion whose expression is a globally static
+      --      expression.
+      if Expr /= Null_Iir then
+         Staticness := Get_Expr_Staticness (Expr);
+
+         --  If the type mark is not locally static, the expression cannot
+         --  be locally static.  This was clarified in VHDL 08, but a type
+         --  mark that denotes an unconstrained array type, does not prevent
+         --  the expression from being static.
+         if Get_Kind (Conv_Type) not in Iir_Kinds_Array_Type_Definition
+           or else Get_Constraint_State (Conv_Type) = Fully_Constrained
+         then
+            Staticness := Min (Staticness, Get_Type_Staticness (Conv_Type));
+         end if;
+
+         --  LRM87 7.4 Static Expressions
+         --  A type conversion is not a locally static expression.
+         if Flags.Vhdl_Std = Vhdl_87 then
+            Staticness := Min (Globally, Staticness);
+         end if;
+         Set_Expr_Staticness (Conv, Staticness);
+
+         if not Are_Types_Closely_Related (Conv_Type, Get_Type (Expr))
+         then
+            --  FIXME: should explain why the types are not closely related.
+            Error_Msg_Sem
+              ("conversion not allowed between not closely related types",
+               Conv);
+            --  Avoid error storm in evaluation.
+            Set_Expr_Staticness (Conv, None);
+         else
+            Check_Read (Expr);
+         end if;
+      end if;
+      return Conv;
+   end Sem_Type_Conversion;
+
+   --  OBJ is an 'impure' object (variable, signal or file) referenced at
+   --  location LOC.
+   --  Check the pure rules (LRM08 4 Subprograms and packages,
+   --  LRM08 4.3 Subprograms bodies).
+   procedure Sem_Check_Pure (Loc : Iir; Obj : Iir)
+   is
+      procedure Update_Impure_Depth (Subprg_Spec : Iir; Depth : Iir_Int32)
+      is
+         Bod : Iir;
+      begin
+         Bod := Get_Subprogram_Body (Subprg_Spec);
+         if Bod = Null_Iir then
+            return;
+         end if;
+         if Depth < Get_Impure_Depth (Bod) then
+            Set_Impure_Depth (Bod, Depth);
+         end if;
+      end Update_Impure_Depth;
+
+      procedure Error_Pure (Subprg : Iir; Obj : Iir)
+      is
+      begin
+         Error_Msg_Sem
+           ("reference to " & Disp_Node (Obj) & " violate pure rule for "
+            & Disp_Node (Subprg), Loc);
+      end Error_Pure;
+
+      Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
+      Subprg_Body : Iir;
+      Parent : Iir;
+   begin
+      --  Apply only in subprograms.
+      if Subprg = Null_Iir then
+         return;
+      end if;
+      case Get_Kind (Subprg) is
+         when Iir_Kinds_Process_Statement =>
+            return;
+         when Iir_Kind_Procedure_Declaration =>
+            --  Exit now if already known as impure.
+            if Get_Purity_State (Subprg) = Impure then
+               return;
+            end if;
+         when Iir_Kind_Function_Declaration =>
+            --  Exit now if impure.
+            if Get_Pure_Flag (Subprg) = False then
+               return;
+            end if;
+         when others =>
+            Error_Kind ("sem_check_pure", Subprg);
+      end case;
+
+      --  Not all objects are impure.
+      case Get_Kind (Obj) is
+         when Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            null;
+         when Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration =>
+            --  When referenced as a formal name (FIXME: this is an
+            --  approximation), the rules don't apply.
+            if not Get_Is_Within_Flag (Get_Parent (Obj)) then
+               return;
+            end if;
+         when Iir_Kind_File_Declaration =>
+            --  LRM 93 2.2
+            --  If a pure function is the parent of a given procedure, then
+            --  that procedure must not contain a reference to an explicitly
+            --  declared file object [...]
+            --
+            --  A pure function must not contain a reference to an explicitly
+            --  declared file.
+            if Flags.Vhdl_Std > Vhdl_93c then
+               if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
+                  Error_Pure (Subprg, Obj);
+               else
+                  Set_Purity_State (Subprg, Impure);
+                  Set_Impure_Depth (Get_Subprogram_Body (Subprg),
+                                    Iir_Depth_Impure);
+               end if;
+            end if;
+            return;
+         when others =>
+            return;
+      end case;
+
+      --  OBJ is declared in the immediate declarative part of the subprogram.
+      Parent := Get_Parent (Obj);
+      Subprg_Body := Get_Subprogram_Body (Subprg);
+      if Parent = Subprg or else Parent = Subprg_Body then
+         return;
+      end if;
+
+      --  Function.
+      if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then
+         Error_Pure (Subprg, Obj);
+         return;
+      end if;
+
+      case Get_Kind (Parent) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kinds_Process_Statement
+           | Iir_Kind_Protected_Type_Body =>
+            --  The procedure is impure.
+            Set_Purity_State (Subprg, Impure);
+            Set_Impure_Depth (Subprg_Body, Iir_Depth_Impure);
+            return;
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            Update_Impure_Depth
+              (Subprg,
+               Get_Subprogram_Depth (Get_Subprogram_Specification (Parent)));
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            Update_Impure_Depth (Subprg, Get_Subprogram_Depth (Parent));
+         when others =>
+            Error_Kind ("sem_check_pure(2)", Parent);
+      end case;
+   end Sem_Check_Pure;
+
+   --  Set All_Sensitized_State to False iff OBJ is a signal declaration
+   --  and the current subprogram is in a package body.
+   procedure Sem_Check_All_Sensitized (Obj : Iir)
+   is
+      Subprg : Iir;
+   begin
+      --  We cares only of signals.
+      if Get_Kind (Obj) /= Iir_Kind_Signal_Declaration then
+         return;
+      end if;
+      --  We cares only of subprograms.  Give up if we are in a process.
+      Subprg := Sem_Stmts.Get_Current_Subprogram;
+      if Subprg = Null_Iir
+        or else Get_Kind (Subprg) not in Iir_Kinds_Subprogram_Declaration
+      then
+         return;
+      end if;
+      if Get_Kind (Get_Library_Unit (Sem.Get_Current_Design_Unit))
+        = Iir_Kind_Package_Body
+      then
+         Set_All_Sensitized_State (Subprg, Invalid_Signal);
+      else
+         Set_All_Sensitized_State (Subprg, Read_Signal);
+      end if;
+   end Sem_Check_All_Sensitized;
+
+   function Finish_Sem_Denoting_Name (Name : Iir; Res : Iir) return Iir
+   is
+      Prefix : Iir;
+   begin
+      case Iir_Kinds_Denoting_Name (Get_Kind (Name)) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Operator_Symbol =>
+            Xref_Ref (Name, Res);
+            return Name;
+         when Iir_Kind_Selected_Name =>
+            Xref_Ref (Name, Res);
+            Prefix := Get_Prefix (Name);
+            loop
+               pragma Assert (Get_Kind (Prefix) in Iir_Kinds_Denoting_Name);
+               Xref_Ref (Prefix, Get_Named_Entity (Prefix));
+               exit when Get_Kind (Prefix) /= Iir_Kind_Selected_Name;
+               Prefix := Get_Prefix (Prefix);
+            end loop;
+            return Name;
+      end case;
+   end Finish_Sem_Denoting_Name;
+
+   function Finish_Sem_Name_1 (Name : Iir; Res : Iir) return Iir
+   is
+      Prefix : Iir;
+      Name_Prefix : Iir;
+      Name_Res : Iir;
+   begin
+      case Get_Kind (Res) is
+         when Iir_Kinds_Library_Unit_Declaration =>
+            return Finish_Sem_Denoting_Name (Name, Res);
+         when Iir_Kinds_Sequential_Statement
+           | Iir_Kinds_Concurrent_Statement =>
+            --  Label or part of an expanded name (for process, block
+            --  and generate).
+            return Finish_Sem_Denoting_Name (Name, Res);
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kinds_Quantity_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Unit_Declaration =>
+            Name_Res := Finish_Sem_Denoting_Name (Name, Res);
+            Set_Base_Name (Name_Res, Res);
+            Set_Name_Staticness (Name_Res, Get_Name_Staticness (Res));
+            Set_Expr_Staticness (Name_Res, Get_Expr_Staticness (Res));
+            Sem_Check_Pure (Name_Res, Res);
+            Sem_Check_All_Sensitized (Res);
+            Set_Type (Name_Res, Get_Type (Res));
+            return Name_Res;
+         when Iir_Kind_Attribute_Value =>
+            pragma Assert (Get_Kind (Name) = Iir_Kind_Attribute_Name);
+            Prefix := Finish_Sem_Name (Get_Prefix (Name));
+            Set_Prefix (Name, Prefix);
+            Set_Base_Name (Name, Res);
+            Set_Type (Name, Get_Type (Res));
+            Set_Name_Staticness (Name, Get_Name_Staticness (Res));
+            Set_Expr_Staticness (Name, Get_Expr_Staticness (Res));
+            return Name;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kind_Interface_Package_Declaration =>
+            Name_Res := Finish_Sem_Denoting_Name (Name, Res);
+            Set_Base_Name (Name_Res, Res);
+            return Name_Res;
+         when Iir_Kinds_Function_Declaration =>
+            Name_Res := Finish_Sem_Denoting_Name (Name, Res);
+            Set_Type (Name_Res, Get_Return_Type (Res));
+            return Name_Res;
+         when Iir_Kinds_Procedure_Declaration =>
+            return Finish_Sem_Denoting_Name (Name, Res);
+         when Iir_Kind_Type_Conversion =>
+            pragma Assert (Get_Kind (Name) = Iir_Kind_Parenthesis_Name);
+            Set_Type_Mark (Res, Sem_Type_Mark (Get_Prefix (Name)));
+            Free_Parenthesis_Name (Name, Res);
+            return Res;
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Dereference =>
+            --  Fall through.
+            null;
+         when Iir_Kind_Implicit_Dereference =>
+            --  The name may not have a prefix.
+            Prefix := Finish_Sem_Name (Name, Get_Prefix (Res));
+            Set_Prefix (Res, Prefix);
+            Finish_Sem_Dereference (Res);
+            return Res;
+         when Iir_Kind_Function_Call =>
+            case Get_Kind (Name) is
+               when Iir_Kind_Parenthesis_Name =>
+                  Prefix := Finish_Sem_Name
+                    (Get_Prefix (Name), Get_Implementation (Res));
+                  Finish_Sem_Function_Call (Res, Prefix);
+                  Free_Iir (Name);
+               when Iir_Kinds_Denoting_Name =>
+                  Prefix := Finish_Sem_Name (Name, Get_Implementation (Res));
+                  Finish_Sem_Function_Call (Res, Prefix);
+               when others =>
+                  Error_Kind ("Finish_Sem_Name(function call)", Name);
+            end case;
+            return Res;
+         when Iir_Kinds_Array_Attribute =>
+            if Get_Parameter (Res) = Null_Iir then
+               Finish_Sem_Array_Attribute (Name, Res, Null_Iir);
+            end if;
+            if Get_Kind (Name) = Iir_Kind_Attribute_Name then
+               Free_Iir (Name);
+            else
+               Free_Iir (Get_Prefix (Name));
+               Free_Parenthesis_Name (Name, Res);
+            end if;
+            return Res;
+         when Iir_Kinds_Scalar_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute =>
+            if Get_Parameter (Res) = Null_Iir then
+               Finish_Sem_Scalar_Type_Attribute (Name, Res, Null_Iir);
+            else
+               Free_Parenthesis_Name (Name, Res);
+            end if;
+            return Res;
+         when Iir_Kinds_Signal_Value_Attribute =>
+            null;
+         when Iir_Kinds_Signal_Attribute =>
+            if Get_Parameter (Res) = Null_Iir then
+               Finish_Sem_Signal_Attribute (Name, Res, Null_Iir);
+            else
+               Free_Parenthesis_Name (Name, Res);
+            end if;
+            return Res;
+         when Iir_Kinds_Type_Attribute =>
+            Free_Iir (Name);
+            return Res;
+         when Iir_Kind_Base_Attribute =>
+            return Res;
+         when Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute =>
+            Free_Iir (Name);
+            return Res;
+         when Iir_Kind_Psl_Expression =>
+            return Res;
+         when Iir_Kind_Psl_Declaration =>
+            return Name;
+         when Iir_Kind_Element_Declaration
+           | Iir_Kind_Error =>
+            --  Certainly an error!
+            return Res;
+         when others =>
+            Error_Kind ("finish_sem_name", Res);
+      end case;
+
+      --  Finish prefix.
+      Prefix := Get_Prefix (Res);
+      Name_Prefix := Get_Prefix (Name);
+      Prefix := Finish_Sem_Name_1 (Name_Prefix, Prefix);
+      Set_Prefix (Res, Prefix);
+
+      case Get_Kind (Res) is
+         when Iir_Kind_Indexed_Name =>
+            Finish_Sem_Indexed_Name (Res);
+            Free_Parenthesis_Name (Name, Res);
+         when Iir_Kind_Slice_Name =>
+            Finish_Sem_Slice_Name (Res);
+            Free_Parenthesis_Name (Name, Res);
+         when Iir_Kind_Selected_Element =>
+            pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_Name);
+            Xref_Ref (Res, Get_Selected_Element (Res));
+            Set_Name_Staticness (Res, Get_Name_Staticness (Prefix));
+            Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix));
+            Set_Base_Name (Res, Get_Base_Name (Prefix));
+            Free_Iir (Name);
+         when Iir_Kind_Dereference =>
+            pragma Assert (Get_Kind (Name) = Iir_Kind_Selected_By_All_Name);
+            Finish_Sem_Dereference (Res);
+            Free_Iir (Name);
+         when Iir_Kinds_Signal_Value_Attribute =>
+            Sem_Name_Free_Result (Name, Res);
+         when others =>
+            Error_Kind ("finish_sem_name(2)", Res);
+      end case;
+      return Res;
+   end Finish_Sem_Name_1;
+
+   function Finish_Sem_Name (Name : Iir; Res : Iir) return Iir
+   is
+      Old_Res : Iir;
+   begin
+      if Get_Kind (Res) /= Iir_Kind_Implicit_Dereference then
+         Old_Res := Get_Named_Entity (Name);
+         if Old_Res /= Null_Iir and then Old_Res /= Res then
+            pragma Assert (Is_Overload_List (Old_Res));
+            Sem_Name_Free_Result (Old_Res, Res);
+         end if;
+         Set_Named_Entity (Name, Res);
+      end if;
+      return Finish_Sem_Name_1 (Name, Res);
+   end Finish_Sem_Name;
+
+   function Finish_Sem_Name (Name : Iir) return Iir is
+   begin
+      return Finish_Sem_Name_1 (Name, Get_Named_Entity (Name));
+   end Finish_Sem_Name;
+
+   --  LRM93 6.2
+   --  The evaluation of a simple name has no other effect than to determine
+   --  the named entity denoted by the name.
+   --
+   --  NAME may be a simple name, a strig literal or a character literal.
+   --  GHDL: set interpretation of NAME (possibly an overload list) or
+   --  error_mark for unknown names.
+   --  If SOFT is TRUE, then no error message is reported in case of failure.
+   procedure Sem_Simple_Name (Name : Iir; Keep_Alias : Boolean; Soft : Boolean)
+   is
+      Id : constant Name_Id := Get_Identifier (Name);
+      Interpretation: Name_Interpretation_Type;
+      Res: Iir;
+      Res_List : Iir_List;
+      N : Natural;
+   begin
+      Interpretation := Get_Interpretation (Id);
+
+      if not Valid_Interpretation (Interpretation) then
+         --  Unknown name.
+         if not Soft then
+            Error_Msg_Sem
+              ("no declaration for """ & Image_Identifier (Name) & """", Name);
+         end if;
+         Res := Error_Mark;
+      elsif not Valid_Interpretation (Get_Next_Interpretation (Interpretation))
+      then
+         --  One simple interpretation.
+         Res := Get_Declaration (Interpretation);
+
+         --  For a design unit, return the library unit
+         if Get_Kind (Res) = Iir_Kind_Design_Unit then
+            --  FIXME: should replace interpretation ?
+            Libraries.Load_Design_Unit (Res, Name);
+            Sem.Add_Dependence (Res);
+            Res := Get_Library_Unit (Res);
+         end if;
+
+         --  Check visibility.
+         if not Get_Visible_Flag (Res) then
+            if Flag_Relaxed_Rules
+              and then Get_Kind (Res) in Iir_Kinds_Object_Declaration
+              and then Valid_Interpretation (Get_Under_Interpretation (Id))
+            then
+               Res := Get_Declaration (Get_Under_Interpretation (Id));
+            else
+               if not Soft then
+                  Error_Msg_Sem
+                    (Disp_Node (Res) & " is not visible here", Name);
+               end if;
+               --  Even if a named entity was found, return an error_mark.
+               --  Indeed, the named entity found is certainly the one being
+               --  semantized, and the semantization may be uncomplete.
+               Res := Error_Mark;
+            end if;
+         end if;
+
+         if not Keep_Alias
+           and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration
+         then
+            Set_Alias_Declaration (Name, Res);
+            Res := Get_Named_Entity (Get_Name (Res));
+         end if;
+      else
+         --  Name is overloaded.
+         Res_List := Create_Iir_List;
+         N := 0;
+         --  The SEEN_FLAG is used to get only one meaning which can be reached
+         --  through several pathes (such as aliases).
+         while Valid_Interpretation (Interpretation) loop
+            if Keep_Alias then
+               Res := Get_Declaration (Interpretation);
+            else
+               Res := Get_Non_Alias_Declaration (Interpretation);
+            end if;
+            if not Get_Seen_Flag (Res) then
+               Set_Seen_Flag (Res, True);
+               N := N + 1;
+               Append_Element (Res_List, Res);
+            end if;
+            Interpretation := Get_Next_Interpretation (Interpretation);
+         end loop;
+
+         --  FIXME: there can be only one element (a function and its alias!).
+
+         --  Clear SEEN_FLAG.
+         for I in 0 .. N - 1 loop
+            Res := Get_Nth_Element (Res_List, I);
+            Set_Seen_Flag (Res, False);
+         end loop;
+
+         Res := Create_Overload_List (Res_List);
+      end if;
+
+      Set_Base_Name (Name, Res);
+      Set_Named_Entity (Name, Res);
+   end Sem_Simple_Name;
+
+   --  LRM93 §6.3
+   --  Selected Names.
+   procedure Sem_Selected_Name (Name: Iir; Keep_Alias : Boolean := False)
+   is
+      Suffix : constant Name_Id := Get_Identifier (Name);
+      Prefix_Name : constant Iir := Get_Prefix (Name);
+      Prefix_Loc : constant Location_Type := Get_Location (Prefix_Name);
+
+      Prefix: Iir;
+      Res : Iir;
+
+      --  Semantize SUB_NAME.NAME as an expanded name (ie, NAME is declared
+      --  within SUB_NAME).  This is possible only if the expanded name is
+      --  analyzed within the context of SUB_NAME.
+      procedure Sem_As_Expanded_Name (Sub_Name : Iir)
+      is
+         Sub_Res : Iir;
+      begin
+         if Get_Is_Within_Flag (Sub_Name) then
+            Sub_Res := Find_Declarations_In_List (Sub_Name, Name, Keep_Alias);
+            if Sub_Res /= Null_Iir then
+               Add_Result (Res, Sub_Res);
+            end if;
+         end if;
+      end Sem_As_Expanded_Name;
+
+      --  LRM93 §6.3
+      --  For a selected name that is used to denote a record element,
+      --  the suffix must be a simple name denoting an element of a
+      --  record object or value.  The prefix must be appropriate for the
+      --  type of this object or value.
+      --
+      --  Semantize SUB_NAME.NAME as a selected element.
+      procedure Sem_As_Selected_Element (Sub_Name : Iir)
+      is
+         Base_Type : Iir;
+         Ptr_Type : Iir;
+         Rec_El : Iir;
+         R : Iir;
+         Se : Iir;
+      begin
+         --  FIXME: if not is_expr (sub_name) return.
+         Base_Type := Get_Base_Type (Get_Type (Sub_Name));
+         if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
+            Ptr_Type := Base_Type;
+            Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
+         else
+            Ptr_Type := Null_Iir;
+         end if;
+
+         if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
+            return;
+         end if;
+
+         Rec_El := Find_Name_In_List
+           (Get_Elements_Declaration_List (Base_Type), Suffix);
+         if Rec_El = Null_Iir then
+            return;
+         end if;
+
+         if not Maybe_Function_Call (Sub_Name) then
+            return;
+         end if;
+
+         R := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name);
+         R := Maybe_Insert_Dereference (R, Ptr_Type);
+
+         Se := Create_Iir (Iir_Kind_Selected_Element);
+         Location_Copy (Se, Name);
+         Set_Prefix (Se, R);
+         Set_Type (Se, Get_Type (Rec_El));
+         Set_Selected_Element (Se, Rec_El);
+         Set_Base_Name (Se, Get_Object_Prefix (R, False));
+         Add_Result (Res, Se);
+      end Sem_As_Selected_Element;
+
+      procedure Error_Selected_Element (Prefix_Type : Iir)
+      is
+         Base_Type : Iir;
+      begin
+         Base_Type := Get_Base_Type (Prefix_Type);
+         if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
+            Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
+         end if;
+         if Get_Kind (Base_Type) /= Iir_Kind_Record_Type_Definition then
+            Error_Msg_Sem
+              (Disp_Node (Prefix) & " does not designate a record", Name);
+         else
+            Error_Msg_Sem
+              ("no element """ & Name_Table.Image (Suffix)
+               & """ in " & Disp_Node (Base_Type), Name);
+         end if;
+      end Error_Selected_Element;
+
+      procedure Sem_As_Protected_Item (Sub_Name : Iir)
+      is
+         Prot_Type : constant Iir := Get_Type (Sub_Name);
+         Method : Iir;
+      begin
+         --  LRM98 12.3 Visibility
+         --  s) For a subprogram declared immediately within a given protected
+         --     type declaration: at the place of the suffix in a selected
+         --     name whose prefix denotes an object of the protected type.
+         Method := Get_Declaration_Chain (Prot_Type);
+         while Method /= Null_Iir loop
+            case Get_Kind (Method) is
+               when Iir_Kind_Function_Declaration |
+                 Iir_Kind_Procedure_Declaration =>
+                  if Get_Identifier (Method) = Suffix then
+                     Add_Result (Res, Method);
+                  end if;
+               when Iir_Kind_Attribute_Specification
+                 | Iir_Kind_Use_Clause =>
+                  null;
+               when others =>
+                  Error_Kind ("sem_as_protected_item", Method);
+            end case;
+            Method := Get_Chain (Method);
+         end loop;
+      end Sem_As_Protected_Item;
+
+      procedure Error_Protected_Item (Prot_Type : Iir) is
+      begin
+         Error_Msg_Sem
+           ("no method " & Name_Table.Image (Suffix) & " in "
+              & Disp_Node (Prot_Type), Name);
+      end Error_Protected_Item;
+   begin
+      --  Analyze prefix.
+      Sem_Name (Prefix_Name);
+      Prefix := Get_Named_Entity (Prefix_Name);
+      if Prefix = Error_Mark then
+         Set_Named_Entity (Name, Prefix);
+         return;
+      end if;
+
+      Res := Null_Iir;
+
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Overload_List =>
+            --  LRM93 6.3
+            --  If, according to the visibility rules, there is at
+            --  least one possible interpretation of the prefix of a
+            --  selected name as the name of an enclosing entity
+            --  interface, architecture, subprogram, block statement,
+            --  process statement, generate statement, or loop
+            --  statement, then the only interpretations considered are
+            --  those of the immediately preceding paragraph.
+            --
+            --  In this case, the selected name is always interpreted
+            --  as an expanded name.  In particular, no interpretations
+            --  of the prefix as a function call are considered.
+            declare
+               Prefix_List : Iir_List;
+               El : Iir;
+            begin
+               --  So, first try as expanded name.
+               Prefix_List := Get_Overload_List (Prefix);
+               for I in Natural loop
+                  El := Get_Nth_Element (Prefix_List, I);
+                  exit when El = Null_Iir;
+                  Sem_As_Expanded_Name (El);
+               end loop;
+
+               --  If no expanded name are found, try as selected element.
+               if Res = Null_Iir then
+                  for I in Natural loop
+                     El := Get_Nth_Element (Prefix_List, I);
+                     exit when El = Null_Iir;
+                     Sem_As_Selected_Element (El);
+                  end loop;
+               end if;
+            end;
+            if Res = Null_Iir then
+               Error_Msg_Sem ("no suffix """ & Name_Table.Image (Suffix)
+                              & """ for overloaded selected name", Name);
+            end if;
+         when Iir_Kind_Library_Declaration =>
+            --  LRM93 6.3
+            --  An expanded name denotes a primary unit constained in a design
+            --  library if the prefix denotes the library and the suffix is the
+            --  simple name if a primary unit whose declaration is contained
+            --  in that library.
+            --  An expanded name is not allowed for a secondary unit,
+            --  particularly for an architecture body.
+            --  GHDL: FIXME: error message more explicit
+            Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name);
+            if Res = Null_Iir then
+               Error_Msg_Sem
+                 ("primary unit """ & Name_Table.Image (Suffix)
+                  & """ not found in " & Disp_Node (Prefix), Name);
+            else
+               Sem.Add_Dependence (Res);
+               Res := Get_Library_Unit (Res);
+            end if;
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_For_Loop_Statement =>
+            --  LRM93 §6.3
+            --  An expanded name denotes a named entity declared immediatly
+            --  within a named construct if the prefix that is an entity
+            --  interface, an architecture, a subprogram, a block statement,
+            --  a process statement, a generate statement, or a loop
+            --  statement, and the suffix is the simple name, character
+            --  literal, or operator symbol of an named entity whose
+            --  declaration occurs immediatly within that construct.
+            if Get_Kind (Prefix) = Iir_Kind_Design_Unit then
+               Libraries.Load_Design_Unit (Prefix, Name);
+               Sem.Add_Dependence (Prefix);
+               Prefix := Get_Library_Unit (Prefix);
+               --  Modified only for xrefs, since a design_unit points to
+               --  the first context clause, while a library unit points to
+               --  the identifier.
+               Set_Named_Entity (Get_Prefix (Name), Prefix);
+            end if;
+
+            Res := Find_Declarations_In_List (Prefix, Name, Keep_Alias);
+
+            if Res = Null_Iir then
+               Error_Msg_Sem
+                 ("no declaration for """ & Name_Table.Image (Suffix)
+                  & """ in " & Disp_Node (Prefix), Name);
+            else
+               --  LRM93 §6.3
+               --  This form of expanded name is only allowed within the
+               --  construct itself.
+               if not Kind_In (Prefix,
+                               Iir_Kind_Package_Declaration,
+                               Iir_Kind_Package_Instantiation_Declaration)
+                 and then not Get_Is_Within_Flag (Prefix)
+               then
+                  Error_Msg_Sem
+                    ("this expanded name is only allowed within the construct",
+                     Prefix_Loc);
+                  --  Hum, keep res.
+               end if;
+            end if;
+         when Iir_Kind_Function_Declaration =>
+            Sem_As_Expanded_Name (Prefix);
+            if Res = Null_Iir then
+               Sem_As_Selected_Element (Prefix);
+            end if;
+            if Res = Null_Iir then
+               Error_Selected_Element (Get_Return_Type (Prefix));
+            end if;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Function_Call =>
+            if Get_Kind (Get_Type (Prefix))
+              = Iir_Kind_Protected_Type_Declaration
+            then
+               Sem_As_Protected_Item (Prefix);
+               if Res = Null_Iir then
+                  Error_Protected_Item (Prefix);
+               end if;
+            else
+               Sem_As_Selected_Element (Prefix);
+               if Res = Null_Iir then
+                  Error_Selected_Element (Get_Type (Prefix));
+               end if;
+            end if;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Slice_Name =>
+            Error_Msg_Sem
+              (Disp_Node (Prefix) & " cannot be selected by name", Prefix_Loc);
+
+         when others =>
+            Error_Kind ("sem_selected_name(2)", Prefix);
+      end case;
+      if Res = Null_Iir then
+         Res := Error_Mark;
+      end if;
+      Set_Named_Entity (Name, Res);
+   end Sem_Selected_Name;
+
+   --  If ASSOC_LIST has one element, which is an expression without formal,
+   --  return the actual, else return NULL_IIR.
+   function Get_One_Actual (Assoc_Chain : Iir) return Iir
+   is
+      Assoc : Iir;
+   begin
+      --  Only one actual ?
+      if Assoc_Chain = Null_Iir or else Get_Chain (Assoc_Chain) /= Null_Iir
+      then
+         return Null_Iir;
+      end if;
+
+      --  Not 'open' association element ?
+      Assoc := Assoc_Chain;
+      if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
+         return Null_Iir;
+      end if;
+
+      --  Not an association (ie no formal) ?
+      if Get_Formal (Assoc) /= Null_Iir then
+         return Null_Iir;
+      end if;
+
+      return Get_Actual (Assoc);
+   end Get_One_Actual;
+
+   function Slice_Or_Index (Actual : Iir) return Iir_Kind is
+   begin
+      --  But it may be a slice name.
+      case Get_Kind (Actual) is
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Range_Expression =>
+            return Iir_Kind_Slice_Name;
+         when others =>
+            if Is_Range_Attribute_Name (Actual) then
+               return Iir_Kind_Slice_Name;
+            end if;
+      end case;
+      --  By default, this is an indexed name.
+      return Iir_Kind_Indexed_Name;
+   end Slice_Or_Index;
+
+   --  Check whether association chain ASSOCS may be interpreted as indexes.
+   function Index_Or_Not (Assocs : Iir) return Iir_Kind
+   is
+      El : Iir;
+   begin
+      El := Assocs;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Association_Element_By_Expression =>
+               if Get_Formal (El) /= Null_Iir then
+                  return Iir_Kind_Error;
+               end if;
+            when others =>
+               --  Only expression are allowed.
+               return Iir_Kind_Error;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      return Iir_Kind_Indexed_Name;
+   end Index_Or_Not;
+
+   function Sem_Index_Specification (Name : Iir_Parenthesis_Name; Itype : Iir)
+                                    return Iir
+   is
+      Actual : Iir;
+      Kind : Iir_Kind;
+      Res : Iir;
+   begin
+      --  FIXME: reuse Sem_Name for the whole analysis ?
+
+      Actual := Get_One_Actual (Get_Association_Chain (Name));
+      if Actual = Null_Iir then
+         Error_Msg_Sem ("only one index specification is allowed", Name);
+         return Null_Iir;
+      end if;
+      case Get_Kind (Actual) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            Sem_Name (Actual);
+            Kind := Slice_Or_Index (Get_Named_Entity (Actual));
+            --  FIXME: semantization to be finished.
+            --Maybe_Finish_Sem_Name (Actual);
+         when others =>
+            Kind := Slice_Or_Index (Actual);
+      end case;
+
+      Res := Create_Iir (Kind);
+      Location_Copy (Res, Name);
+      case Kind is
+         when Iir_Kind_Indexed_Name =>
+            Actual := Sem_Expression (Actual, Itype);
+            if Actual = Null_Iir then
+               return Null_Iir;
+            end if;
+            Check_Read (Actual);
+            if Get_Expr_Staticness (Actual) < Globally then
+               Error_Msg_Sem ("index must be a static expression", Name);
+            end if;
+            Set_Index_List (Res, Create_Iir_List);
+            Append_Element (Get_Index_List (Res), Actual);
+         when Iir_Kind_Slice_Name =>
+            Actual := Sem_Discrete_Range_Expression (Actual, Itype, False);
+            if Actual = Null_Iir then
+               return Null_Iir;
+            end if;
+            if Get_Expr_Staticness (Actual) < Globally then
+               Error_Msg_Sem ("index must be a static expression", Name);
+            end if;
+            Set_Suffix (Res, Actual);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Free_Parenthesis_Name (Name, Res);
+      return Res;
+   end Sem_Index_Specification;
+
+   procedure Sem_Parenthesis_Name (Name : Iir_Parenthesis_Name)
+   is
+      Prefix: Iir;
+      Prefix_Name : Iir;
+      Res : Iir;
+      Assoc_Chain : Iir;
+
+      Slice_Index_Kind : Iir_Kind;
+
+      --  If FINISH is TRUE, then display error message in case of error.
+      function Sem_As_Indexed_Or_Slice_Name (Sub_Name : Iir; Finish : Boolean)
+        return Iir
+      is
+         Base_Type : Iir;
+         Ptr_Type : Iir;
+         P : Iir;
+         R : Iir;
+      begin
+         if Slice_Index_Kind = Iir_Kind_Error then
+            if Finish then
+               Error_Msg_Sem ("prefix is not a function name", Name);
+            end if;
+            --  No way.
+            return Null_Iir;
+         end if;
+
+         --  Only values can be indexed or sliced.
+         --  Catch errors such as slice of a type conversion.
+         if not Is_Object_Name (Sub_Name)
+           and then Get_Kind (Sub_Name) not in Iir_Kinds_Function_Declaration
+         then
+            if Finish then
+               Error_Msg_Sem ("prefix is not an array value (found "
+                              & Disp_Node (Sub_Name) & ")", Name);
+            end if;
+            return Null_Iir;
+         end if;
+
+         --  Extract type of prefix, handle possible implicit deference.
+         Base_Type := Get_Base_Type (Get_Type (Sub_Name));
+         if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition then
+            Ptr_Type := Base_Type;
+            Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
+         else
+            Ptr_Type := Null_Iir;
+         end if;
+
+         if Get_Kind (Base_Type) /= Iir_Kind_Array_Type_Definition then
+            if Finish then
+               Error_Msg_Sem ("type of prefix is not an array", Name);
+            end if;
+            return Null_Iir;
+         end if;
+         if Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) /=
+           Get_Chain_Length (Assoc_Chain)
+         then
+            if Finish then
+               Error_Msg_Sem
+                 ("number of indexes mismatches array dimension", Name);
+            end if;
+            return Null_Iir;
+         end if;
+
+         if not Maybe_Function_Call (Sub_Name) then
+            if Finish then
+               Error_Msg_Sem ("missing parameters for function call", Name);
+            end if;
+            return Null_Iir;
+         end if;
+
+         P := Maybe_Insert_Function_Call (Prefix_Name, Sub_Name);
+         P := Maybe_Insert_Dereference (P, Ptr_Type);
+
+         R := Create_Iir (Slice_Index_Kind);
+         Location_Copy (R, Name);
+         Set_Prefix (R, P);
+         Set_Base_Name (R, Get_Object_Prefix (P));
+
+         case Slice_Index_Kind is
+            when Iir_Kind_Slice_Name =>
+               Set_Suffix (R, Get_Actual (Assoc_Chain));
+               Set_Type (R, Get_Base_Type (Get_Type (P)));
+            when Iir_Kind_Indexed_Name =>
+               declare
+                  Idx_El : Iir;
+                  Idx_List : Iir_List;
+               begin
+                  Idx_List := Create_Iir_List;
+                  Set_Index_List (R, Idx_List);
+                  Idx_El := Assoc_Chain;
+                  while Idx_El /= Null_Iir loop
+                     Append_Element (Idx_List, Get_Actual (Idx_El));
+                     Idx_El := Get_Chain (Idx_El);
+                  end loop;
+               end;
+               Set_Type (R, Get_Element_Subtype (Base_Type));
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         return R;
+      end Sem_As_Indexed_Or_Slice_Name;
+
+      --  Sem parenthesis name when the prefix is a function declaration.
+      --  Can be either a function call (and the expression is the actual) or
+      --  a slice/index of the result of a call without actual.
+      procedure Sem_Parenthesis_Function (Sub_Name : Iir) is
+         Used : Boolean;
+         R : Iir;
+         Match : Boolean;
+      begin
+         Used := False;
+         if Get_Kind (Sub_Name) in Iir_Kinds_Function_Declaration then
+            Sem_Association_Chain
+              (Get_Interface_Declaration_Chain (Sub_Name),
+               Assoc_Chain, False, Missing_Parameter, Name, Match);
+            if Match then
+               Add_Result
+                 (Res,
+                  Sem_As_Function_Call (Prefix_Name, Sub_Name, Assoc_Chain));
+               Used := True;
+            end if;
+         end if;
+         if Get_Kind (Sub_Name) not in Iir_Kinds_Procedure_Declaration then
+            R := Sem_As_Indexed_Or_Slice_Name (Sub_Name, False);
+            if R /= Null_Iir then
+               Add_Result (Res, R);
+               Used := True;
+            end if;
+         end if;
+         if not Used then
+            Sem_Name_Free_Result (Sub_Name, Null_Iir);
+         end if;
+      end Sem_Parenthesis_Function;
+
+      procedure Error_Parenthesis_Function (Spec : Iir)
+      is
+         Match : Boolean;
+      begin
+         Error_Msg_Sem
+           ("cannot match " & Disp_Node (Prefix) & " with actuals", Name);
+         --  Display error message.
+         Sem_Association_Chain
+           (Get_Interface_Declaration_Chain (Spec),
+            Assoc_Chain, True, Missing_Parameter, Name, Match);
+      end Error_Parenthesis_Function;
+
+      Actual : Iir;
+      Actual_Expr : Iir;
+   begin
+      -- The prefix is a function name, a type mark or an array.
+      Prefix_Name := Get_Prefix (Name);
+      Sem_Name (Prefix_Name);
+      Prefix := Get_Named_Entity (Prefix_Name);
+      if Prefix = Error_Mark then
+         Set_Named_Entity (Name, Error_Mark);
+         return;
+      end if;
+      Res := Null_Iir;
+
+      Assoc_Chain := Get_Association_Chain (Name);
+      Actual := Get_One_Actual (Assoc_Chain);
+
+      if Get_Kind (Prefix) = Iir_Kind_Type_Declaration
+        or else Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration
+      then
+         --  A type conversion.  The prefix is a type mark.
+
+         if Actual = Null_Iir then
+            --  More than one actual.  Keep only the first.
+            Error_Msg_Sem
+              ("type conversion allows only one expression", Name);
+         end if;
+
+         --  This is certainly the easiest case: the prefix is not overloaded,
+         --  so the result can be computed.
+         Set_Named_Entity (Name, Sem_Type_Conversion (Name, Prefix, Actual));
+         return;
+      end if;
+
+      --  Select between slice or indexed name.
+      Actual_Expr := Null_Iir;
+      if Actual /= Null_Iir then
+         if Get_Kind (Actual) in Iir_Kinds_Name
+           or else Get_Kind (Actual) = Iir_Kind_Attribute_Name
+         then
+            --  Maybe a discrete range name.
+            Sem_Name (Actual);
+            Actual_Expr := Get_Named_Entity (Actual);
+            if Actual_Expr = Error_Mark then
+               Set_Named_Entity (Name, Actual_Expr);
+               return;
+            end if;
+            --  Decides between sliced or indexed name to actual.
+            Slice_Index_Kind := Slice_Or_Index (Actual_Expr);
+         elsif Get_Kind (Actual) = Iir_Kind_Range_Expression then
+            --  This can only be a slice.
+            Slice_Index_Kind := Iir_Kind_Slice_Name;
+            --  Actual_Expr :=
+            --    Sem_Discrete_Range_Expression (Actual, Null_Iir, False);
+            --  Set_Actual (Assoc_Chain, Actual_Expr);
+         else
+            Slice_Index_Kind := Iir_Kind_Indexed_Name;
+         end if;
+      else
+         --  FIXME: improve error message for multi-dim slice ?
+         Slice_Index_Kind := Index_Or_Not (Assoc_Chain);
+      end if;
+
+      if Slice_Index_Kind /= Iir_Kind_Slice_Name then
+         if Sem_Actual_Of_Association_Chain (Assoc_Chain) = False then
+            Actual := Null_Iir;
+         else
+            Actual := Get_One_Actual (Assoc_Chain);
+         end if;
+      end if;
+
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Overload_List =>
+            declare
+               El : Iir;
+               Prefix_List : Iir_List;
+            begin
+               Prefix_List := Get_Overload_List (Prefix);
+               for I in Natural loop
+                  El := Get_Nth_Element (Prefix_List, I);
+                  exit when El = Null_Iir;
+                  Sem_Parenthesis_Function (El);
+               end loop;
+            end;
+            if Res = Null_Iir then
+               Error_Msg_Sem
+                 ("no overloaded function found matching "
+                    & Disp_Node (Prefix_Name), Name);
+            end if;
+         when Iir_Kinds_Function_Declaration =>
+            Sem_Parenthesis_Function (Prefix);
+            if Res = Null_Iir then
+               Error_Parenthesis_Function (Prefix);
+            end if;
+
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Function_Call =>
+            Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
+
+         when Iir_Kinds_Array_Attribute =>
+            if Actual /= Null_Iir then
+               Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Actual);
+               Set_Named_Entity (Name, Prefix);
+            else
+               Error_Msg_Sem ("bad attribute parameter", Name);
+               Set_Named_Entity (Name, Error_Mark);
+            end if;
+            return;
+
+         when Iir_Kinds_Scalar_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute =>
+            if Get_Parameter (Prefix) /= Null_Iir then
+               --  Attribute already has a parameter, the expression
+               --  is either a slice or an index.
+               Add_Result
+                 (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True));
+            elsif Actual /= Null_Iir then
+               Finish_Sem_Scalar_Type_Attribute (Prefix_Name, Prefix, Actual);
+               Set_Named_Entity (Name, Prefix);
+               return;
+            else
+               Error_Msg_Sem ("bad attribute parameter", Name);
+               Set_Named_Entity (Name, Error_Mark);
+               return;
+            end if;
+
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            Error_Msg_Sem
+              ("subprogram name is a type mark (missing apostrophe)", Name);
+
+         when Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute =>
+            if Actual /= Null_Iir then
+               Finish_Sem_Signal_Attribute (Prefix_Name, Prefix, Actual);
+               Set_Named_Entity (Name, Prefix);
+            else
+               Error_Msg_Sem ("bad attribute parameter", Name);
+               Set_Named_Entity (Name, Error_Mark);
+            end if;
+            return;
+
+         when Iir_Kinds_Procedure_Declaration =>
+            Error_Msg_Sem ("function name is a procedure", Name);
+
+         when Iir_Kinds_Process_Statement
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Type_Conversion =>
+            Error_Msg_Sem
+              (Disp_Node (Prefix) & " cannot be indexed or sliced", Name);
+            Res := Null_Iir;
+
+         when Iir_Kind_Psl_Declaration =>
+            Res := Sem_Psl.Sem_Psl_Name (Name);
+
+         when Iir_Kinds_Library_Unit_Declaration =>
+            Error_Msg_Sem ("function name is a design unit", Name);
+
+         when others =>
+            Error_Kind ("sem_parenthesis_name", Prefix);
+      end case;
+
+      if Res = Null_Iir then
+         Res := Error_Mark;
+      end if;
+      Set_Named_Entity (Name, Res);
+   end Sem_Parenthesis_Name;
+
+   procedure Sem_Selected_By_All_Name (Name : Iir_Selected_By_All_Name)
+   is
+      Prefix : Iir;
+      Prefix_Name : Iir;
+      Res : Iir;
+
+      procedure Sem_As_Selected_By_All_Name (Sub_Name : Iir)
+      is
+         Base_Type : Iir;
+         R, R1 : Iir;
+      begin
+         --  Only accept prefix of access type.
+         Base_Type := Get_Base_Type (Get_Type (Sub_Name));
+         if Get_Kind (Base_Type) /= Iir_Kind_Access_Type_Definition then
+            return;
+         end if;
+
+         if not Maybe_Function_Call (Sub_Name) then
+            return;
+         end if;
+
+         R1 := Maybe_Insert_Function_Call (Get_Prefix (Name), Sub_Name);
+
+         R := Create_Iir (Iir_Kind_Dereference);
+         Location_Copy (R, Name);
+         Set_Prefix (R, R1);
+         --  FIXME: access subtype.
+         Set_Type (R, Get_Designated_Type (Base_Type));
+         Add_Result (Res, R);
+      end Sem_As_Selected_By_All_Name;
+   begin
+      Prefix := Get_Prefix (Name);
+      Sem_Name (Prefix);
+      Prefix_Name := Prefix;
+      Prefix := Get_Named_Entity (Prefix);
+      if Prefix = Null_Iir then
+         return;
+      end if;
+      Res := Null_Iir;
+
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Overload_List =>
+            declare
+               Prefix_List : Iir_List;
+               El : Iir;
+            begin
+               Prefix_List := Get_Overload_List (Prefix);
+               for I in Natural loop
+                  El := Get_Nth_Element (Prefix_List, I);
+                  exit when El = Null_Iir;
+                  Sem_As_Selected_By_All_Name (El);
+               end loop;
+            end;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Function_Call =>
+            Sem_As_Selected_By_All_Name (Prefix);
+         when Iir_Kinds_Function_Declaration =>
+            Prefix := Sem_As_Function_Call (Name => Prefix_Name,
+                                            Spec => Prefix,
+                                            Assoc_Chain => Null_Iir);
+            Sem_As_Selected_By_All_Name (Prefix);
+         when Iir_Kind_Error =>
+            Set_Named_Entity (Name, Error_Mark);
+            return;
+         when others =>
+            Error_Kind ("sem_selected_by_all_name", Prefix);
+      end case;
+      if Res = Null_Iir then
+         Error_Msg_Sem ("prefix is not an access", Name);
+         Res := Error_Mark;
+      end if;
+      Set_Named_Entity (Name, Res);
+   end Sem_Selected_By_All_Name;
+
+   function Sem_Base_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      Prefix_Name : Iir;
+      Prefix : Iir;
+      Res : Iir;
+      Base_Type : Iir;
+      Type_Decl : Iir;
+   begin
+      Prefix_Name := Finish_Sem_Name (Get_Prefix (Attr));
+      --  FIXME: handle error
+      Prefix := Get_Named_Entity (Prefix_Name);
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Type_Declaration =>
+            Base_Type := Get_Type_Definition (Prefix);
+         when Iir_Kind_Subtype_Declaration =>
+            Base_Type := Get_Base_Type (Get_Type (Prefix));
+            --  Get the first subtype.  FIXME: ref?
+            Type_Decl := Get_Type_Declarator (Base_Type);
+            if Get_Kind (Type_Decl) = Iir_Kind_Anonymous_Type_Declaration then
+               Base_Type := Get_Subtype_Definition (Type_Decl);
+            end if;
+         when others =>
+            Error_Msg_Sem
+              ("prefix of 'base attribute must be a type or a subtype", Attr);
+            return Error_Mark;
+      end case;
+      Res := Create_Iir (Iir_Kind_Base_Attribute);
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix_Name);
+      Set_Type (Res, Base_Type);
+      return Res;
+   end Sem_Base_Attribute;
+
+   function Sem_User_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      Prefix : Iir;
+      Value : Iir;
+      Attr_Id : Name_Id;
+      Spec : Iir_Attribute_Specification;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+
+      --  LRM93 6.6
+      --  If the attribute name denotes an alias, then the attribute name
+      --  denotes an attribute of the aliased name and not the alias itself,
+      --  except when the attribute designator denotes any of the predefined
+      --  attributes 'simple_name, 'path_name, or 'instance_name.
+      if Get_Kind (Prefix) = Iir_Kind_Object_Alias_Declaration then
+         --  GHDL: according to 4.3.3, the name cannot be an alias.
+         Prefix := Strip_Denoting_Name (Get_Name (Prefix));
+      end if;
+
+      --  LRM93 6.6
+      --  If the attribute designator denotes a user-defined attribute, the
+      --  prefix cannot denote a subelement or a slice of an object.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name =>
+            Error_Msg_Sem ("prefix of user defined attribute cannot be an "
+                           & "object subelement", Attr);
+            return Error_Mark;
+         when Iir_Kind_Dereference =>
+            Error_Msg_Sem ("prefix of user defined attribute cannot be an "
+                           & "anonymous object", Attr);
+            return Error_Mark;
+         when Iir_Kinds_Object_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kinds_Function_Declaration
+           | Iir_Kinds_Procedure_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kinds_Sequential_Statement
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kind_Component_Declaration
+           | Iir_Kinds_Library_Unit_Declaration =>
+            --  FIXME: to complete
+            null;
+         when others =>
+            Error_Kind ("sem_user_attribute", Prefix);
+      end case;
+
+      Attr_Id := Get_Identifier (Attr);
+      Value := Get_Attribute_Value_Chain (Prefix);
+      while Value /= Null_Iir loop
+         Spec := Get_Attribute_Specification (Value);
+         exit when Get_Identifier (Get_Attribute_Designator (Spec)) = Attr_Id;
+         Value := Get_Chain (Value);
+      end loop;
+      if Value = Null_Iir then
+         Error_Msg_Sem
+           (Disp_Node (Prefix) & " was not annotated with attribute '"
+            & Name_Table.Image (Attr_Id) & ''', Attr);
+         if Attr_Id = Std_Names.Name_First or Attr_Id = Std_Names.Name_Last
+         then
+            --  Nice (?) message for Ada users.
+            Error_Msg_Sem
+              ("(you may use 'high, 'low, 'left or 'right attribute)", Attr);
+         end if;
+         return Error_Mark;
+      end if;
+
+      Xref_Ref (Attr, Value);
+
+      return Value;
+   end Sem_User_Attribute;
+
+   --  The prefix of scalar type attributes is a type name (or 'base), and
+   --  therefore isn't overloadable.  So at the end of the function, the
+   --  analyze is finished.
+   function Sem_Scalar_Type_Attribute (Attr : Iir_Attribute_Name)
+                                      return Iir
+   is
+      use Std_Names;
+      Prefix_Name : constant Iir := Get_Prefix (Attr);
+      Id : constant Name_Id := Get_Identifier (Attr);
+      Prefix : Iir;
+      Prefix_Type : Iir;
+      Res : Iir;
+   begin
+      Prefix := Get_Named_Entity (Prefix_Name);
+
+      --  LRM93 14.1
+      --  Prefix: Any discrete or physical type of subtype T.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Type_Declaration =>
+            Prefix_Type := Get_Type_Definition (Prefix);
+         when Iir_Kind_Subtype_Declaration =>
+            Prefix_Type := Get_Type (Prefix);
+         when Iir_Kind_Base_Attribute =>
+            Prefix_Type := Get_Type (Prefix);
+         when others =>
+            Error_Msg_Sem ("prefix of '" & Name_Table.Image (Id)
+                           & " attribute must be a type", Attr);
+            return Error_Mark;
+      end case;
+
+      case Id is
+         when Name_Image
+           | Name_Value =>
+            if Get_Kind (Prefix_Type) not in Iir_Kinds_Scalar_Type_Definition
+            then
+               Error_Msg_Sem
+                 ("prefix of '" & Name_Table.Image (Id)
+                  & " attribute must be a scalar type", Attr);
+               Error_Msg_Sem
+                 ("found " & Disp_Node (Prefix_Type)
+                  & " defined at " & Disp_Location (Prefix_Type), Attr);
+               return Error_Mark;
+            end if;
+         when others =>
+            case Get_Kind (Prefix_Type) is
+               when Iir_Kinds_Discrete_Type_Definition
+                 | Iir_Kind_Physical_Subtype_Definition
+                 | Iir_Kind_Physical_Type_Definition =>
+                  null;
+               when others =>
+                  Error_Msg_Sem
+                    ("prefix of '" & Name_Table.Image (Id)
+                     & " attribute must be discrete or physical type", Attr);
+                  Error_Msg_Sem
+                    ("found " & Disp_Node (Prefix_Type)
+                     & " defined at " & Disp_Location (Prefix_Type), Attr);
+                  return Error_Mark;
+            end case;
+      end case;
+
+      --  Create the resulting node.
+      case Get_Identifier (Attr) is
+         when Name_Pos =>
+            Res := Create_Iir (Iir_Kind_Pos_Attribute);
+         when Name_Val =>
+            Res := Create_Iir (Iir_Kind_Val_Attribute);
+         when Name_Succ =>
+            Res := Create_Iir (Iir_Kind_Succ_Attribute);
+         when Name_Pred =>
+            Res := Create_Iir (Iir_Kind_Pred_Attribute);
+         when Name_Leftof =>
+            Res := Create_Iir (Iir_Kind_Leftof_Attribute);
+         when Name_Rightof =>
+            Res := Create_Iir (Iir_Kind_Rightof_Attribute);
+         when Name_Image =>
+            Res := Create_Iir (Iir_Kind_Image_Attribute);
+         when Name_Value =>
+            Res := Create_Iir (Iir_Kind_Value_Attribute);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix_Name);
+      Set_Base_Name (Res, Res);
+
+      case Get_Identifier (Attr) is
+         when Name_Pos =>
+            --  LRM93 14.1
+            --  Result type: universal_integer.
+            Set_Type (Res, Convertible_Integer_Type_Definition);
+         when Name_Val =>
+            --  LRM93 14.1
+            --  Result type: the base type of T
+            Set_Type (Res, Get_Base_Type (Prefix_Type));
+         when Name_Succ
+           | Name_Pred
+           | Name_Leftof
+           | Name_Rightof =>
+            --  LRM93 14.1
+            --  Result type: the base type of T.
+            Set_Type (Res, Get_Base_Type (Prefix_Type));
+         when Name_Image =>
+            --  LRM93 14.1
+            --  Result type: type string
+            Set_Type (Res, String_Type_Definition);
+         when Name_Value =>
+            --  LRM93 14.1
+            --  Result type: the base type of T.
+            Set_Type (Res, Get_Base_Type (Prefix_Type));
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Sem_Scalar_Type_Attribute;
+
+   --  Analyze attributes whose prefix is a type or a subtype and result is
+   --  a value (not a function).
+   function Sem_Predefined_Type_Attribute (Attr : Iir_Attribute_Name)
+     return Iir
+   is
+      use Std_Names;
+      Prefix_Name : constant Iir := Get_Prefix (Attr);
+      Id : constant Name_Id := Get_Identifier (Attr);
+      Res : Iir;
+      Prefix : Iir;
+      Prefix_Type : Iir;
+   begin
+      case Id is
+         when Name_Left =>
+            Res := Create_Iir (Iir_Kind_Left_Type_Attribute);
+         when Name_Right =>
+            Res := Create_Iir (Iir_Kind_Right_Type_Attribute);
+         when Name_High =>
+            Res := Create_Iir (Iir_Kind_High_Type_Attribute);
+         when Name_Low =>
+            Res := Create_Iir (Iir_Kind_Low_Type_Attribute);
+         when Name_Ascending =>
+            Res := Create_Iir (Iir_Kind_Ascending_Type_Attribute);
+         when Name_Range
+           | Name_Reverse_Range =>
+            Error_Msg_Sem
+              ("prefix of range attribute must be an array type or object",
+               Attr);
+            return Error_Mark;
+         when others =>
+            Error_Msg_Sem ("Attribute '" & Name_Table.Image (Id)
+                             & " not valid on this type", Attr);
+            return Error_Mark;
+      end case;
+      Location_Copy (Res, Attr);
+      Set_Base_Name (Res, Res);
+
+      Prefix := Get_Named_Entity (Prefix_Name);
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            Prefix := Finish_Sem_Name (Prefix_Name, Prefix);
+            Prefix_Type := Get_Type (Prefix);
+            Set_Expr_Staticness (Res, Get_Expr_Staticness (Prefix));
+         when Iir_Kind_Base_Attribute =>
+            --  Base_Attribute is already finished.
+            Prefix_Type := Get_Type (Prefix);
+            Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type));
+         when others =>
+            Prefix := Sem_Type_Mark (Prefix_Name);
+            Prefix_Type := Get_Type (Prefix);
+            Set_Expr_Staticness (Res, Get_Type_Staticness (Prefix_Type));
+      end case;
+      Set_Prefix (Res, Prefix);
+
+      case Get_Identifier (Attr) is
+         when Name_Ascending =>
+            --  LRM93 14.1
+            --  Result Type: type boolean.
+            Set_Type (Res, Boolean_Type_Definition);
+         when others =>
+            --  LRM 14.1
+            --  Result Type: Same type as T.
+            Set_Type (Res, Prefix_Type);
+      end case;
+      return Res;
+   end Sem_Predefined_Type_Attribute;
+
+   --  Called for attributes Length, Left, Right, High, Low, Range,
+   --  Reverse_Range, Ascending.
+   --  FIXME: handle overload
+   function Sem_Array_Attribute_Name (Attr : Iir_Attribute_Name) return Iir
+   is
+      use Std_Names;
+      Prefix: Iir;
+      Prefix_Name : constant Iir := Get_Prefix (Attr);
+      Prefix_Type : Iir;
+      Res : Iir;
+      Res_Type : Iir;
+   begin
+      Prefix := Get_Named_Entity (Prefix_Name);
+
+      --  LRM93 14.1
+      --  Prefix: Any prefix A that is appropriate for an array object, or an
+      --  alias thereof, or that denotes a constrained array subtype.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Dereference
+           | Iir_Kinds_Object_Declaration
+           | Iir_Kind_Function_Call
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Image_Attribute =>
+            --  FIXME: list of expr.
+            Prefix_Type := Get_Type (Prefix);
+            case Get_Kind (Prefix_Type) is
+               when Iir_Kind_Access_Type_Definition
+                 | Iir_Kind_Access_Subtype_Definition =>
+                  declare
+                     Designated_Type : Iir;
+                  begin
+                     Designated_Type :=
+                       Get_Designated_Type (Get_Base_Type (Prefix_Type));
+                     Prefix := Insert_Implicit_Dereference (Prefix, Attr);
+                     Prefix_Type := Designated_Type;
+                  end;
+               when Iir_Kinds_Array_Type_Definition =>
+                  null;
+               when others =>
+                  Error_Msg_Sem ("object prefix must be an array", Attr);
+                  return Error_Mark;
+            end case;
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Base_Attribute =>
+            Prefix_Type := Get_Type (Prefix);
+            if not Is_Fully_Constrained_Type (Prefix_Type) then
+               Error_Msg_Sem ("prefix type is not constrained", Attr);
+               --  We continue using the unconstrained array type.
+               --  At least, this type is valid; and even if the array was
+               --  constrained, the base type would be the same.
+            end if;
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            --  For names such as pfx'Range'Left.
+            --  Finish_Sem_Array_Attribute (Prefix_Name, Prefix, Null_Iir);
+            Prefix_Type := Get_Type (Prefix);
+         when Iir_Kind_Process_Statement =>
+            Error_Msg_Sem
+              (Disp_Node (Prefix) & " is not an appropriate prefix for '"
+               & Name_Table.Image (Get_Identifier (Attr))
+               & " attribute",
+               Attr);
+            return Error_Mark;
+         when others =>
+            Error_Msg_Sem ("prefix must denote an array object or type", Attr);
+            return Error_Mark;
+      end case;
+
+      case Get_Kind (Prefix_Type) is
+         when Iir_Kinds_Scalar_Type_Definition =>
+            --  Note: prefix is a scalar type or subtype.
+            return Sem_Predefined_Type_Attribute (Attr);
+         when Iir_Kinds_Array_Type_Definition =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              ("prefix of '"
+               & Name_Table.Image (Get_Identifier (Attr))
+               & " attribute must denote a constrained array subtype",
+               Attr);
+            return Error_Mark;
+      end case;
+
+      --  Type of the attribute.  This is correct unless there is a parameter,
+      --  and furthermore 'range and 'reverse_range has to be handled
+      --  specially because the result is a range and not a value.
+      Res_Type := Get_Index_Type (Get_Index_Subtype_List (Prefix_Type), 0);
+
+      --  Create the node for the attribute.
+      case Get_Identifier (Attr) is
+         when Name_Left =>
+            Res := Create_Iir (Iir_Kind_Left_Array_Attribute);
+         when Name_Right =>
+            Res := Create_Iir (Iir_Kind_Right_Array_Attribute);
+         when Name_High =>
+            Res := Create_Iir (Iir_Kind_High_Array_Attribute);
+         when Name_Low =>
+            Res := Create_Iir (Iir_Kind_Low_Array_Attribute);
+         when Name_Range =>
+            Res := Create_Iir (Iir_Kind_Range_Array_Attribute);
+         when Name_Reverse_Range =>
+            Res := Create_Iir (Iir_Kind_Reverse_Range_Array_Attribute);
+         when Name_Length =>
+            Res := Create_Iir (Iir_Kind_Length_Array_Attribute);
+            --  FIXME: Error if ambiguous
+            Res_Type := Convertible_Integer_Type_Definition;
+         when Name_Ascending =>
+            Res := Create_Iir (Iir_Kind_Ascending_Array_Attribute);
+            --  FIXME: Error if ambiguous
+            Res_Type := Boolean_Type_Definition;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix);
+      Set_Type (Res, Res_Type);
+      return Res;
+   end Sem_Array_Attribute_Name;
+
+   function Sem_Signal_Signal_Attribute
+     (Attr : Iir_Attribute_Name; Kind : Iir_Kind)
+     return Iir
+   is
+      Res : Iir;
+      Prefix : Iir;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+      Res := Create_Iir (Kind);
+      if Kind = Iir_Kind_Delayed_Attribute then
+         Set_Type (Res, Get_Type (Prefix));
+      elsif Kind = Iir_Kind_Transaction_Attribute then
+         Set_Type (Res, Bit_Type_Definition);
+      else
+         Set_Type (Res, Boolean_Type_Definition);
+      end if;
+      Set_Base_Name (Res, Res);
+
+      if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then
+         --  LRM93 2.1.1.2 / LRM08 4.2.2.3
+         --
+         --  It is an error if signal-valued attributes 'STABLE , 'QUIET,
+         --  'TRANSACTION, and 'DELAYED of formal signal paramaters of any
+         --  mode are read within a subprogram.
+         case Get_Kind (Get_Parent (Prefix)) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Error_Msg_Sem
+                 ("'" & Name_Table.Image (Get_Identifier (Attr)) &
+                  " is not allowed for a signal parameter", Attr);
+            when others =>
+               null;
+         end case;
+      end if;
+      Sem_Stmts.Add_Declaration_For_Implicit_Signal (Res);
+      return Res;
+   end Sem_Signal_Signal_Attribute;
+
+   function Sem_Signal_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      use Std_Names;
+      Prefix: Iir;
+      Res : Iir;
+      Base : Iir;
+   begin
+      Prefix := Get_Named_Entity (Get_Prefix (Attr));
+      Base := Get_Object_Prefix (Prefix);
+      case Get_Kind (Base) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kinds_Signal_Attribute =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              ("prefix of '"
+               & Name_Table.Image (Get_Identifier (Attr))
+               & " attribute must denote a signal", Attr);
+            return Error_Mark;
+      end case;
+      case Get_Identifier (Attr) is
+         when Name_Stable =>
+            Res := Sem_Signal_Signal_Attribute
+              (Attr, Iir_Kind_Stable_Attribute);
+         when Name_Quiet =>
+            Res := Sem_Signal_Signal_Attribute
+              (Attr, Iir_Kind_Quiet_Attribute);
+         when Name_Delayed =>
+            Res := Sem_Signal_Signal_Attribute
+              (Attr, Iir_Kind_Delayed_Attribute);
+         when Name_Transaction =>
+            Res := Sem_Signal_Signal_Attribute
+              (Attr, Iir_Kind_Transaction_Attribute);
+         when Name_Event =>
+            Res := Create_Iir (Iir_Kind_Event_Attribute);
+            Set_Type (Res, Boolean_Type_Definition);
+         when Name_Active =>
+            Res := Create_Iir (Iir_Kind_Active_Attribute);
+            Set_Type (Res, Boolean_Type_Definition);
+         when Name_Last_Value =>
+            Res := Create_Iir (Iir_Kind_Last_Value_Attribute);
+            Set_Type (Res, Get_Type (Prefix));
+         when Name_Last_Event =>
+            Res := Create_Iir (Iir_Kind_Last_Event_Attribute);
+            Set_Type (Res, Time_Type_Definition);
+         when Name_Last_Active =>
+            Res := Create_Iir (Iir_Kind_Last_Active_Attribute);
+            Set_Type (Res, Time_Type_Definition);
+         when Name_Driving_Value =>
+            Res := Create_Iir (Iir_Kind_Driving_Value_Attribute);
+            Set_Type (Res, Get_Type (Prefix));
+            --  FIXME: check restrictions.
+         when Name_Driving =>
+            Res := Create_Iir (Iir_Kind_Driving_Attribute);
+            Set_Type (Res, Boolean_Type_Definition);
+            --  FIXME: check restrictions.
+         when others =>
+            --  Not yet implemented attribute, or really an internal error.
+            raise Internal_Error;
+      end case;
+      Location_Copy (Res, Attr);
+
+      --  LRM 4.3.2
+      --  The value of an object is said to be read when one of the following
+      --  conditions is satisfied:
+      --  [...]
+      --  * When the object is a signal and the value of any of its predefined
+      --    attributes 'STABLE, 'QUIET, 'DELAYED, 'TRANSACTION, 'EVENT,
+      --    'ACTIVE, 'LAST_EVENT, 'LAST_ACTIVE, or 'LAST_VALUE is read.
+
+      --  LRM 14.1
+      --  S'Driving Restrictions:
+      --  S'Driving_Value Restrictions:
+      --  This attribute is available only from within a process, a
+      --  concurrent statement with an equivalent process, or a subprogram.
+      --  If the prefix denotes a port, it is an error if the port does not
+      --  have a mode of INOUT, OUT or BUFFER.  It is also an error if the
+      --  attribute name appears in a subprogram body that is not a declarative
+      --  item contained within a process statement and the prefix is not a
+      --  formal parameter of the given subprogram or of a parent of that
+      --  subprogram.  Finally, it is an error if the prefix denotes a
+      --  subprogram formal parameter whose mode is not INOUT or OUT, or if
+      --  S'Driving is False at the time of the evaluation of S'Driving_Value.
+      case Get_Kind (Res) is
+         when Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Event_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Event_Attribute
+           | Iir_Kind_Last_Active_Attribute
+           | Iir_Kind_Last_Value_Attribute =>
+            Check_Read (Prefix);
+         when Iir_Kind_Driving_Attribute
+           | Iir_Kind_Driving_Value_Attribute =>
+            --  FIXME: complete checks.
+            if Get_Current_Concurrent_Statement = Null_Iir then
+               Error_Msg_Sem
+                 ("'driving or 'driving_value is available only within a "
+                  & "concurrent statement", Attr);
+            else
+               case Get_Kind (Get_Current_Concurrent_Statement) is
+                  when Iir_Kinds_Process_Statement
+                    | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+                    | Iir_Kind_Concurrent_Selected_Signal_Assignment
+                    | Iir_Kind_Concurrent_Procedure_Call_Statement =>
+                     null;
+                  when others =>
+                     Error_Msg_Sem
+                       ("'driving or 'driving_value not available within "
+                        & "this concurrent statement", Attr);
+               end case;
+            end if;
+
+            case Get_Kind (Base) is
+               when Iir_Kind_Signal_Declaration =>
+                  null;
+               when Iir_Kind_Interface_Signal_Declaration =>
+                  case Get_Mode (Base) is
+                     when Iir_Buffer_Mode
+                       | Iir_Inout_Mode
+                       | Iir_Out_Mode =>
+                        null;
+                     when others =>
+                        Error_Msg_Sem
+                          ("mode of 'driving or 'driving_value prefix must "
+                           & "be out, inout or buffer", Attr);
+                  end case;
+               when others =>
+                  Error_Msg_Sem
+                    ("bad prefix for 'driving or 'driving_value", Attr);
+            end case;
+         when others =>
+            null;
+      end case;
+
+      --  According to LRM 7.4, signal attributes are not static expressions
+      --  since the prefix (a signal) is not a static expression.
+      Set_Expr_Staticness (Res, None);
+
+      --  LRM 6.1
+      --  A name is said to be a static name if and only if at least one of
+      --  the following conditions holds:
+      --  [...]
+      --  -  The name is a attribute name whose prefix is a static signal name
+      --     and whose suffix is one of the predefined attributes 'DELAYED,
+      --     'STABLE, 'QUIET or 'TRANSACTION.
+      --  According to LRM 6.1, attributes are not static names.
+      if Flags.Vhdl_Std = Vhdl_93c or Flags.Vhdl_Std >= Vhdl_02 then
+         case Get_Kind (Res) is
+            when Iir_Kind_Stable_Attribute
+              | Iir_Kind_Quiet_Attribute
+              | Iir_Kind_Delayed_Attribute
+              | Iir_Kind_Transaction_Attribute =>
+               Set_Name_Staticness (Res, Get_Name_Staticness (Prefix));
+            when others =>
+               Set_Name_Staticness (Res, None);
+         end case;
+      else
+         Set_Name_Staticness (Res, None);
+      end if;
+
+      Set_Prefix (Res, Prefix);
+
+      --  Set has_active_flag when activity is read.
+      case Get_Kind (Res) is
+         when Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Active_Attribute
+           | Iir_Kind_Last_Active_Attribute =>
+            Set_Has_Active_Flag (Base, True);
+         when others =>
+            null;
+      end case;
+
+      return Res;
+   end Sem_Signal_Attribute;
+
+   --  'Simple_name, 'instance_name and 'path_name.
+   function Sem_Name_Attribute (Attr : Iir_Attribute_Name) return Iir
+   is
+      use Std_Names;
+      Prefix_Name : constant Iir := Get_Prefix (Attr);
+      Prefix: Iir;
+      Res : Iir;
+      Attr_Type : Iir;
+   begin
+      Prefix := Get_Named_Entity (Prefix_Name);
+      Set_Prefix (Attr, Finish_Sem_Name (Prefix_Name, Prefix));
+
+      --  LRM 14.1  Predefined attributes
+      --  E'SIMPLE_NAME
+      --    Prefix: Any named entity as defined in 5.1
+      --  E'INSTANCE_NAME
+      --    Prefix: Any named entity other than the local ports and generics
+      --       of a component declaration.
+      --  E'PATH_NAME
+      --    Prefix: Any named entity other than the local ports and generics
+      --       of a component declaration.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kinds_Library_Unit_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_Constant_Declaration =>
+            if Get_Identifier (Attr) /= Name_Simple_Name
+              and then Get_Kind (Get_Parent (Prefix))
+              = Iir_Kind_Component_Declaration
+            then
+               Error_Msg_Sem
+                 ("local ports or generics of a component cannot be a prefix",
+                  Attr);
+            end if;
+         when others =>
+            Error_Msg_Sem (Disp_Node (Prefix) & " is not a named entity",
+                           Attr);
+      end case;
+
+      case Get_Identifier (Attr) is
+         when Name_Simple_Name =>
+            Res := Create_Iir (Iir_Kind_Simple_Name_Attribute);
+            Eval_Simple_Name (Get_Identifier (Prefix));
+            Set_Simple_Name_Identifier (Res, Name_Table.Get_Identifier);
+            Attr_Type := Create_Unidim_Array_By_Length
+              (String_Type_Definition,
+               Iir_Int64 (Name_Table.Name_Length),
+               Attr);
+            Set_Simple_Name_Subtype (Res, Attr_Type);
+            Set_Expr_Staticness (Res, Locally);
+
+         when Name_Path_Name =>
+            Res := Create_Iir (Iir_Kind_Path_Name_Attribute);
+            Set_Expr_Staticness (Res, Globally);
+            Attr_Type := String_Type_Definition;
+
+         when Name_Instance_Name =>
+            Res := Create_Iir (Iir_Kind_Instance_Name_Attribute);
+            Set_Expr_Staticness (Res, Globally);
+            Attr_Type := String_Type_Definition;
+
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Location_Copy (Res, Attr);
+      Set_Prefix (Res, Prefix_Name);
+      Set_Type (Res, Attr_Type);
+      return Res;
+   end Sem_Name_Attribute;
+
+   procedure Sem_Attribute_Name (Attr : Iir_Attribute_Name)
+   is
+      use Std_Names;
+      Prefix : Iir;
+      Res : Iir;
+      Sig : Iir_Signature;
+   begin
+      --  LRM93 6.6  Attribute names
+      --  The meaning of the prefix of an attribute name must be determinable
+      --  independently of the attribute designator and independently of the
+      --  fact that it is the prefix of an attribute.
+      Prefix := Get_Prefix (Attr);
+
+      --  LRM93 6.6
+      --  If the prefix of an attribute name denotes an alias, then the
+      --  attribute name denotes an attribute of the aliased name and not the
+      --  alias itself, except when the attribute designator denotes any of
+      --  the predefined attributes 'Simple_Name, 'Path_Name or 'Instance_Name.
+      --  If the prefix of an attribute name denotes an alias and the
+      --  attribute designator denotes any of the predefined attributes
+      --  'Simple_Name, 'Path_Name or 'Instance_Name, then the attribute name
+      --  denotes the attribute of the alias and not of the aliased name.
+      if Flags.Vhdl_Std > Vhdl_87
+        and then Get_Identifier (Attr) in Name_Id_Name_Attributes
+      then
+         Sem_Name (Prefix, True);
+      else
+         Sem_Name (Prefix, False);
+      end if;
+      Prefix := Get_Named_Entity (Prefix);
+
+      if Prefix = Error_Mark then
+         Set_Named_Entity (Attr, Prefix);
+         return;
+      end if;
+
+      --  LRM93 6.6
+      --  A signature may follow the prefix if and only if the prefix denotes
+      --  a subprogram or enumeration literal, or an alias thereof.
+      --  In this case, the signature is required to match (see Section 2.3.2)
+      --  the parameter and result type profile of exactly one visible
+      --  subprogram or enumeration literal, as is appropriate to the prefix.
+      -- GHDL: this is done by Sem_Signature.
+      Sig := Get_Attribute_Signature (Attr);
+      if Sig /= Null_Iir then
+         Prefix := Sem_Signature (Prefix, Sig);
+         if Prefix = Null_Iir then
+            Set_Named_Entity (Attr, Error_Mark);
+            return;
+         end if;
+         Set_Named_Entity (Get_Prefix (Attr), Prefix);
+      end if;
+
+      if Get_Kind (Prefix) = Iir_Kind_Overload_List then
+         --  FIXME: this should be allowed.
+         Error_Msg_Sem ("prefix of attribute is overloaded", Attr);
+         Set_Named_Entity (Attr, Error_Mark);
+         return;
+      end if;
+
+      --  Set_Prefix (Attr, Finish_Sem_Name (Get_Prefix (Attr), Prefix));
+
+      case Get_Identifier (Attr) is
+         when Name_Base =>
+            Res := Sem_Base_Attribute (Attr);
+         when Name_Image
+           | Name_Value =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Res := Sem_Scalar_Type_Attribute (Attr);
+            else
+               Res := Sem_User_Attribute (Attr);
+            end if;
+
+         when Name_Pos
+           | Name_Val
+           | Name_Succ
+           | Name_Pred
+           | Name_Rightof
+           | Name_Leftof =>
+            Res := Sem_Scalar_Type_Attribute (Attr);
+
+         when Name_Length
+           | Name_Left
+           | Name_Right
+           | Name_High
+           | Name_Low
+           | Name_Range
+           | Name_Reverse_Range =>
+            Res := Sem_Array_Attribute_Name (Attr);
+
+         when Name_Ascending =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Res := Sem_Array_Attribute_Name (Attr);
+            else
+               Res := Sem_User_Attribute (Attr);
+            end if;
+
+         when Name_Stable
+           | Name_Event
+           | Name_Last_Value
+           | Name_Delayed
+           | Name_Quiet
+           | Name_Transaction
+           | Name_Active
+           | Name_Last_Active
+           | Name_Last_Event =>
+            Res := Sem_Signal_Attribute (Attr);
+
+         when Name_Driving
+           | Name_Driving_Value =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Res := Sem_Signal_Attribute (Attr);
+            else
+               Res := Sem_User_Attribute (Attr);
+            end if;
+
+         when Name_Simple_Name
+           | Name_Path_Name
+           | Name_Instance_Name =>
+            if Flags.Vhdl_Std > Vhdl_87 then
+               Res := Sem_Name_Attribute (Attr);
+            else
+               Res := Sem_User_Attribute (Attr);
+            end if;
+
+         when others =>
+            Res := Sem_User_Attribute (Attr);
+      end case;
+
+      if Res = Null_Iir then
+         Error_Kind ("sem_attribute_name", Attr);
+      end if;
+      Set_Named_Entity (Attr, Res);
+   end Sem_Attribute_Name;
+
+   --  LRM93 §6
+   procedure Sem_Name (Name : Iir; Keep_Alias : Boolean := False) is
+   begin
+      --  Exit now if NAME was already semantized.
+      if Get_Named_Entity (Name) /= Null_Iir then
+         return;
+      end if;
+
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Operator_Symbol =>
+            --  String_Literal may be a symbol_operator.
+            Sem_Simple_Name (Name, Keep_Alias, Soft => False);
+         when Iir_Kind_Selected_Name =>
+            Sem_Selected_Name (Name, Keep_Alias);
+         when Iir_Kind_Parenthesis_Name =>
+            Sem_Parenthesis_Name (Name);
+         when Iir_Kind_Selected_By_All_Name =>
+            Sem_Selected_By_All_Name (Name);
+         when Iir_Kind_Attribute_Name =>
+            Sem_Attribute_Name (Name);
+         when others =>
+            Error_Kind ("sem_name", Name);
+      end case;
+   end Sem_Name;
+
+   procedure Sem_Name_Soft (Name : Iir)
+   is
+   begin
+      --  Exit now if NAME was already semantized.
+      if Get_Named_Entity (Name) /= Null_Iir then
+         return;
+      end if;
+
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Operator_Symbol =>
+            --  String_Literal may be a symbol_operator.
+            Sem_Simple_Name (Name, False, Soft => True);
+         when others =>
+            Error_Kind ("sem_name_soft", Name);
+      end case;
+   end Sem_Name_Soft;
+
+   procedure Sem_Name_Clean (Name : Iir)
+   is
+      N : Iir;
+      Next_N : Iir;
+      Named_Entity : Iir;
+      Atype : Iir;
+   begin
+      N := Name;
+      while N /= Null_Iir loop
+         case Get_Kind (N) is
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Operator_Symbol =>
+               Next_N := Null_Iir;
+            when others =>
+               Error_Kind ("sem_name_clean", N);
+         end case;
+
+         --  Clear and free overload lists of Named_entity and type.
+         Named_Entity := Get_Named_Entity (N);
+         Set_Named_Entity (N, Null_Iir);
+         if Named_Entity /= Null_Iir
+           and then Is_Overload_List (Named_Entity)
+         then
+            Free_Iir (Named_Entity);
+         end if;
+
+         Atype := Get_Type (N);
+         Set_Type (N, Null_Iir);
+         if Atype /= Null_Iir
+           and then Is_Overload_List (Atype)
+         then
+            Free_Iir (Atype);
+         end if;
+
+         N := Next_N;
+      end loop;
+   end Sem_Name_Clean;
+
+   --  Remove procedure specification from LIST.
+   function Remove_Procedures_From_List (Expr : Iir) return Iir
+   is
+      El : Iir;
+      P : Natural;
+      List : Iir_List;
+   begin
+      if not Is_Overload_List (Expr) then
+         return Expr;
+      end if;
+      List := Get_Overload_List (Expr);
+      P := 0;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         case Get_Kind (El) is
+            when Iir_Kinds_Procedure_Declaration =>
+               null;
+            when Iir_Kinds_Function_Declaration =>
+               if Maybe_Function_Call (El) then
+                  Replace_Nth_Element (List, P, El);
+                  P := P + 1;
+               end if;
+            when others =>
+               Replace_Nth_Element (List, P, El);
+               P := P + 1;
+         end case;
+      end loop;
+      case P is
+         when 0 =>
+            Free_Iir (Expr);
+            return Null_Iir;
+         when 1 =>
+            El := Get_First_Element (List);
+            Free_Iir (Expr);
+            return El;
+         when others =>
+            Set_Nbr_Elements (List, P);
+            return Expr;
+      end case;
+   end Remove_Procedures_From_List;
+
+   --  Convert name EXPR to an expression (ie, create function call).
+   --  A_TYPE is the expected type of the expression.
+   --  Returns NULL_IIR in case of error.
+   function Name_To_Expression (Name : Iir; A_Type : Iir) return Iir
+   is
+      Ret_Type : Iir;
+      Res_Type : Iir;
+      Expr : Iir;
+      Expr_List : Iir_List;
+      Res : Iir;
+      El : Iir;
+   begin
+      Expr := Get_Named_Entity (Name);
+      if Get_Kind (Expr) = Iir_Kind_Error then
+         return Null_Iir;
+      end if;
+      if Check_Is_Expression (Expr, Name) = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      --  Note: EXPR may contain procedure names...
+      Expr := Remove_Procedures_From_List (Expr);
+      Set_Named_Entity (Name, Expr);
+      if Expr = Null_Iir then
+         Error_Msg_Sem ("procedure name " & Disp_Node (Name)
+                        & " cannot be used as expression", Name);
+         return Null_Iir;
+      end if;
+
+      if not Is_Overload_List (Expr) then
+         Res := Finish_Sem_Name (Name);
+         pragma Assert (Res /= Null_Iir);
+         if A_Type /= Null_Iir then
+            Res_Type := Get_Type (Res);
+            if Res_Type = Null_Iir then
+               return Null_Iir;
+            end if;
+            if not Are_Basetypes_Compatible (Get_Base_Type (Res_Type), A_Type)
+            then
+               Error_Not_Match (Res, A_Type, Name);
+               return Null_Iir;
+            end if;
+            --  Fall through.
+         end if;
+      else
+         --  EXPR is an overloaded name.
+         Expr_List := Get_Overload_List (Expr);
+
+         if A_Type /= Null_Iir then
+            --  Find the name returning A_TYPE.
+            Res := Null_Iir;
+            for I in Natural loop
+               El := Get_Nth_Element (Expr_List, I);
+               exit when El = Null_Iir;
+               if Are_Basetypes_Compatible (Get_Base_Type (Get_Type (El)),
+                                            A_Type)
+               then
+                  Add_Result (Res, El);
+               end if;
+            end loop;
+            if Res = Null_Iir then
+               Error_Not_Match (Name, A_Type, Name);
+               return Null_Iir;
+            elsif Is_Overload_List (Res) then
+               Error_Overload (Name);
+               Disp_Overload_List (Get_Overload_List (Res), Name);
+               return Null_Iir;
+            else
+               --  Free results
+               Sem_Name_Free_Result (Expr, Res);
+
+               Ret_Type := Get_Type (Name);
+               if Ret_Type /= Null_Iir then
+                  pragma Assert (Is_Overload_List (Ret_Type));
+                  Free_Overload_List (Ret_Type);
+               end if;
+
+               Set_Named_Entity (Name, Res);
+               Res := Finish_Sem_Name (Name);
+               --  Fall through.
+            end if;
+         else
+            --  Create a list of type.
+            Ret_Type := Create_List_Of_Types (Expr_List);
+            if Ret_Type = Null_Iir or else not Is_Overload_List (Ret_Type) then
+               --  There is either no types or one type for
+               --  several meanings.
+               Error_Overload (Name);
+               Disp_Overload_List (Expr_List, Name);
+               --Free_Iir (Ret_Type);
+               return Null_Iir;
+            end if;
+            Set_Type (Name, Ret_Type);
+            return Name;
+         end if;
+      end if;
+
+      --  NAME has only one meaning, which is RES.
+      case Get_Kind (Res) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Selected_Name =>
+            Expr := Get_Named_Entity (Res);
+            case Get_Kind (Expr) is
+               when Iir_Kind_Implicit_Function_Declaration
+                 | Iir_Kind_Function_Declaration =>
+                  if Maybe_Function_Call (Expr) then
+                     Expr := Sem_As_Function_Call (Res, Expr, Null_Iir);
+                     if Get_Kind (Expr) /= Iir_Kind_Function_Call then
+                        raise Internal_Error;
+                     end if;
+                     Finish_Sem_Function_Call (Expr, Res);
+                     return Expr;
+                  else
+                     Error_Msg_Sem
+                       (Disp_Node (Expr) & " requires parameters", Res);
+                     Set_Type (Res, Get_Type (Expr));
+                     Set_Expr_Staticness (Res, None);
+                     return Res;
+                  end if;
+               when others =>
+                  null;
+            end case;
+            Set_Type (Res, Get_Type (Expr));
+            Set_Expr_Staticness (Res, Get_Expr_Staticness (Expr));
+            --Set_Name_Staticness (Name, Get_Name_Staticness (Expr));
+            --Set_Base_Name (Name, Get_Base_Name (Expr));
+            return Res;
+         when Iir_Kind_Function_Call
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Type_Conversion
+           | Iir_Kind_Attribute_Name =>
+            return Eval_Expr_If_Static (Res);
+         when Iir_Kind_Dereference =>
+            --  Never static.
+            return Res;
+         when Iir_Kinds_Array_Attribute =>
+            --  FIXME: exclude range and reverse_range.
+            return Eval_Expr_If_Static (Res);
+         when Iir_Kinds_Signal_Attribute
+           | Iir_Kinds_Signal_Value_Attribute =>
+            --  Never static
+            return Res;
+         when Iir_Kinds_Type_Attribute
+           | Iir_Kinds_Scalar_Type_Attribute
+           | Iir_Kind_Image_Attribute
+           | Iir_Kind_Value_Attribute
+           | Iir_Kind_Simple_Name_Attribute
+           | Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute =>
+            return Eval_Expr_If_Static (Res);
+         when Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Selected_By_All_Name =>
+            raise Internal_Error;
+         when others =>
+            Error_Kind ("name_to_expression", Res);
+      end case;
+   end Name_To_Expression;
+
+   function Name_To_Range (Name : Iir) return Iir
+   is
+      Expr : Iir;
+   begin
+      Expr := Get_Named_Entity (Name);
+      if Get_Kind (Expr) = Iir_Kind_Error then
+         return Error_Mark;
+      end if;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Type_Declaration =>
+            Expr := Sem_Type_Mark (Name);
+            Set_Expr_Staticness
+              (Expr, Get_Type_Staticness (Get_Type (Expr)));
+            return Expr;
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            if Get_Parameter (Expr) = Null_Iir then
+               Finish_Sem_Array_Attribute (Name, Expr, Null_Iir);
+            end if;
+            if Get_Kind (Name) = Iir_Kind_Attribute_Name then
+               Free_Iir (Name);
+            else
+               Free_Iir (Get_Prefix (Name));
+               Free_Parenthesis_Name (Name, Expr);
+            end if;
+            return Expr;
+         when others =>
+            Error_Msg_Sem ("name " & Disp_Node (Name)
+                             & " doesn't denote a range", Name);
+            return Error_Mark;
+      end case;
+   end Name_To_Range;
+
+   function Is_Object_Name (Name : Iir) return Boolean is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Function_Call
+           | Iir_Kinds_Attribute =>
+            return True;
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return False;
+         when others =>
+            return False;
+      end case;
+   end Is_Object_Name;
+
+   function Name_To_Object (Name : Iir) return Iir is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Function_Call
+           | Iir_Kinds_Signal_Attribute =>
+            return Name;
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return Name_To_Object (Get_Named_Entity (Name));
+         when others =>
+            return Null_Iir;
+      end case;
+   end Name_To_Object;
+
+   function Create_Error_Name (Orig : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Error);
+      Set_Expr_Staticness (Res, None);
+      Set_Error_Origin (Res, Orig);
+      Location_Copy (Res, Orig);
+      return Res;
+   end Create_Error_Name;
+
+   function Sem_Denoting_Name (Name: Iir) return Iir
+   is
+      Res: Iir;
+   begin
+      pragma Assert (Get_Kind (Name) in Iir_Kinds_Denoting_Name);
+
+      Sem_Name (Name);
+      Res := Get_Named_Entity (Name);
+
+      case Get_Kind (Res) is
+         when Iir_Kind_Error =>
+            --  A message must have been displayed.
+            return Name;
+         when Iir_Kind_Overload_List =>
+            Error_Overload (Res);
+            Set_Named_Entity (Name, Create_Error_Name (Name));
+            return Name;
+         when Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement
+           | Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Enumeration_Literal
+           | Iir_Kind_Unit_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kinds_Object_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Library_Declaration
+           | Iir_Kinds_Subprogram_Declaration
+           | Iir_Kind_Component_Declaration =>
+            Res := Finish_Sem_Name (Name, Res);
+            pragma Assert (Get_Kind (Res) in Iir_Kinds_Denoting_Name);
+            return Res;
+         when Iir_Kind_Selected_Element =>
+            --  An error (to be diagnosticed by the caller).
+            return Name;
+         when others =>
+            Error_Kind ("sem_denoting_name", Res);
+      end case;
+   end Sem_Denoting_Name;
+
+   function Sem_Terminal_Name (Name : Iir) return Iir
+   is
+      Res : Iir;
+      Ent : Iir;
+   begin
+      Res := Sem_Denoting_Name (Name);
+      Ent := Get_Named_Entity (Res);
+      if Get_Kind (Ent) /= Iir_Kind_Terminal_Declaration then
+         Error_Class_Match (Name, "terminal");
+         Set_Named_Entity (Res, Create_Error_Name (Name));
+      end if;
+      return Res;
+   end Sem_Terminal_Name;
+
+   procedure Error_Class_Match (Name : Iir; Class_Name : String)
+   is
+      Ent : constant Iir := Get_Named_Entity (Name);
+   begin
+      if Is_Error (Ent) then
+         Error_Msg_Sem (Class_Name & " name expected", Name);
+      else
+         Error_Msg_Sem
+           (Class_Name & " name expected, found "
+              & Disp_Node (Get_Named_Entity (Name)), Name);
+      end if;
+   end Error_Class_Match;
+end Sem_Names;
diff --git a/src/sem_names.ads b/src/sem_names.ads
new file mode 100644
index 000000000..3bc85305d
--- /dev/null
+++ b/src/sem_names.ads
@@ -0,0 +1,159 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Sem_Names is
+   --  In VHDL, most of name notations are ambiguous:
+   --   P.N is either
+   --     an expanded name or
+   --     a selected name for an element (with a possible implicit dereference)
+   --   P (A1, A2, ...) can be
+   --     an indexed name (with a possible implicit dereference)
+   --     a slice name (with a possible implicit dereference)
+   --     a subprogram call
+   --     a type conversion
+
+   --  The name analysis resolves two ambiguities: notation and overload.
+   --  In a first pass, all possible meaning are collected as an overload
+   --  list in the Named_Entity field of the name.  Prefixes in that list
+   --  are always declarations and not simple or expanded names.  This is done
+   --  to avoid creating nodes for simple or expanded names, as they cannot be
+   --  shared in the prefixes because they can have several meanings.
+   --
+   --  In a second pass, when the caller has resolved the overloading (using
+   --  the context), the name is rewritten: parenthesis and selected names are
+   --  replaced (by slice, index, call, element selection...).  Prefixes are
+   --  simple or expanded names (and never declarations).  Checks are also
+   --  performed on the result (pure, all sensitized).
+   --
+   --  The result of the name analysis may not be a name: a function_call or
+   --  a type conversion are not names.
+
+   --  Analyze NAME: perform the first pass only.  In case of error, a message
+   --  is displayed and the named entity is error_mark.
+   procedure Sem_Name (Name : Iir; Keep_Alias : Boolean := False);
+
+   --  Finish semantisation of NAME, if necessary.  The named entity must not
+   --  be an overload list (ie the overload resolution must have been done).
+   --  This make remaining checks, transforms function names into calls...
+   function Finish_Sem_Name (Name : Iir) return Iir;
+
+   --  Analyze NAME as a type mark.  NAME must be either a simple name or an
+   --  expanded name, and the denoted entity must be either a type or a subtype
+   --  declaration.  Return the name (possibly modified) and set named_entity
+   --  and type.  In case of error, the type is error_mark.  NAME may have
+   --  already been analyzed by Sem_Name.
+   --  Incomplete types are allowed only if INCOMPLETE is True.
+   function Sem_Type_Mark (Name : Iir; Incomplete : Boolean := False)
+                          return Iir;
+
+   --  Same as Sem_Name but without any side-effect:
+   --  * do not report error
+   --  * do not set xrefs
+   --  Currently, only simple names (and expanded names) are handled.
+   --  This is to be used during sem of associations.  Because there is no side
+   --  effect, NAME is not modified.
+   procedure Sem_Name_Soft (Name : Iir);
+
+   --  Remove every named_entity of NAME.
+   --  If NAME is Null_Iir then this is no op.
+   --  To be used only for names (weakly) semantized by sem_name_soft.
+   procedure Sem_Name_Clean (Name : Iir);
+
+   --  Return TRUE if NAME is a name that designate an object (ie a constant,
+   --  a variable, a signal or a file).
+   function Is_Object_Name (Name : Iir) return Boolean;
+
+   --  Return an object node if NAME designates an object (ie either is an
+   --  object or a name for an object).
+   --  Otherwise, returns NULL_IIR.
+   function Name_To_Object (Name : Iir) return Iir;
+
+   --  If NAME is a selected name whose prefix is a protected variable, set
+   --  method_object of CALL.
+   procedure Name_To_Method_Object (Call : Iir; Name : Iir);
+
+   --  Convert name NAME to an expression (ie, can create function call).
+   --  A_TYPE is the expected type of the expression.
+   --  FIXME: it is unclear wether the result must be an expression or not
+   --  (ie, it *must* have a type, but may be a range).
+   function Name_To_Expression (Name : Iir; A_Type : Iir) return Iir;
+
+   --  Finish analyze of NAME and expect a range (either a type or subtype
+   --  declaration or a range attribute).  Return Error_Mark in case of error.
+   function Name_To_Range (Name : Iir) return Iir;
+
+   -- Return true if AN_IIR is an overload list.
+   function Is_Overload_List (An_Iir: Iir) return Boolean;
+   pragma Inline (Is_Overload_List);
+
+   -- Create an overload list, that must be destroyed by Destroy_Overload_List.
+   function Get_Overload_List return Iir_Overload_List;
+   pragma Inline (Get_Overload_List);
+
+   function Create_Overload_List (List : Iir_List) return Iir_Overload_List;
+   pragma Inline (Create_Overload_List);
+
+   --  Free the list node (and the list itself).
+   procedure Free_Overload_List (N : in out Iir_Overload_List);
+
+   --  Display an error message if the overload resolution for EXPR find more
+   --  than one interpretation.
+   procedure Error_Overload (Expr: Iir);
+
+   --  Disp the overload list LIST.
+   procedure Disp_Overload_List (List : Iir_List; Loc : Iir);
+
+   --  Convert a list to either Null_Iir, an element or an overload list.
+   function Simplify_Overload_List (List : Iir_List) return Iir;
+
+   --  Add new interpretation DECL to RES.
+   --  Create an overload_list if necessary.
+   --  Before the first call, RES should be set to NULL_IIR.
+   procedure Add_Result (Res : in out Iir; Decl : Iir);
+
+   --  Free a Parenthesis_Name.  This is a special case as in general the
+   --  Association_Chain field must be freed too.
+   procedure Free_Parenthesis_Name (Name : Iir; Res : Iir);
+
+   --  Return TRUE iff TYPE1 and TYPE2 are closely related.
+   function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean;
+
+   --  From the list LIST of function or enumeration literal, extract the
+   --  list of (return) types.
+   --  If there is only one type, return it.
+   --  If there is no types, return NULL.
+   --  Otherwise, return the list as an overload list.
+   function Create_List_Of_Types (List : Iir_List) return Iir;
+
+   function Sem_Index_Specification (Name : Iir_Parenthesis_Name; Itype : Iir)
+                                    return Iir;
+
+   --  Analyze denoting name NAME.  NAME must be either a simple name or an
+   --  expanded name and so is the result.
+   function Sem_Denoting_Name (Name: Iir) return Iir;
+
+   --  Like Sem_Denoting_Name but expect a terminal name.
+   function Sem_Terminal_Name (Name : Iir) return Iir;
+
+   --  Emit an error for NAME that doesn't match its class CLASS_NAME.
+   procedure Error_Class_Match (Name : Iir; Class_Name : String);
+
+   --  Create an error node for name ORIG; set its expr staticness to none.
+   function Create_Error_Name (Orig : Iir) return Iir;
+end Sem_Names;
diff --git a/src/sem_psl.adb b/src/sem_psl.adb
new file mode 100644
index 000000000..cae63f740
--- /dev/null
+++ b/src/sem_psl.adb
@@ -0,0 +1,617 @@
+--  Semantic analysis pass for PSL.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with PSL.Nodes; use PSL.Nodes;
+with PSL.Subsets;
+with PSL.Hash;
+
+with Sem_Expr;
+with Sem_Stmts; use Sem_Stmts;
+with Sem_Scopes;
+with Sem_Names;
+with Std_Names;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package;
+with Ieee.Std_Logic_1164;
+with Errorout; use Errorout;
+with Xrefs; use Xrefs;
+
+package body Sem_Psl is
+   --  Return TRUE iff Atype is a PSL boolean type.
+   --  See PSL1.1 5.1.2  Boolean expressions
+   function Is_Psl_Bool_Type (Atype : Iir) return Boolean
+   is
+      Btype : Iir;
+   begin
+      if Atype = Null_Iir then
+         return False;
+      end if;
+      Btype := Get_Base_Type (Atype);
+      return Btype = Std_Package.Boolean_Type_Definition
+        or else Btype = Std_Package.Bit_Type_Definition
+        or else Btype = Ieee.Std_Logic_1164.Std_Ulogic_Type;
+   end Is_Psl_Bool_Type;
+
+   --  Return TRUE if EXPR type is a PSL boolean type.
+   function Is_Psl_Bool_Expr (Expr : Iir) return Boolean is
+   begin
+      return Is_Psl_Bool_Type (Get_Type (Expr));
+   end Is_Psl_Bool_Expr;
+
+   --  Convert VHDL and/or/not nodes to PSL nodes.
+   function Convert_Bool (Expr : Iir) return Node
+   is
+      use Std_Names;
+      Impl : Iir;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kinds_Dyadic_Operator =>
+            declare
+               Left : Iir;
+               Right : Iir;
+
+               function Build_Op (Kind : Nkind) return Node
+               is
+                  N : Node;
+               begin
+                  N := Create_Node (Kind);
+                  Set_Location (N, Get_Location (Expr));
+                  Set_Left (N, Convert_Bool (Left));
+                  Set_Right (N, Convert_Bool (Right));
+                  Free_Iir (Expr);
+                  return N;
+               end Build_Op;
+            begin
+               Impl := Get_Implementation (Expr);
+               Left := Get_Left (Expr);
+               Right := Get_Right (Expr);
+               if Impl /= Null_Iir
+                 and then Is_Psl_Bool_Expr (Left)
+                 and then Is_Psl_Bool_Expr (Right)
+               then
+                  if Get_Identifier (Impl) = Name_And then
+                     return Build_Op (N_And_Bool);
+                  elsif Get_Identifier (Impl) = Name_Or then
+                     return Build_Op (N_Or_Bool);
+                  end if;
+               end if;
+            end;
+         when Iir_Kinds_Monadic_Operator =>
+            declare
+               Operand : Iir;
+
+               function Build_Op (Kind : Nkind) return Node
+               is
+                  N : Node;
+               begin
+                  N := Create_Node (Kind);
+                  Set_Location (N, Get_Location (Expr));
+                  Set_Boolean (N, Convert_Bool (Operand));
+                  Free_Iir (Expr);
+                  return N;
+               end Build_Op;
+            begin
+               Impl := Get_Implementation (Expr);
+               Operand := Get_Operand (Expr);
+               if Impl /= Null_Iir
+                 and then Is_Psl_Bool_Expr (Operand)
+               then
+                  if Get_Identifier (Impl) = Name_Not then
+                     return Build_Op (N_Not_Bool);
+                  end if;
+               end if;
+            end;
+         when Iir_Kinds_Name =>
+            --  Get the named entity for names in order to hash it.
+            declare
+               Name : Iir;
+            begin
+               Name := Get_Named_Entity (Expr);
+               if Name /= Null_Iir then
+                  return PSL.Hash.Get_PSL_Node (HDL_Node (Name));
+               end if;
+            end;
+         when others =>
+            null;
+      end case;
+      return PSL.Hash.Get_PSL_Node (HDL_Node (Expr));
+   end Convert_Bool;
+
+   --  Semantize an HDL expression.  This may mostly a wrapper except in the
+   --  case when the expression is in fact a PSL expression.
+   function Sem_Hdl_Expr (N : Node) return Node
+   is
+      use Sem_Names;
+
+      Expr : Iir;
+      Name : Iir;
+      Decl : Node;
+      Res : Node;
+   begin
+      Expr := Get_HDL_Node (N);
+      if Get_Kind (Expr) in Iir_Kinds_Name then
+         Sem_Name (Expr);
+         Expr := Finish_Sem_Name (Expr);
+         Set_HDL_Node (N, Expr);
+
+         if Get_Kind (Expr) in Iir_Kinds_Denoting_Name then
+            Name := Get_Named_Entity (Expr);
+         else
+            Name := Expr;
+         end if;
+
+         case Get_Kind (Name) is
+            when Iir_Kind_Error =>
+               return N;
+            when Iir_Kind_Overload_List =>
+               --  FIXME: todo.
+               raise Internal_Error;
+            when Iir_Kind_Psl_Declaration =>
+               Decl := Get_Psl_Declaration (Name);
+               case Get_Kind (Decl) is
+                  when N_Sequence_Declaration =>
+                     Res := Create_Node (N_Sequence_Instance);
+                  when N_Endpoint_Declaration =>
+                     Res := Create_Node (N_Endpoint_Instance);
+                  when N_Property_Declaration =>
+                     Res := Create_Node (N_Property_Instance);
+                  when N_Boolean_Parameter
+                    | N_Sequence_Parameter
+                    | N_Const_Parameter
+                    | N_Property_Parameter =>
+                     --  FIXME: create a n_name
+                     Free_Node (N);
+                     Free_Iir (Expr);
+                     return Decl;
+                  when others =>
+                     Error_Kind ("sem_hdl_expr(2)", Decl);
+               end case;
+               Set_Location (Res, Get_Location (N));
+               Set_Declaration (Res, Decl);
+               if Get_Parameter_List (Decl) /= Null_Node then
+                  Error_Msg_Sem ("no actual for instantiation", Res);
+               end if;
+               Free_Node (N);
+               Free_Iir (Expr);
+               return Res;
+            when Iir_Kind_Psl_Expression =>
+               --  Remove the two bridge nodes: from PSL to HDL and from
+               --  HDL to PSL.
+               Free_Node (N);
+               Res := Get_Psl_Expression (Name);
+               Free_Iir (Expr);
+               if Name /= Expr then
+                  Free_Iir (Name);
+               end if;
+               return Res;
+            when others =>
+               Expr := Name;
+         end case;
+      else
+         Expr := Sem_Expr.Sem_Expression (Expr, Null_Iir);
+      end if;
+
+      if Expr = Null_Iir then
+         return N;
+      end if;
+      Free_Node (N);
+      if not Is_Psl_Bool_Expr (Expr) then
+         Error_Msg_Sem ("type of expression must be boolean", Expr);
+         return PSL.Hash.Get_PSL_Node (HDL_Node (Expr));
+      else
+         return Convert_Bool (Expr);
+      end if;
+   end Sem_Hdl_Expr;
+
+   --  Sem a boolean node.
+   function Sem_Boolean (Bool : Node) return Node is
+   begin
+      case Get_Kind (Bool) is
+         when N_HDL_Expr =>
+            return Sem_Hdl_Expr (Bool);
+         when N_And_Bool
+           | N_Or_Bool =>
+            Set_Left (Bool, Sem_Boolean (Get_Left (Bool)));
+            Set_Right (Bool, Sem_Boolean (Get_Right (Bool)));
+            return Bool;
+         when others =>
+            Error_Kind ("psl.sem_boolean", Bool);
+      end case;
+   end Sem_Boolean;
+
+   --  Used by Sem_Property to rewrite a property logical operator to a
+   --  boolean logical operator.
+   function Reduce_Logic_Node (Prop : Node; Bool_Kind : Nkind) return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node (Bool_Kind);
+      Set_Location (Res, Get_Location (Prop));
+      Set_Left (Res, Get_Left (Prop));
+      Set_Right (Res, Get_Right (Prop));
+      Free_Node (Prop);
+      return Res;
+   end Reduce_Logic_Node;
+
+   function Sem_Sequence (Seq : Node) return Node
+   is
+      Res : Node;
+      L, R : Node;
+   begin
+      case Get_Kind (Seq) is
+         when N_Braced_SERE =>
+            Res := Sem_Sequence (Get_SERE (Seq));
+            Set_SERE (Seq, Res);
+            return Seq;
+         when N_Concat_SERE
+           | N_Fusion_SERE
+           | N_Within_SERE
+           | N_Or_Seq
+           | N_And_Seq
+           | N_Match_And_Seq =>
+            L := Sem_Sequence (Get_Left (Seq));
+            Set_Left (Seq, L);
+            R := Sem_Sequence (Get_Right (Seq));
+            Set_Right (Seq, R);
+            return Seq;
+         when N_Star_Repeat_Seq =>
+            Res := Get_Sequence (Seq);
+            if Res /= Null_Node then
+               Res := Sem_Sequence (Get_Sequence (Seq));
+               Set_Sequence (Seq, Res);
+            end if;
+            --  FIXME: range.
+            return Seq;
+         when N_Plus_Repeat_Seq =>
+            Res := Get_Sequence (Seq);
+            if Res /= Null_Node then
+               Res := Sem_Sequence (Get_Sequence (Seq));
+               Set_Sequence (Seq, Res);
+            end if;
+            return Seq;
+         when N_And_Bool
+           | N_Or_Bool
+           | N_Not_Bool =>
+            return Sem_Boolean (Seq);
+         when N_HDL_Expr =>
+            return Sem_Hdl_Expr (Seq);
+         when others =>
+            Error_Kind ("psl.sem_sequence", Seq);
+      end case;
+   end Sem_Sequence;
+
+   function Sem_Property (Prop : Node; Top : Boolean := False) return Node
+   is
+      Res : Node;
+      L, R : Node;
+   begin
+      case Get_Kind (Prop) is
+         when N_Braced_SERE =>
+            return Sem_Sequence (Prop);
+         when N_Always
+           | N_Never =>
+            --  By extension, clock_event is allowed within outermost
+            --  always/never.
+            Res := Sem_Property (Get_Property (Prop), Top);
+            Set_Property (Prop, Res);
+            return Prop;
+         when N_Eventually =>
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            return Prop;
+         when N_Clock_Event =>
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            Res := Sem_Boolean (Get_Boolean (Prop));
+            Set_Boolean (Prop, Res);
+            if not Top then
+               Error_Msg_Sem ("inner clock event not supported", Prop);
+            end if;
+            return Prop;
+         when N_Abort =>
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            Res := Sem_Boolean (Get_Boolean (Prop));
+            Set_Boolean (Prop, Res);
+            return Prop;
+         when N_Until
+           | N_Before =>
+            Res := Sem_Property (Get_Left (Prop));
+            Set_Left (Prop, Res);
+            Res := Sem_Property (Get_Right (Prop));
+            Set_Right (Prop, Res);
+            return Prop;
+         when N_Log_Imp_Prop
+           | N_And_Prop
+           | N_Or_Prop =>
+            L := Sem_Property (Get_Left (Prop));
+            Set_Left (Prop, L);
+            R := Sem_Property (Get_Right (Prop));
+            Set_Right (Prop, R);
+            if Get_Psl_Type (L) = Type_Boolean
+              and then Get_Psl_Type (R) = Type_Boolean
+            then
+               case Get_Kind (Prop) is
+                  when N_And_Prop =>
+                     return Reduce_Logic_Node (Prop, N_And_Bool);
+                  when N_Or_Prop =>
+                     return Reduce_Logic_Node (Prop, N_Or_Bool);
+                  when N_Log_Imp_Prop =>
+                     return Reduce_Logic_Node (Prop, N_Imp_Bool);
+                  when others =>
+                     Error_Kind ("psl.sem_property(log)", Prop);
+               end case;
+            end if;
+            return Prop;
+         when N_Overlap_Imp_Seq
+           | N_Imp_Seq =>
+            Res := Sem_Sequence (Get_Sequence (Prop));
+            Set_Sequence (Prop, Res);
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            return Prop;
+         when N_Next =>
+            --  FIXME: number.
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            return Prop;
+         when N_Next_A =>
+            --  FIXME: range.
+            Res := Sem_Property (Get_Property (Prop));
+            Set_Property (Prop, Res);
+            return Prop;
+         when N_HDL_Expr =>
+            Res := Sem_Hdl_Expr (Prop);
+            if not Top and then Get_Kind (Res) = N_Property_Instance then
+               declare
+                  Decl : constant Node := Get_Declaration (Res);
+               begin
+                  if Decl /= Null_Node
+                    and then Get_Global_Clock (Decl) /= Null_Node
+                  then
+                     Error_Msg_Sem ("property instance already has a clock",
+                                    Prop);
+                  end if;
+               end;
+            end if;
+            return Res;
+         when others =>
+            Error_Kind ("psl.sem_property", Prop);
+      end case;
+   end Sem_Property;
+
+   --  Extract the clock from PROP.
+   procedure Extract_Clock (Prop : in out Node; Clk : out Node)
+   is
+      Child : Node;
+   begin
+      Clk := Null_Node;
+      case Get_Kind (Prop) is
+         when N_Clock_Event =>
+            Clk := Get_Boolean (Prop);
+            Prop := Get_Property (Prop);
+         when N_Always
+           | N_Never =>
+            Child := Get_Property (Prop);
+            if Get_Kind (Child) = N_Clock_Event then
+               Set_Property (Prop, Get_Property (Child));
+               Clk := Get_Boolean (Child);
+            end if;
+         when N_Property_Instance =>
+            Child := Get_Declaration (Prop);
+            Clk := Get_Global_Clock (Child);
+         when others =>
+            null;
+      end case;
+   end Extract_Clock;
+
+   --  Sem a property/sequence/endpoint declaration.
+   procedure Sem_Psl_Declaration (Stmt : Iir)
+   is
+      use Sem_Scopes;
+      Decl : Node;
+      Prop : Node;
+      Clk : Node;
+      Formal : Node;
+      El : Iir;
+   begin
+      Sem_Scopes.Add_Name (Stmt);
+      Xref_Decl (Stmt);
+
+      Decl := Get_Psl_Declaration (Stmt);
+
+      Open_Declarative_Region;
+
+      --  Make formal parameters visible.
+      Formal := Get_Parameter_List (Decl);
+      while Formal /= Null_Node loop
+         El := Create_Iir (Iir_Kind_Psl_Declaration);
+         Set_Location (El, Get_Location (Formal));
+         Set_Identifier (El, Get_Identifier (Formal));
+         Set_Psl_Declaration (El, Formal);
+
+         Sem_Scopes.Add_Name (El);
+         Xref_Decl (El);
+         Set_Visible_Flag (El, True);
+
+         Formal := Get_Chain (Formal);
+      end loop;
+
+      case Get_Kind (Decl) is
+         when N_Property_Declaration =>
+            --  FIXME: sem formal list
+            Prop := Get_Property (Decl);
+            Prop := Sem_Property (Prop, True);
+            Extract_Clock (Prop, Clk);
+            Set_Property (Decl, Prop);
+            Set_Global_Clock (Decl, Clk);
+            --  Check simple subset restrictions.
+            PSL.Subsets.Check_Simple (Prop);
+         when N_Sequence_Declaration
+           | N_Endpoint_Declaration =>
+            --  FIXME: sem formal list, do not allow property parameter.
+            Prop := Get_Sequence (Decl);
+            Prop := Sem_Sequence (Prop);
+            Set_Sequence (Decl, Prop);
+            PSL.Subsets.Check_Simple (Prop);
+         when others =>
+            Error_Kind ("sem_psl_declaration", Decl);
+      end case;
+      Set_Visible_Flag (Stmt, True);
+
+      Close_Declarative_Region;
+   end Sem_Psl_Declaration;
+
+   procedure Sem_Psl_Assert_Statement (Stmt : Iir)
+   is
+      Prop : Node;
+      Clk : Node;
+   begin
+      Prop := Get_Psl_Property (Stmt);
+      Prop := Sem_Property (Prop, True);
+      Extract_Clock (Prop, Clk);
+      Set_Psl_Property (Stmt, Prop);
+
+      --  Sem report and severity expressions.
+      Sem_Report_Statement (Stmt);
+
+      --  Properties must be clocked.
+      if Clk = Null_Node then
+         if Current_Psl_Default_Clock = Null_Iir then
+            Error_Msg_Sem ("no clock for PSL assert", Stmt);
+            Clk := Null_Node;
+         else
+            Clk := Get_Psl_Boolean (Current_Psl_Default_Clock);
+         end if;
+      end if;
+      Set_PSL_Clock (Stmt, Clk);
+
+      --  Check simple subset restrictions.
+      PSL.Subsets.Check_Simple (Prop);
+   end Sem_Psl_Assert_Statement;
+
+   procedure Sem_Psl_Default_Clock (Stmt : Iir)
+   is
+      Expr : Node;
+   begin
+      if Current_Psl_Default_Clock /= Null_Iir
+        and then Get_Parent (Current_Psl_Default_Clock) = Get_Parent (Stmt)
+      then
+         Error_Msg_Sem
+           ("redeclaration of PSL default clock in the same region", Stmt);
+         Error_Msg_Sem (" (previous default clock declaration)",
+                        Current_Psl_Default_Clock);
+      end if;
+      Expr := Sem_Boolean (Get_Psl_Boolean (Stmt));
+      Set_Psl_Boolean (Stmt, Expr);
+      Current_Psl_Default_Clock := Stmt;
+   end Sem_Psl_Default_Clock;
+
+   function Sem_Psl_Instance_Name (Name : Iir) return Iir
+   is
+      Prefix : Iir;
+      Ent : Iir;
+      Decl : Node;
+      Formal : Node;
+      Assoc : Iir;
+      Res : Node;
+      Last_Assoc : Node;
+      Assoc2 : Node;
+      Actual : Iir;
+      Psl_Actual : Node;
+      Res2 : Iir;
+   begin
+      Prefix := Get_Prefix (Name);
+      Ent := Get_Named_Entity (Prefix);
+      pragma Assert (Get_Kind (Ent) = Iir_Kind_Psl_Declaration);
+      Decl := Get_Psl_Declaration (Ent);
+      case Get_Kind (Decl) is
+         when N_Property_Declaration =>
+            Res := Create_Node (N_Property_Instance);
+         when N_Sequence_Declaration =>
+            Res := Create_Node (N_Sequence_Instance);
+         when N_Endpoint_Declaration =>
+            Res := Create_Node (N_Endpoint_Instance);
+         when others =>
+            Error_Msg_Sem ("can only instantiate a psl declaration", Name);
+            return Null_Iir;
+      end case;
+      Set_Declaration (Res, Decl);
+      Set_Location (Res, Get_Location (Name));
+      Formal := Get_Parameter_List (Decl);
+      Assoc := Get_Association_Chain (Name);
+      Last_Assoc := Null_Node;
+
+      while Formal /= Null_Node loop
+         if Assoc = Null_Iir then
+            Error_Msg_Sem ("not enough association", Name);
+            exit;
+         end if;
+         if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
+            Error_Msg_Sem
+              ("open or individual association not allowed", Assoc);
+         elsif Get_Formal (Assoc) /= Null_Iir then
+            Error_Msg_Sem ("named association not allowed in psl", Assoc);
+         else
+            Actual := Get_Actual (Assoc);
+            --  FIXME: currently only boolean are parsed.
+            Actual := Sem_Expr.Sem_Expression (Actual, Null_Iir);
+            if Get_Kind (Actual) in Iir_Kinds_Name then
+               Actual := Get_Named_Entity (Actual);
+            end if;
+            Psl_Actual := PSL.Hash.Get_PSL_Node (HDL_Node (Actual));
+         end if;
+
+         Assoc2 := Create_Node (N_Actual);
+         Set_Location (Assoc2, Get_Location (Assoc));
+         Set_Formal (Assoc2, Formal);
+         Set_Actual (Assoc2, Psl_Actual);
+         if Last_Assoc = Null_Node then
+            Set_Association_Chain (Res, Assoc2);
+         else
+            Set_Chain (Last_Assoc, Assoc2);
+         end if;
+         Last_Assoc := Assoc2;
+
+         Formal := Get_Chain (Formal);
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      if Assoc /= Null_Iir then
+         Error_Msg_Sem ("too many association", Name);
+      end if;
+
+      Res2 := Create_Iir (Iir_Kind_Psl_Expression);
+      Set_Psl_Expression (Res2, Res);
+      Location_Copy (Res2, Name);
+      return Res2;
+   end Sem_Psl_Instance_Name;
+
+   --  Called by sem_names to semantize a psl name.
+   function Sem_Psl_Name (Name : Iir) return Iir is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Parenthesis_Name =>
+            return Sem_Psl_Instance_Name (Name);
+         when others =>
+            Error_Kind ("sem_psl_name", Name);
+      end case;
+      return Null_Iir;
+   end Sem_Psl_Name;
+
+end Sem_Psl;
diff --git a/src/sem_psl.ads b/src/sem_psl.ads
new file mode 100644
index 000000000..59df96f7f
--- /dev/null
+++ b/src/sem_psl.ads
@@ -0,0 +1,26 @@
+--  Semantic analysis pass for PSL.
+--  Copyright (C) 2009 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Iirs; use Iirs;
+
+package Sem_Psl is
+   procedure Sem_Psl_Declaration (Stmt : Iir);
+   procedure Sem_Psl_Assert_Statement (Stmt : Iir);
+   procedure Sem_Psl_Default_Clock (Stmt : Iir);
+   function Sem_Psl_Name (Name : Iir) return Iir;
+end Sem_Psl;
diff --git a/src/sem_scopes.adb b/src/sem_scopes.adb
new file mode 100644
index 000000000..71c758575
--- /dev/null
+++ b/src/sem_scopes.adb
@@ -0,0 +1,1412 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with GNAT.Table;
+with Flags; use Flags;
+with Name_Table; -- use Name_Table;
+with Errorout; use Errorout;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Sem_Scopes is
+   -- FIXME: names:
+   -- scopes => regions ?
+
+   --  Debugging subprograms.
+   procedure Disp_All_Names;
+   pragma Unreferenced (Disp_All_Names);
+
+   procedure Disp_Scopes;
+   pragma Unreferenced (Disp_Scopes);
+
+   procedure Disp_Detailed_Interpretations (Ident : Name_Id);
+   pragma Unreferenced (Disp_Detailed_Interpretations);
+
+   -- An interpretation cell is the element of the simply linked list
+   -- of interpratation for an identifier.
+   -- DECL is visible declaration;
+   -- NEXT is the next element of the list.
+   -- Interpretation cells are stored in a stack, Interpretations.
+   type Interpretation_Cell is record
+      Decl: Iir;
+      Is_Potential : Boolean;
+      Pad_0 : Boolean;
+      Next: Name_Interpretation_Type;
+   end record;
+   pragma Pack (Interpretation_Cell);
+
+   -- To manage the list of interpretation and to add informations to this
+   -- list, a stack is used.
+   -- Elements of stack can be of kind:
+   -- Save_Cell:
+   --   the element contains the interpretation INTER for the indentifier ID
+   --   for the outer declarative region.
+   --   A save cell is always each time a declaration is added to save the
+   --   previous interpretation.
+   -- Region_Start:
+   --   A new declarative region start at interpretation INTER.  Here, INTER
+   --   is used as an index in the interpretations stack (table).
+   --   ID is used as an index into the unidim_array stack.
+   -- Barrier_start, Barrier_end:
+   --   All currents interpretations are saved between both INTER, and
+   --   are cleared.  This is used to call semantic during another semantic.
+
+   type Scope_Cell_Kind_Type is
+     (Save_Cell, Hide_Cell, Region_Start, Barrier_Start, Barrier_End);
+
+   type Scope_Cell is record
+      Kind: Scope_Cell_Kind_Type;
+
+      --  Usage of Inter:
+      --  Save_Cell: previous value of name_table (id).info
+      --  Hide_Cell: interpretation hidden.
+      --  Region_Start: previous value of Current_Scope_Start.
+      --  Barrier_Start: previous value of current_scope_start.
+      --  Barrier_End: last index of interpretations table.
+      Inter: Name_Interpretation_Type;
+
+      --  Usage of Id:
+      --  Save_Cell: ID whose interpretations are saved.
+      --  Hide_Cell: not used.
+      --  Region_Start: previous value of the last index of visible_types.
+      --  Barrier_Start: previous value of CURRENT_BARRIER.
+      --  Barrier_End: previous value of Current_composite_types_start.
+      Id: Name_Id;
+   end record;
+
+   package Interpretations is new GNAT.Table
+     (Table_Component_Type => Interpretation_Cell,
+      Table_Index_Type => Name_Interpretation_Type,
+      Table_Low_Bound => First_Valid_Interpretation,
+      Table_Initial => 128,
+      Table_Increment => 50);
+
+   package Scopes is new GNAT.Table
+     (Table_Component_Type => Scope_Cell,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 0,
+      Table_Initial => 128,
+      Table_Increment => 50);
+
+   -- Index into Interpretations marking the last interpretation of
+   -- the previous (immediate) declarative region.
+   Current_Scope_Start: Name_Interpretation_Type := No_Name_Interpretation;
+
+   function Valid_Interpretation (Inter : Name_Interpretation_Type)
+                                 return Boolean is
+   begin
+      return Inter >= First_Valid_Interpretation;
+   end Valid_Interpretation;
+
+   -- Get and Set the info field of the table table for a
+   -- name_interpretation.
+   function Get_Interpretation (Id: Name_Id) return Name_Interpretation_Type is
+   begin
+      return Name_Interpretation_Type (Name_Table.Get_Info (Id));
+   end Get_Interpretation;
+
+   procedure Set_Interpretation (Id: Name_Id; Inter: Name_Interpretation_Type)
+   is
+   begin
+      Name_Table.Set_Info (Id, Int32 (Inter));
+   end Set_Interpretation;
+
+   function Get_Under_Interpretation (Id : Name_Id)
+     return Name_Interpretation_Type
+   is
+      Inter : Name_Interpretation_Type;
+   begin
+      Inter := Name_Interpretation_Type (Name_Table.Get_Info (Id));
+
+      --  ID has no interpretation.
+      --  So, there is no 'under' interpretation (FIXME: prove it).
+      if not Valid_Interpretation (Inter) then
+         return No_Name_Interpretation;
+      end if;
+      for I in reverse Scopes.First .. Scopes.Last loop
+         declare
+            S : Scope_Cell renames Scopes.Table (I);
+         begin
+            case S.Kind is
+               when Save_Cell =>
+                  if S.Id = Id then
+                     --  This is the previous one, return it.
+                     return S.Inter;
+                  end if;
+               when Region_Start
+                 | Hide_Cell =>
+                  null;
+               when Barrier_Start
+                 | Barrier_End =>
+                  return No_Name_Interpretation;
+            end case;
+         end;
+      end loop;
+      return No_Name_Interpretation;
+   end Get_Under_Interpretation;
+
+   procedure Check_Interpretations;
+   pragma Unreferenced (Check_Interpretations);
+
+   procedure Check_Interpretations
+   is
+      Inter: Name_Interpretation_Type;
+      Last : Name_Interpretation_Type;
+      Err : Boolean;
+   begin
+      Last := Interpretations.Last;
+      Err := False;
+      for I in 0 .. Name_Table.Last_Name_Id loop
+         Inter := Get_Interpretation (I);
+         if Inter > Last then
+            Ada.Text_IO.Put_Line
+              ("bad interpretation for " & Name_Table.Image (I));
+            Err := True;
+         end if;
+      end loop;
+      if Err then
+         raise Internal_Error;
+      end if;
+   end Check_Interpretations;
+
+   -- Create a new declarative region.
+   -- Simply push a region_start cell and update current_scope_start.
+   procedure Open_Declarative_Region is
+   begin
+      Scopes.Increment_Last;
+      Scopes.Table (Scopes.Last) := (Kind => Region_Start,
+                                     Inter => Current_Scope_Start,
+                                     Id => Null_Identifier);
+      Current_Scope_Start := Interpretations.Last;
+   end Open_Declarative_Region;
+
+   -- Close a declarative region.
+   -- Update interpretation of identifiers.
+   procedure Close_Declarative_Region is
+   begin
+      loop
+         case Scopes.Table (Scopes.Last).Kind is
+            when Region_Start =>
+               --  Discard interpretations cells added in this scopes.
+               Interpretations.Set_Last (Current_Scope_Start);
+               --  Restore Current_Scope_Start.
+               Current_Scope_Start := Scopes.Table (Scopes.Last).Inter;
+               Scopes.Decrement_Last;
+               return;
+            when Save_Cell =>
+               --  Restore a previous interpretation.
+               Set_Interpretation (Scopes.Table (Scopes.Last).Id,
+                                   Scopes.Table (Scopes.Last).Inter);
+            when Hide_Cell =>
+               --  Unhide previous interpretation.
+               declare
+                  H, S : Name_Interpretation_Type;
+               begin
+                  H := Scopes.Table (Scopes.Last).Inter;
+                  S := Interpretations.Table (H).Next;
+                  Interpretations.Table (H).Next :=
+                    Interpretations.Table (S).Next;
+                  Interpretations.Table (S).Next := H;
+               end;
+            when Barrier_Start
+              | Barrier_End =>
+               --  Barrier cannot exist inside a declarative region.
+               raise Internal_Error;
+         end case;
+         Scopes.Decrement_Last;
+      end loop;
+   end Close_Declarative_Region;
+
+   procedure Open_Scope_Extension renames Open_Declarative_Region;
+   procedure Close_Scope_Extension renames Close_Declarative_Region;
+
+   function Get_Next_Interpretation (Ni: Name_Interpretation_Type)
+                                     return Name_Interpretation_Type is
+   begin
+      if not Valid_Interpretation (Ni) then
+         raise Internal_Error;
+      end if;
+      return Interpretations.Table (Ni).Next;
+   end Get_Next_Interpretation;
+
+   function Get_Declaration (Ni: Name_Interpretation_Type)
+                             return Iir is
+   begin
+      if not Valid_Interpretation (Ni) then
+         raise Internal_Error;
+      end if;
+      return Interpretations.Table (Ni).Decl;
+   end Get_Declaration;
+
+   function Strip_Non_Object_Alias (Decl : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Decl;
+      if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then
+         Res := Get_Named_Entity (Get_Name (Res));
+      end if;
+      return Res;
+   end Strip_Non_Object_Alias;
+
+   function Get_Non_Alias_Declaration (Ni: Name_Interpretation_Type)
+                                      return Iir is
+   begin
+      return Strip_Non_Object_Alias (Get_Declaration (Ni));
+   end Get_Non_Alias_Declaration;
+
+   -- Pointer just past the last barrier_end in the scopes stack.
+   Current_Barrier : Integer := 0;
+
+   procedure Push_Interpretations is
+   begin
+      -- Add a barrier_start.
+      -- Save current_scope_start and current_barrier.
+      Scopes.Increment_Last;
+      Scopes.Table (Scopes.Last) := (Kind => Barrier_Start,
+                                     Inter => Current_Scope_Start,
+                                     Id => Name_Id (Current_Barrier));
+
+      -- Save all the current name interpretations.
+      --  (For each name that have interpretations, there is a save_cell
+      --   containing the interpretations for the outer scope).
+      -- FIXME: maybe we should only save the name_table info.
+      for I in Current_Barrier .. Scopes.Last - 1 loop
+         if Scopes.Table (I).Kind = Save_Cell then
+            Scopes.Increment_Last;
+            Scopes.Table (Scopes.Last) :=
+              (Kind => Save_Cell,
+               Inter => Get_Interpretation (Scopes.Table (I).Id),
+               Id => Scopes.Table (I).Id);
+            Set_Interpretation (Scopes.Table (I).Id, No_Name_Interpretation);
+         end if;
+      end loop;
+
+      -- Add a barrier_end.
+      -- Save interpretations.last.
+      Scopes.Increment_Last;
+      Scopes.Table (Scopes.Last) :=
+        (Kind => Barrier_End,
+         Inter => Interpretations.Last,
+         Id => Null_Identifier);
+
+      -- Start a completly new scope.
+      Current_Scope_Start := Interpretations.Last + 1;
+
+      -- Keep the last barrier.
+      Current_Barrier := Scopes.Last + 1;
+
+      pragma Debug (Name_Table.Assert_No_Infos);
+   end Push_Interpretations;
+
+   procedure Pop_Interpretations is
+   begin
+      -- clear all name interpretations set by the current barrier.
+      for I in Current_Barrier .. Scopes.Last loop
+         if Scopes.Table (I).Kind = Save_Cell then
+            Set_Interpretation (Scopes.Table (I).Id, No_Name_Interpretation);
+         end if;
+      end loop;
+      Scopes.Set_Last (Current_Barrier - 1);
+      if Scopes.Table (Scopes.Last).Kind /= Barrier_End then
+         raise Internal_Error;
+      end if;
+
+      pragma Debug (Name_Table.Assert_No_Infos);
+
+      -- Restore the stack pointer of interpretations.
+      Interpretations.Set_Last (Scopes.Table (Scopes.Last).Inter);
+      Scopes.Decrement_Last;
+
+      -- Restore all name interpretations.
+      while Scopes.Table (Scopes.Last).Kind /= Barrier_Start loop
+         Set_Interpretation (Scopes.Table (Scopes.Last).Id,
+                             Scopes.Table (Scopes.Last).Inter);
+         Scopes.Decrement_Last;
+      end loop;
+
+      -- Restore current_scope_start and current_barrier.
+      Current_Scope_Start := Scopes.Table (Scopes.Last).Inter;
+      Current_Barrier := Natural (Scopes.Table (Scopes.Last).Id);
+
+      Scopes.Decrement_Last;
+   end Pop_Interpretations;
+
+   -- Return TRUE if INTER was made directly visible via a use clause.
+   function Is_Potentially_Visible (Inter: Name_Interpretation_Type)
+     return Boolean
+   is
+   begin
+      return Interpretations.Table (Inter).Is_Potential;
+   end Is_Potentially_Visible;
+
+   -- Return TRUE iif DECL can be overloaded.
+   function Is_Overloadable (Decl: Iir) return Boolean is
+   begin
+      -- LRM93 §10.3:
+      -- The overloaded declarations considered in this chapter are those for
+      -- subprograms and enumeration literals.
+      case Get_Kind (Decl) is
+         when Iir_Kind_Enumeration_Literal
+           | Iir_Kinds_Function_Declaration
+           | Iir_Kinds_Procedure_Declaration =>
+            return True;
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is
+               when Iir_Kind_Enumeration_Literal
+                 | Iir_Kinds_Function_Declaration
+                 | Iir_Kinds_Procedure_Declaration =>
+                  return True;
+               when Iir_Kind_Non_Object_Alias_Declaration =>
+                  raise Internal_Error;
+               when others =>
+                  return False;
+            end case;
+         when others =>
+            return False;
+      end case;
+   end Is_Overloadable;
+
+   -- Return TRUE if INTER was made direclty visible in the current
+   -- declarative region.
+   function Is_In_Current_Declarative_Region (Inter: Name_Interpretation_Type)
+                                             return Boolean is
+   begin
+      return Inter > Current_Scope_Start;
+   end Is_In_Current_Declarative_Region;
+
+   --  Called when CURR is being declared in the same declarative region as
+   --  PREV, using the same identifier.
+   --  The function assumes CURR and PREV are both overloadable.
+   --  Return TRUE if this redeclaration is allowed.
+--    function Redeclaration_Allowed (Prev, Curr : Iir) return Boolean is
+--    begin
+--       case Get_Kind (Curr) is
+--          when Iir_Kinds_Function_Specification
+--            | Iir_Kinds_Procedure_Specification =>
+--             if ((Get_Kind (Prev) in Iir_Kinds_User_Function_Specification
+--               and then
+--               Get_Kind (Curr) in Iir_Kinds_User_Function_Specification)
+--               or else
+--               (Get_Kind (Prev) in Iir_Kinds_User_Procedure_Specification
+--                and then
+--               Get_Kind (Curr) in Iir_Kinds_User_Procedure_Specification))
+--             then
+--                return not Iirs_Utils.Is_Same_Profile (Prev, Curr);
+--             else
+--                return True;
+--             end if;
+--          when Iir_Kind_Enumeration_Literal =>
+--             if Get_Kind (Prev) /= Get_Kind (Curr) then
+--                --  FIXME: PREV may be a function returning the type of the
+--                --  literal.
+--                return True;
+--             end if;
+--             return Get_Type (Prev) /= Get_Type (Curr);
+--          when others =>
+--             return False;
+--       end case;
+--    end Redeclaration_Allowed;
+
+   -- Add interpretation DECL to the identifier of DECL.
+   -- POTENTIALLY is true if the identifier comes from a use clause.
+   procedure Add_Name (Decl: Iir; Ident: Name_Id; Potentially: Boolean)
+   is
+      -- Current interpretation of ID.  This is the one before DECL is
+      -- added (if so).
+      Current_Inter: Name_Interpretation_Type;
+      Current_Decl : Iir;
+
+      --  Before adding a new interpretation, the current interpretation
+      --  must be saved so that it could be restored when the current scope
+      --  is removed.  That must be done only once per scope and per
+      --  interpretation.  Note that the saved interpretation is not removed
+      --  from the chain of interpretations.
+      procedure Save_Current_Interpretation is
+      begin
+         Scopes.Increment_Last;
+         Scopes.Table (Scopes.Last) :=
+           (Kind => Save_Cell, Id => Ident, Inter => Current_Inter);
+      end Save_Current_Interpretation;
+
+      --  Add DECL in the chain of interpretation for the identifier.
+      procedure Add_New_Interpretation is
+      begin
+         Interpretations.Increment_Last;
+         Interpretations.Table (Interpretations.Last) :=
+           (Decl => Decl, Next => Current_Inter,
+            Is_Potential => Potentially, Pad_0 => False);
+         Set_Interpretation (Ident, Interpretations.Last);
+      end Add_New_Interpretation;
+   begin
+      Current_Inter := Get_Interpretation (Ident);
+
+      if Current_Inter = No_Name_Interpretation
+        or else (Current_Inter = Conflict_Interpretation and not Potentially)
+      then
+         --  Very simple: no hidding, no overloading.
+         --  (current interpretation is Conflict_Interpretation if there is
+         --   only potentially visible declarations that are not made directly
+         --   visible).
+         --  Note: in case of conflict interpretation, it may be unnecessary
+         --  to save the current interpretation (but it is simpler to always
+         --  save it).
+         Save_Current_Interpretation;
+         Add_New_Interpretation;
+         return;
+      end if;
+
+      if Potentially then
+         if Current_Inter = Conflict_Interpretation then
+            --  Yet another conflicting interpretation.
+            return;
+         end if;
+
+         --  Do not re-add a potential decl.  This handles cases like:
+         --  'use p.all; use p.all;'.
+         --  FIXME: add a flag (or reuse Visible_Flag) to avoid walking all
+         --  the interpretations.
+         declare
+            Inter: Name_Interpretation_Type := Current_Inter;
+         begin
+            while Valid_Interpretation (Inter) loop
+               if Get_Declaration (Inter) = Decl then
+                  return;
+               end if;
+               Inter := Get_Next_Interpretation (Inter);
+            end loop;
+         end;
+      end if;
+
+      --  LRM 10.3 Visibility
+      --  Each of two declarations is said to be a homograph of the other if
+      --  both declarations have the same identifier, operator symbol, or
+      --  character literal, and overloading is allowed for at most one
+      --  of the two.
+      --
+      --  GHDL: the condition 'overloading is allowed for at most one of the
+      --  two' is false iff overloading is allowed for both; this is a nand.
+
+      --  Note: at this stage, current_inter is valid.
+      Current_Decl := Get_Declaration (Current_Inter);
+
+      if Is_Overloadable (Current_Decl) and then Is_Overloadable (Decl) then
+         --  Current_Inter and Decl overloads (well, they have the same
+         --  designator).
+
+         --  LRM 10.3 Visibility
+         --  If overloading is allowed for both declarations, then each of the
+         --  two is a homograph of the other if they have the same identifier,
+         --  operator symbol or character literal, as well as the same
+         --  parameter and result profile.
+
+         declare
+            Homograph : Name_Interpretation_Type;
+            Prev_Homograph : Name_Interpretation_Type;
+
+            --  Add DECL in the chain of interpretation, and save the current
+            --  one if necessary.
+            procedure Maybe_Save_And_Add_New_Interpretation is
+            begin
+               if not Is_In_Current_Declarative_Region (Current_Inter) then
+                  Save_Current_Interpretation;
+               end if;
+               Add_New_Interpretation;
+            end Maybe_Save_And_Add_New_Interpretation;
+
+            --  Hide HOMOGRAPH (ie unlink it from the chain of interpretation).
+            procedure Hide_Homograph
+            is
+               S : Name_Interpretation_Type;
+            begin
+               if Prev_Homograph = No_Name_Interpretation then
+                  Prev_Homograph := Interpretations.Last;
+               end if;
+               if Interpretations.Table (Prev_Homograph).Next /= Homograph
+               then
+                  --  PREV_HOMOGRAPH must be the interpretation just before
+                  --  HOMOGRAPH.
+                  raise Internal_Error;
+               end if;
+
+               --  Hide previous interpretation.
+               S := Interpretations.Table (Homograph).Next;
+               Interpretations.Table (Homograph).Next := Prev_Homograph;
+               Interpretations.Table (Prev_Homograph).Next := S;
+               Scopes.Increment_Last;
+               Scopes.Table (Scopes.Last) :=
+                 (Kind => Hide_Cell,
+                  Id => Null_Identifier, Inter => Homograph);
+            end Hide_Homograph;
+
+            function Get_Hash_Non_Alias (D : Iir) return Iir_Int32 is
+            begin
+               return Get_Subprogram_Hash (Strip_Non_Object_Alias (D));
+            end Get_Hash_Non_Alias;
+
+            --  Return True iff D is an implicit declaration (either a
+            --  subprogram or an implicit alias).
+            function Is_Implicit_Declaration (D : Iir) return Boolean is
+            begin
+               case Get_Kind (D) is
+                  when Iir_Kinds_Implicit_Subprogram_Declaration =>
+                     return True;
+                  when Iir_Kind_Non_Object_Alias_Declaration =>
+                     return Get_Implicit_Alias_Flag (D);
+                  when Iir_Kind_Enumeration_Literal
+                    | Iir_Kind_Procedure_Declaration
+                    | Iir_Kind_Function_Declaration =>
+                     return False;
+                  when others =>
+                     Error_Kind ("is_implicit_declaration", D);
+               end case;
+            end Is_Implicit_Declaration;
+
+            --  Return TRUE iff D is an implicit alias of an implicit
+            --  subprogram.
+            function Is_Implicit_Alias (D : Iir) return Boolean is
+            begin
+               --  FIXME: Is it possible to have an implicit alias of an
+               --  explicit subprogram ? Yes for enumeration literal and
+               --  physical units.
+               return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration
+                 and then Get_Implicit_Alias_Flag (D)
+                 and then (Get_Kind (Get_Named_Entity (Get_Name (D)))
+                             in Iir_Kinds_Implicit_Subprogram_Declaration);
+            end Is_Implicit_Alias;
+
+            --  Replace the homograph of DECL by DECL.
+            procedure Replace_Homograph is
+            begin
+               Interpretations.Table (Homograph).Decl := Decl;
+            end Replace_Homograph;
+
+            Decl_Hash : Iir_Int32;
+            Hash : Iir_Int32;
+         begin
+            Decl_Hash := Get_Hash_Non_Alias (Decl);
+            if Decl_Hash = 0 then
+               --  The hash must have been computed.
+               raise Internal_Error;
+            end if;
+
+            --  Find an homograph of this declaration (and also keep the
+            --  interpretation just before it in the chain),
+            Homograph := Current_Inter;
+            Prev_Homograph := No_Name_Interpretation;
+            while Homograph /= No_Name_Interpretation loop
+               Current_Decl := Get_Declaration (Homograph);
+               Hash := Get_Hash_Non_Alias (Current_Decl);
+               exit when Decl_Hash = Hash
+                 and then Is_Same_Profile (Decl, Current_Decl);
+               Prev_Homograph := Homograph;
+               Homograph := Get_Next_Interpretation (Homograph);
+            end loop;
+
+            if Homograph = No_Name_Interpretation then
+               --  Simple case: no homograph.
+               Maybe_Save_And_Add_New_Interpretation;
+               return;
+            end if;
+
+            --  There is an homograph.
+            if Potentially then
+               --  Added DECL would be made potentially visible.
+
+               --  LRM93 10.4 1) / LRM08 12.4 a) Use Clauses
+               --  1. A potentially visible declaration is not made
+               --     directly visible if the place considered is within the
+               --     immediate scope of a homograph of the declaration.
+               if Is_In_Current_Declarative_Region (Homograph) then
+                  if not Is_Potentially_Visible (Homograph) then
+                     return;
+                  end if;
+               end if;
+
+               --  LRM08 12.4 Use Clauses
+               --  b) If two potentially visible declarations are homograph
+               --     and one is explicitly declared and the other is
+               --     implicitly declared, then the implicit declaration is
+               --     not made directly visible.
+               if (Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08)
+                 and then Is_Potentially_Visible (Homograph)
+               then
+                  declare
+                     Implicit_Current_Decl : constant Boolean :=
+                       Is_Implicit_Declaration (Current_Decl);
+                     Implicit_Decl : constant Boolean :=
+                       Is_Implicit_Declaration (Decl);
+                  begin
+                     if Implicit_Current_Decl and then not Implicit_Decl then
+                        if Is_In_Current_Declarative_Region (Homograph) then
+                           Replace_Homograph;
+                        else
+                           --  Hide homoraph and insert decl.
+                           Maybe_Save_And_Add_New_Interpretation;
+                           Hide_Homograph;
+                        end if;
+                        return;
+                     elsif not Implicit_Current_Decl and then Implicit_Decl
+                     then
+                        --  Discard decl.
+                        return;
+                     elsif Strip_Non_Object_Alias (Decl)
+                       = Strip_Non_Object_Alias (Current_Decl)
+                     then
+                        --  This rule is not written clearly in the LRM, but
+                        --  if two designators denote the same named entity,
+                        --  no need to make both visible.
+                        return;
+                     end if;
+                  end;
+               end if;
+
+               --  GHDL: if the homograph is in the same declarative
+               --  region than DECL, it must be an implicit declaration
+               --  to be hidden.
+               --  FIXME: this rule is not in the LRM93, but it is necessary
+               --  so that explicit declaration hides the implicit one.
+               if Flags.Vhdl_Std < Vhdl_08
+                 and then not Flags.Flag_Explicit
+                 and then Get_Parent (Decl) = Get_Parent (Current_Decl)
+               then
+                  declare
+                     Implicit_Current_Decl : constant Boolean :=
+                       (Get_Kind (Current_Decl)
+                          in Iir_Kinds_Implicit_Subprogram_Declaration);
+                     Implicit_Decl : constant Boolean :=
+                       (Get_Kind (Decl)
+                          in Iir_Kinds_Implicit_Subprogram_Declaration);
+                  begin
+                     if Implicit_Current_Decl and not Implicit_Decl then
+                        --  Note: no need to save previous interpretation, as
+                        --  it is in the same declarative region.
+                        --  Replace the previous homograph with DECL.
+                        Replace_Homograph;
+                        return;
+                     elsif not Implicit_Current_Decl and Implicit_Decl then
+                        --  As we have replaced the homograph, it is possible
+                        --  than the implicit declaration is re-added (by
+                        --  a new use clause).  Discard it.
+                        return;
+                     end if;
+                  end;
+               end if;
+
+               --  The homograph was made visible in an outer declarative
+               --  region.  Therefore, it must not be hidden.
+               Maybe_Save_And_Add_New_Interpretation;
+
+               return;
+            else
+               --  Added DECL would be made directly visible.
+
+               if not Is_Potentially_Visible (Homograph) then
+                  --  The homograph was also declared in that declarative
+                  --  region or in an inner one.
+                  if Is_In_Current_Declarative_Region (Homograph) then
+                     --  ... and was declared in the same region
+
+                     --  To sum up: at this point both DECL and CURRENT_DECL
+                     --  are overloadable, have the same profile (but may be
+                     --  aliases) and are declared in the same declarative
+                     --  region.
+
+                     --  LRM08 12.3 Visibility
+                     --  LRM93 10.3 Visibility
+                     --  Two declarations that occur immediately within
+                     --  the same declarative regions [...] shall not be
+                     --  homograph, unless exactely one of them is the
+                     --  implicit declaration of a predefined operation,
+
+                     --  LRM08 12.3 Visibility
+                     --  or is an implicit alias of such implicit declaration.
+                     --
+                     --  GHDL: FIXME: 'implicit alias'
+
+                     --  LRM08 12.3 Visibility
+                     --  LRM93 10.3 Visibility
+                     --  Each of two declarations is said to be a
+                     --  homograph of the other if and only if both
+                     --  declarations have the same designator, [...]
+                     --
+                     --  LRM08 12.3 Visibility
+                     --  [...] and they denote different named entities,
+                     --  and [...]
+                     declare
+                        Is_Decl_Implicit : Boolean;
+                        Is_Current_Decl_Implicit : Boolean;
+                     begin
+                        if Flags.Vhdl_Std >= Vhdl_08 then
+                           Is_Current_Decl_Implicit :=
+                             (Get_Kind (Current_Decl) in
+                                Iir_Kinds_Implicit_Subprogram_Declaration)
+                             or else Is_Implicit_Alias (Current_Decl);
+                           Is_Decl_Implicit :=
+                             (Get_Kind (Decl) in
+                                Iir_Kinds_Implicit_Subprogram_Declaration)
+                             or else Is_Implicit_Alias (Decl);
+
+                           --  If they denote the same entity, they aren't
+                           --  homograph.
+                           if Strip_Non_Object_Alias (Decl)
+                             = Strip_Non_Object_Alias (Current_Decl)
+                           then
+                              if Is_Current_Decl_Implicit
+                                and then not Is_Decl_Implicit
+                              then
+                                 --  They aren't homograph but DECL is stronger
+                                 --  (at it is not an implicit declaration)
+                                 --  than CURRENT_DECL
+                                 Replace_Homograph;
+                              end if;
+
+                              return;
+                           end if;
+
+                           if Is_Decl_Implicit
+                             and then not Is_Current_Decl_Implicit
+                           then
+                              --  Re-declaration of an implicit subprogram via
+                              --  an implicit alias is simply discarded.
+                              return;
+                           end if;
+                        else
+                           --  Can an implicit subprogram declaration appears
+                           --  after an explicit one in vhdl 93?  I don't
+                           --  think so.
+                           Is_Decl_Implicit :=
+                             (Get_Kind (Decl)
+                                in Iir_Kinds_Implicit_Subprogram_Declaration);
+                           Is_Current_Decl_Implicit :=
+                             (Get_Kind (Current_Decl)
+                                in Iir_Kinds_Implicit_Subprogram_Declaration);
+                        end if;
+
+                        if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit)
+                        then
+                           Error_Msg_Sem
+                             ("redeclaration of " & Disp_Node (Current_Decl) &
+                                " defined at " & Disp_Location (Current_Decl),
+                              Decl);
+                           return;
+                        end if;
+                     end;
+                  else
+                     --  GHDL: hide directly visible declaration declared in
+                     --  an outer region.
+                     null;
+                  end if;
+               else
+                  --  LRM 10.4 Use Clauses
+                  --  1. A potentially visible declaration is not made
+                  --  directly visible if the place considered is within the
+                  --  immediate scope of a homograph of the declaration.
+
+                  --  GHDL: hide the potentially visible declaration.
+                  null;
+               end if;
+               Maybe_Save_And_Add_New_Interpretation;
+
+               Hide_Homograph;
+               return;
+            end if;
+         end;
+      end if;
+
+      --  The current interpretation and the new one aren't overloadable, ie
+      --  they are homograph (well almost).
+
+      if Is_In_Current_Declarative_Region (Current_Inter) then
+         --  They are perhaps visible in the same declarative region.
+         if Is_Potentially_Visible (Current_Inter) then
+            if Potentially then
+               --  LRM93 10.4 2) / LRM08 12.4 c) Use clauses
+               --  Potentially visible declarations that have the same
+               --  designator are not made directly visible unless each of
+               --  them is either an enumeration literal specification or
+               --  the declaration of a subprogram.
+               if Decl = Get_Declaration (Current_Inter) then
+                  -- The rule applies only for distinct declaration.
+                  -- This handles 'use p.all; use P.all;'.
+                  -- FIXME: this should have been handled at the start of
+                  -- this subprogram.
+                  raise Internal_Error;
+                  return;
+               end if;
+
+               --  LRM08 12.3 Visibility
+               --  Each of two declarations is said to be a homograph of the
+               --  other if and only if both declarations have the same
+               --  designator; and they denote different named entities, [...]
+               if Flags.Vhdl_Std >= Vhdl_08 then
+                  if Strip_Non_Object_Alias (Decl)
+                    = Strip_Non_Object_Alias (Current_Decl)
+                  then
+                     return;
+                  end if;
+               end if;
+
+               Save_Current_Interpretation;
+               Set_Interpretation (Ident, Conflict_Interpretation);
+               return;
+            else
+               -- LRM93 §10.4 item #1
+               --  A potentially visible declaration is not made directly
+               --  visible if the place considered is within the immediate
+               --  scope of a homograph of the declaration.
+               -- GHDL: Discard the current potentially visible declaration,
+               --  only if it is not an entity declaration, since it is used
+               --  to find default binding.
+               if Get_Kind (Current_Decl) = Iir_Kind_Design_Unit
+                 and then Get_Kind (Get_Library_Unit (Current_Decl))
+                 = Iir_Kind_Entity_Declaration
+               then
+                  Save_Current_Interpretation;
+               end if;
+               Current_Inter := No_Name_Interpretation;
+               Add_New_Interpretation;
+               return;
+            end if;
+         else
+            --  There is already a declaration in the current scope.
+            if Potentially then
+               -- LRM93 §10.4 item #1
+               -- Discard the new and potentially visible declaration.
+               -- However, add the type.
+               -- FIXME: Add_In_Visible_List (Ident, Decl);
+               return;
+            else
+               --  LRM93 11.2
+               --  If two or more logical names having the same
+               --  identifier appear in library clauses in the same
+               --  context, the second and subsequent occurences of the
+               --  logical name have no effect.  The same is true of
+               --  logical names appearing both in the context clause
+               --  of a primary unit and in the context clause of a
+               --  corresponding secondary unit.
+               --  GHDL: we apply this rule with VHDL-87, because of implicits
+               --  library clauses STD and WORK.
+               if Get_Kind (Decl) = Iir_Kind_Library_Declaration
+                 and then
+                 Get_Kind (Current_Decl) = Iir_Kind_Library_Declaration
+               then
+                  return;
+               end if;
+
+               -- None of the two declarations are potentially visible, ie
+               -- both are visible.
+               -- LRM §10.3:
+               --  Two declarations that occur immediately within the same
+               --  declarative region must not be homographs,
+               -- FIXME: unless one of them is the implicit declaration of a
+               --  predefined operation.
+               Error_Msg_Sem ("identifier '" & Name_Table.Image (Ident)
+                              & "' already used for a declaration",
+                              Decl);
+               Error_Msg_Sem
+                 ("previous declaration: " & Disp_Node (Current_Decl),
+                  Current_Decl);
+               return;
+            end if;
+         end if;
+      end if;
+
+      -- Homograph, not in the same scope.
+      -- LRM §10.3:
+      -- A declaration is said to be hidden within (part of) an inner
+      -- declarative region if the inner region contains an homograph
+      -- of this declaration; the outer declaration is the hidden
+      -- within the immediate scope of the inner homograph.
+      Save_Current_Interpretation;
+      Current_Inter := No_Name_Interpretation;  -- Hid.
+      Add_New_Interpretation;
+   end Add_Name;
+
+   procedure Add_Name (Decl: Iir) is
+   begin
+      Add_Name (Decl, Get_Identifier (Decl), False);
+   end Add_Name;
+
+   procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir)
+   is
+      Inter : Name_Interpretation_Type;
+   begin
+      Inter := Get_Interpretation (Id);
+      loop
+         exit when Get_Declaration (Inter) = Old;
+         Inter := Get_Next_Interpretation (Inter);
+         if not Valid_Interpretation (Inter) then
+            raise Internal_Error;
+         end if;
+      end loop;
+      Interpretations.Table (Inter).Decl := Decl;
+      if Get_Next_Interpretation (Inter) /= No_Name_Interpretation then
+         raise Internal_Error;
+      end if;
+   end Replace_Name;
+
+   procedure Name_Visible (Decl : Iir) is
+   begin
+      if Get_Visible_Flag (Decl) then
+         --  A name can be made visible only once.
+         raise Internal_Error;
+      end if;
+      Set_Visible_Flag (Decl, True);
+   end Name_Visible;
+
+   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type)
+   is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Implicit_Procedure_Declaration
+           | Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Subtype_Declaration
+           | Iir_Kind_Enumeration_Literal --  By use clause
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Component_Declaration
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration
+           | Iir_Kind_Nature_Declaration
+           | Iir_Kind_Free_Quantity_Declaration
+           | Iir_Kind_Through_Quantity_Declaration
+           | Iir_Kind_Across_Quantity_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kind_Entity_Declaration
+           | Iir_Kind_Package_Declaration
+           | Iir_Kind_Configuration_Declaration
+           | Iir_Kinds_Concurrent_Statement
+           | Iir_Kinds_Sequential_Statement =>
+            Handle_Decl (Decl, Arg);
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            if not Is_Second_Subprogram_Specification (Decl) then
+               Handle_Decl (Decl, Arg);
+            end if;
+         when Iir_Kind_Type_Declaration =>
+            declare
+               Def : Iir;
+               List : Iir_List;
+               El : Iir;
+            begin
+               Def := Get_Type_Definition (Decl);
+
+               -- Handle incomplete type declaration.
+               if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
+                  return;
+               end if;
+
+               Handle_Decl (Decl, Arg);
+
+               if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
+                  List := Get_Enumeration_Literal_List (Def);
+                  for I in Natural loop
+                     El := Get_Nth_Element (List, I);
+                     exit when El = Null_Iir;
+                     Handle_Decl (El, Arg);
+                  end loop;
+               end if;
+            end;
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Handle_Decl (Decl, Arg);
+
+            declare
+               Def : Iir;
+               El : Iir;
+            begin
+               Def := Get_Type_Definition (Decl);
+
+               if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
+                  El := Get_Unit_Chain (Def);
+                  while El /= Null_Iir loop
+                     Handle_Decl (El, Arg);
+                     El := Get_Chain (El);
+                  end loop;
+               end if;
+            end;
+         when Iir_Kind_Use_Clause =>
+            Handle_Decl (Decl, Arg);
+         when Iir_Kind_Library_Clause =>
+            Handle_Decl (Decl, Arg);
+--             El := Get_Library_Declaration (Decl);
+--             if El /= Null_Iir then
+--                --  May be empty.
+--                Handle_Decl (El, Arg);
+--             end if;
+
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            null;
+
+         when Iir_Kind_Attribute_Specification
+           | Iir_Kind_Configuration_Specification
+           | Iir_Kind_Disconnection_Specification =>
+            null;
+         when Iir_Kinds_Signal_Attribute =>
+            null;
+
+         when Iir_Kind_Protected_Type_Body =>
+            --  FIXME: allowed only in debugger (if the current scope is
+            --  within a package body) ?
+            null;
+
+         when others =>
+            Error_Kind ("iterator_decl", Decl);
+      end case;
+   end Iterator_Decl;
+
+   --  Make POTENTIALLY (or not) visible DECL.
+   procedure Add_Name_Decl (Decl : Iir; Potentially : Boolean) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Use_Clause =>
+            if not Potentially then
+               Add_Use_Clause (Decl);
+            end if;
+         when Iir_Kind_Library_Clause =>
+            Add_Name (Get_Library_Declaration (Decl),
+                      Get_Identifier (Decl), Potentially);
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            null;
+         when others =>
+            Add_Name (Decl, Get_Identifier (Decl), Potentially);
+      end case;
+   end Add_Name_Decl;
+
+   procedure Add_Declaration is
+      new Iterator_Decl (Arg_Type => Boolean, Handle_Decl => Add_Name_Decl);
+
+   procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type)
+   is
+      Decl: Iir;
+   begin
+      if Decl_List = Null_Iir_List then
+         return;
+      end if;
+      for I in Natural loop
+         Decl := Get_Nth_Element (Decl_List, I);
+         exit when Decl = Null_Iir;
+         Handle_Decl (Decl, Arg);
+      end loop;
+   end Iterator_Decl_List;
+
+   procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type)
+   is
+      Decl: Iir;
+   begin
+      Decl := Chain_First;
+      while Decl /= Null_Iir loop
+         Handle_Decl (Decl, Arg);
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Iterator_Decl_Chain;
+
+   procedure Add_Declarations_1 is new Iterator_Decl_Chain
+     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
+
+   procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False)
+     renames Add_Declarations_1;
+
+   procedure Add_Declarations_List is new Iterator_Decl_List
+     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);
+
+   procedure Add_Declarations_From_Interface_Chain (Chain : Iir)
+   is
+      El: Iir;
+   begin
+      El := Chain;
+      while El /= Null_Iir loop
+         Add_Name (El, Get_Identifier (El), False);
+         El := Get_Chain (El);
+      end loop;
+   end Add_Declarations_From_Interface_Chain;
+
+   procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir)
+   is
+      El: Iir;
+      Label: Name_Id;
+   begin
+      El := Get_Concurrent_Statement_Chain (Parent);
+      while El /= Null_Iir loop
+         Label := Get_Label (El);
+         if Label /= Null_Identifier then
+            Add_Name (El, Get_Identifier (El), False);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+   end Add_Declarations_Of_Concurrent_Statement;
+
+   procedure Add_Context_Clauses (Unit : Iir_Design_Unit) is
+   begin
+      Add_Declarations (Get_Context_Items (Unit), False);
+   end Add_Context_Clauses;
+
+   -- Add declarations from an entity into the current declarative region.
+   -- This is needed when an architecture is analysed.
+   procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration)
+   is
+   begin
+      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Entity));
+      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Entity));
+      Add_Declarations (Get_Declaration_Chain (Entity), False);
+      Add_Declarations_Of_Concurrent_Statement (Entity);
+   end Add_Entity_Declarations;
+
+   --  Add declarations from a package into the current declarative region.
+   --  (for a use clause or when a package body is analyzed)
+   procedure Add_Package_Declarations
+     (Decl: Iir_Package_Declaration; Potentially : Boolean)
+   is
+      Header : constant Iir := Get_Package_Header (Decl);
+   begin
+      --  LRM08 12.1 Declarative region
+      --  d) A package declaration together with the corresponding body
+      --
+      --  GHDL: the formal generic declarations are considered to be in the
+      --  same declarative region as the package declarations (and therefore
+      --  in the same scope), even if they don't occur immediately within a
+      --  package declaration.
+      if Header /= Null_Iir then
+         Add_Declarations (Get_Generic_Chain (Header), Potentially);
+      end if;
+
+      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
+   end Add_Package_Declarations;
+
+   procedure Add_Package_Instantiation_Declarations
+     (Decl: Iir; Potentially : Boolean) is
+   begin
+      --  LRM08 4.9 Package instantiation declarations
+      --  The package instantiation declaration is equivalent to declaration of
+      --  a generic-mapped package, consisting of a package declaration [...]
+      Add_Declarations (Get_Generic_Chain (Decl), Potentially);
+      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
+   end Add_Package_Instantiation_Declarations;
+
+   --  Add declarations from a package into the current declarative region.
+   --  This is needed when a package body is analysed.
+   procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is
+   begin
+      Add_Package_Declarations (Decl, False);
+   end Add_Package_Declarations;
+
+   procedure Add_Component_Declarations (Component: Iir_Component_Declaration)
+   is
+   begin
+      Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Component));
+      Add_Declarations_From_Interface_Chain (Get_Port_Chain (Component));
+   end Add_Component_Declarations;
+
+   procedure Add_Protected_Type_Declarations
+     (Decl : Iir_Protected_Type_Declaration) is
+   begin
+      Add_Declarations (Get_Declaration_Chain (Decl), False);
+   end Add_Protected_Type_Declarations;
+
+   procedure Extend_Scope_Of_Block_Declarations (Decl : Iir) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Architecture_Body =>
+            Add_Context_Clauses (Get_Design_Unit (Decl));
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            --  FIXME: formal, iterator ?
+            null;
+         when others =>
+            Error_Kind ("extend_scope_of_block_declarations", Decl);
+      end case;
+      Add_Declarations (Get_Declaration_Chain (Decl), False);
+      Add_Declarations_Of_Concurrent_Statement (Decl);
+   end Extend_Scope_Of_Block_Declarations;
+
+   procedure Use_Library_All (Library : Iir_Library_Declaration)
+   is
+      Design_File : Iir_Design_File;
+      Design_Unit : Iir_Design_Unit;
+      Library_Unit : Iir;
+   begin
+      Design_File := Get_Design_File_Chain (Library);
+      while Design_File /= Null_Iir loop
+         Design_Unit := Get_First_Design_Unit (Design_File);
+         while Design_Unit /= Null_Iir loop
+            Library_Unit := Get_Library_Unit (Design_Unit);
+            if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then
+               Add_Name (Design_Unit, Get_Identifier (Design_Unit), True);
+            end if;
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         Design_File := Get_Chain (Design_File);
+      end loop;
+   end Use_Library_All;
+
+   procedure Use_Selected_Name (Name : Iir) is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Overload_List =>
+            Add_Declarations_List (Get_Overload_List (Name), True);
+         when Iir_Kind_Error =>
+            null;
+         when others =>
+            Add_Declaration (Name, True);
+      end case;
+   end Use_Selected_Name;
+
+   procedure Use_All_Names (Name: Iir) is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Library_Declaration =>
+            Use_Library_All (Name);
+         when Iir_Kind_Package_Declaration =>
+            Add_Package_Declarations (Name, True);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Add_Package_Instantiation_Declarations (Name, True);
+         when Iir_Kind_Interface_Package_Declaration =>
+            --  LRM08 6.5.5 Interface package declarations
+            --  Within an entity declaration, an architecture body, a
+            --  component declaration, or an uninstantiated subprogram or
+            --  package declaration that declares a given interface package,
+            --  the name of the given interface package denotes an undefined
+            --  instance of the uninstantiated package.
+            Add_Package_Instantiation_Declarations (Name, True);
+         when Iir_Kind_Error =>
+            null;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Use_All_Names;
+
+   procedure Add_Use_Clause (Clause : Iir_Use_Clause)
+   is
+      Name : Iir;
+      Cl : Iir_Use_Clause;
+   begin
+      Cl := Clause;
+      loop
+         Name := Get_Selected_Name (Cl);
+         if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then
+            Use_All_Names (Get_Named_Entity (Get_Prefix (Name)));
+         else
+            Use_Selected_Name (Get_Named_Entity (Name));
+         end if;
+         Cl := Get_Use_Clause_Chain (Cl);
+         exit when Cl = Null_Iir;
+      end loop;
+   end Add_Use_Clause;
+
+   -- Debugging
+   procedure Disp_Detailed_Interpretations (Ident : Name_Id)
+   is
+      use Ada.Text_IO;
+      use Name_Table;
+
+      Inter: Name_Interpretation_Type;
+      Decl : Iir;
+   begin
+      Put (Name_Table.Image (Ident));
+      Put_Line (":");
+
+      Inter := Get_Interpretation (Ident);
+      while Valid_Interpretation (Inter) loop
+         Put (Name_Interpretation_Type'Image (Inter));
+         if Is_Potentially_Visible (Inter) then
+            Put (" (use)");
+         end if;
+         Put (": ");
+         Decl := Get_Declaration (Inter);
+         Put (Iir_Kind'Image (Get_Kind (Decl)));
+         Put_Line (", loc: " & Get_Location_Str (Get_Location (Decl)));
+         if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
+            Put_Line ("   " & Disp_Subprg (Decl));
+         end if;
+         Inter := Get_Next_Interpretation (Inter);
+      end loop;
+   end Disp_Detailed_Interpretations;
+
+   procedure Disp_All_Interpretations
+     (Interpretation: Name_Interpretation_Type)
+   is
+      use Ada.Text_IO;
+      Inter: Name_Interpretation_Type;
+   begin
+      Inter := Interpretation;
+      while Valid_Interpretation (Inter) loop
+         Put (Name_Interpretation_Type'Image (Inter));
+         Put ('.');
+         Put (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter))));
+         Inter := Get_Next_Interpretation (Inter);
+      end loop;
+      New_Line;
+   end Disp_All_Interpretations;
+
+   procedure Disp_All_Names
+   is
+      use Ada.Text_IO;
+      Inter: Name_Interpretation_Type;
+   begin
+      for I in 0 .. Name_Table.Last_Name_Id loop
+         Inter := Get_Interpretation (I);
+         if Valid_Interpretation (Inter) then
+            Put (Name_Table.Image (I));
+            Put (Name_Id'Image (I));
+            Put (':');
+            Disp_All_Interpretations (Inter);
+         end if;
+      end loop;
+      Put_Line ("interprations.last = "
+                & Name_Interpretation_Type'Image (Interpretations.Last));
+      Put_Line ("current_scope_start ="
+                & Name_Interpretation_Type'Image (Current_Scope_Start));
+   end Disp_All_Names;
+
+   procedure Disp_Scopes
+   is
+      use Ada.Text_IO;
+   begin
+      for I in reverse Scopes.First .. Scopes.Last loop
+         declare
+            S : Scope_Cell renames Scopes.Table (I);
+         begin
+            case S.Kind is
+               when Save_Cell =>
+                  Put ("save_cell: '");
+                  Put (Name_Table.Image (S.Id));
+                  Put ("', old inter:");
+               when Hide_Cell =>
+                  Put ("hide_cell: to be inserted after ");
+               when Region_Start =>
+                  Put ("region_start at");
+               when Barrier_Start =>
+                  Put ("barrier_start at");
+               when Barrier_End =>
+                  Put ("barrier_end at");
+            end case;
+            Put_Line (Name_Interpretation_Type'Image (S.Inter));
+         end;
+      end loop;
+   end Disp_Scopes;
+end Sem_Scopes;
diff --git a/src/sem_scopes.ads b/src/sem_scopes.ads
new file mode 100644
index 000000000..76faaf191
--- /dev/null
+++ b/src/sem_scopes.ads
@@ -0,0 +1,217 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+with Types; use Types;
+
+package Sem_Scopes is
+
+   --  The purpose of SEM_NAME package is to handle association between
+   --  identifiers and declarations.
+   --  Roughly speacking, it implements ch10 of LRM: scope and visibility.
+   --
+   --  Basic elements are: declarations and declarative region.
+   --  Declaration should be understood in the large meaning: any textual
+   --   construction declaring an identifier, which can be a label.
+   --  A declarative region contains declarations and possibly other
+   --   declarative regions.
+   --
+   --  Rules are scope, visibility and overloading.
+   --
+
+   -- Create and close a declarative region.
+   -- By closing a declarative region, all declarations made in this region
+   --  are discarded.
+   procedure Open_Declarative_Region;
+   procedure Close_Declarative_Region;
+
+   -- Add meaning DECL for its identifier to the current declarative region.
+   procedure Add_Name (Decl: Iir);
+   pragma Inline (Add_Name);
+
+   -- Add meaning DECL to the identifier IDENT.
+   -- POTENTIALLY is true if the identifier comes from a use clause.
+   procedure Add_Name (Decl: Iir; Ident : Name_Id; Potentially: Boolean);
+
+   --  Set the visible_flag of DECL to true.
+   procedure Name_Visible (Decl : Iir);
+
+   --  Replace the interpretation OLD of ID by DECL.
+   --  ID must have a uniq interpretation OLD (ie, it must not be overloaded).
+   --  The interpretation must have been done in the current scope.
+   --
+   --  This procedure is used when the meaning of a name is changed due to its
+   --  analysis, eg: when a concurrent_procedure_call_statement becomes
+   --  a component_instantiation_statement.
+   procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir);
+
+   --  Interpretation is a simply linked list of what an identifier means.
+   --  In LRM08 12.3 Visibility, the sentence is 'the declaration defines a
+   --  possible meaning of this occurrence'.
+   --  FIXME: replace Interpretation by Meaning.
+   type Name_Interpretation_Type is private;
+
+   --  Return true if INTER is a valid interpretation, ie has a corresponding
+   --  declaration.  There are only two invalids interpretations, which
+   --  are declared just below as constants.
+   function Valid_Interpretation (Inter : Name_Interpretation_Type)
+                                 return Boolean;
+   pragma Inline (Valid_Interpretation);
+
+   --  This pseudo interpretation marks the end of the interpretation chain,
+   --  and means there is no (more) interpretations for the name.
+   --  Unless you need to discriminate between an absence of declaration and
+   --  a conflict between potential declarations, you should use the
+   --  VALID_INTERPRETATION function.
+   No_Name_Interpretation : constant Name_Interpretation_Type;
+
+   --  This pseudo interpretation means the name has only conflicting potential
+   --  declarations, and also terminates the chain of interpretations.
+   --  Unless you need to discriminate between an absence of declaration and
+   --  a conflict between potential declarations, you should use the
+   --  VALID_INTERPRETATION function.
+   Conflict_Interpretation : constant Name_Interpretation_Type;
+
+   -- Get the first interpretation of identifier ID.
+   function Get_Interpretation (Id: Name_Id) return Name_Interpretation_Type;
+   pragma Inline (Get_Interpretation);
+
+   -- Get the next interpretation from an interpretation.
+   function Get_Next_Interpretation (Ni: Name_Interpretation_Type)
+                                     return Name_Interpretation_Type;
+   pragma Inline (Get_Next_Interpretation);
+
+   --  Get a declaration associated with an interpretation.
+   function Get_Declaration (Ni: Name_Interpretation_Type) return Iir;
+   pragma Inline (Get_Declaration);
+
+   --  Same as Get_Declaration, but get the name of non-object alias.
+   --  (ie, can never returns an object alias).
+   function Get_Non_Alias_Declaration (Ni: Name_Interpretation_Type)
+                                      return Iir;
+
+   --  Get the previous interpretation of identifier ID, ie the interpretation
+   --  for ID before the current interpretation of ID.
+   function Get_Under_Interpretation (Id : Name_Id)
+     return Name_Interpretation_Type;
+
+   -- Return TRUE if INTER was made directly visible via a use clause.
+   function Is_Potentially_Visible (Inter: Name_Interpretation_Type)
+     return Boolean;
+   pragma Inline (Is_Potentially_Visible);
+
+   --  Return TRUE if INTER was made direclty visible in the current
+   --  declarative region.  Note this is different from being declared in the
+   --  current declarative region because of use clauses.
+   function Is_In_Current_Declarative_Region (Inter: Name_Interpretation_Type)
+     return Boolean;
+   pragma Inline (Is_In_Current_Declarative_Region);
+
+   -- Push and pop all interpretations.
+   -- This can be used to suspend name interpretation, in case of recursive
+   -- semantics.
+   -- After a push, all names have no_name_interpretation.
+   -- Pop restore the previous state.
+   procedure Pop_Interpretations;
+   procedure Push_Interpretations;
+
+   -- Execute a use clause on NAME.
+   -- Make potentially directly visible declarations of NAMES.
+   --procedure Use_Selected_Name (Name : Iir);
+   procedure Use_All_Names (Name: Iir);
+
+   --  Achieves visibility of the selected_name of use clause CLAUSE.
+   procedure Add_Use_Clause (Clause : Iir_Use_Clause);
+
+   --  Add declarations for a context clause into the current declarative
+   --  regions.
+   procedure Add_Context_Clauses (Unit : Iir_Design_Unit);
+
+   -- Add declarations from an entity into the current declarative region.
+   -- This is needed when an architecture is analysed.
+   procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration);
+
+   -- Add declarations from a package into the current declarative region.
+   -- This is needed when a package body is analysed.
+   -- FIXME:  this must be done as if the declarative region was extended.
+   procedure Add_Package_Declarations (Decl: Iir_Package_Declaration);
+
+   --  Add interfaces declaration of a component into the current declarative
+   --  region.
+   procedure Add_Component_Declarations
+     (Component : Iir_Component_Declaration);
+
+   --  Add declarations from a protected type declaration into the current
+   --  declaration region (which is expected to be the region of the protected
+   --  type body).
+   procedure Add_Protected_Type_Declarations
+     (Decl : Iir_Protected_Type_Declaration);
+
+   --  Add declarations of interface chain CHAIN into the current
+   --  declarative region.
+   procedure Add_Declarations_From_Interface_Chain (Chain : Iir);
+
+   --  Add all declarations for concurrent statements declared in PARENT.
+   procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir);
+
+   --  Add declarations of a declaration chain CHAIN.
+   procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False);
+
+   --  Scope extension area contains declarations from another declarative
+   --  region.  These area are abstract and only used to be able to add
+   --  and remove declarations.
+   procedure Open_Scope_Extension;
+   procedure Close_Scope_Extension;
+
+   -- Add any declarations that include the end of the declarative part of
+   --  the given block BLOCK.  This follow rules of LRM93 10.2
+   -- FIXME: BLOCK must be an architecture at first, then blocks declared
+   --  inside this architecture, then a block declared inside this block...
+   -- This procedure must be called after an Open_Scope_Extension and
+   --  declarations added can be removed with Close_Scope_Extension.
+   procedure Extend_Scope_Of_Block_Declarations (Decl : Iir);
+
+   --  Call HANDLE_DECL for each declaration found in DECL.
+   --  This will generally call HANDLE_DECL with DECL.
+   --  For types, HANDLE_DECL is first called with the type declaration, then
+   --  with implicit functions, with element literals for enumeration type,
+   --  and units for physical type.
+   generic
+      type Arg_Type is private;
+      with procedure Handle_Decl (Decl : Iir; Arg : Arg_Type);
+   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type);
+
+   --  Call HANDLE_DECL for each declaration found in DECL_LIST.
+   --  Generally, HANDLE_DECL must be an ITERATOR_DECL; this is not
+   --  automatically done, since the user might be interested in using the
+   --  ITERATOR_DECL.
+   generic
+      type Arg_Type is private;
+      with procedure Handle_Decl (Decl : Iir; Arg : Arg_Type);
+   procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type);
+
+   generic
+      type Arg_Type is private;
+      with procedure Handle_Decl (Decl : Iir; Arg : Arg_Type);
+   procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type);
+
+private
+   type Name_Interpretation_Type is new Int32 range 0 .. (2 ** 30) - 1;
+   No_Name_Interpretation : constant Name_Interpretation_Type := 0;
+   Conflict_Interpretation : constant Name_Interpretation_Type := 1;
+   First_Valid_Interpretation : constant Name_Interpretation_Type := 2;
+end Sem_Scopes;
diff --git a/src/sem_specs.adb b/src/sem_specs.adb
new file mode 100644
index 000000000..ca821b27e
--- /dev/null
+++ b/src/sem_specs.adb
@@ -0,0 +1,1731 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs_Utils; use Iirs_Utils;
+with Sem_Expr; use Sem_Expr;
+with Sem_Names; use Sem_Names;
+with Evaluation; use Evaluation;
+with Std_Package; use Std_Package;
+with Errorout; use Errorout;
+with Sem; use Sem;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Assocs; use Sem_Assocs;
+with Libraries;
+with Iir_Chains; use Iir_Chains;
+with Flags; use Flags;
+with Name_Table;
+with Std_Names;
+with Sem_Decls;
+with Xrefs; use Xrefs;
+with Back_End;
+
+package body Sem_Specs is
+   function Get_Entity_Class_Kind (Decl : Iir) return Tokens.Token_Type
+   is
+      use Tokens;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Entity_Declaration =>
+            return Tok_Entity;
+         when Iir_Kind_Architecture_Body =>
+            return Tok_Architecture;
+         when Iir_Kind_Configuration_Declaration =>
+            return Tok_Configuration;
+         when Iir_Kind_Package_Declaration =>
+            return Tok_Package;
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            return Tok_Procedure;
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Implicit_Function_Declaration =>
+            return Tok_Function;
+         when Iir_Kind_Type_Declaration =>
+            return Tok_Type;
+         when Iir_Kind_Subtype_Declaration =>
+            return Tok_Subtype;
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Interface_Constant_Declaration =>
+            return Tok_Constant;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration =>
+            return Tok_Signal;
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration =>
+            return Tok_Variable;
+         when Iir_Kind_Component_Declaration =>
+            return Tok_Component;
+         when Iir_Kind_Concurrent_Conditional_Signal_Assignment
+           | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Case_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement
+           | Iir_Kind_Null_Statement =>
+            return Tok_Label;
+         when Iir_Kind_Enumeration_Literal =>
+            return Tok_Literal;
+         when Iir_Kind_Unit_Declaration =>
+            return Tok_Units;
+         when Iir_Kind_Group_Declaration =>
+            return Tok_Group;
+         when Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return Tok_File;
+         when Iir_Kind_Attribute_Declaration =>
+            --  Even if an attribute can't have a attribute...
+            --  Because an attribute declaration can appear in a declaration
+            --  region.
+            return Tok_Attribute;
+         when others =>
+            Error_Kind ("get_entity_class_kind", Decl);
+      end case;
+      return Tok_Invalid;
+   end Get_Entity_Class_Kind;
+
+   --  Decorate DECL with attribute ATTR.
+   --  If CHECK_CLASS is true, class of DECL must be class of ATTR, otherwise
+   --   returns silently.
+   --  If CHECK_DEFINED is true, DECL must not have been decorated, otherwise
+   --   returns silently.
+   procedure Attribute_A_Decl
+     (Decl : Iir;
+      Attr : Iir_Attribute_Specification;
+      Check_Class : Boolean;
+      Check_Defined : Boolean)
+   is
+      use Tokens;
+      El : Iir_Attribute_Value;
+
+      --  Attribute declaration corresponding to ATTR.
+      --  Due to possible error, it is not required to be an attribute decl,
+      --  it may be a simple name.
+      Attr_Decl : Iir;
+   begin
+      --  LRM93 5.1
+      --  It is an error if the class of those names is not the same as that
+      --  denoted by the entity class.
+      if Get_Entity_Class_Kind (Decl) /= Get_Entity_Class (Attr) then
+         if Check_Class then
+            Error_Msg_Sem (Disp_Node (Decl) & " is not of class '"
+                           & Tokens.Image (Get_Entity_Class (Attr)) & ''',
+                           Attr);
+            if Get_Kind (Decl) = Iir_Kind_Subtype_Declaration
+              and then Get_Entity_Class (Attr) = Tok_Type
+              and then Get_Type (Decl) /= Null_Iir
+              and then Get_Base_Type (Get_Type (Decl)) /= Null_Iir
+              and then Get_Kind
+              (Get_Type_Declarator (Get_Base_Type (Get_Type (Decl))))
+              = Iir_Kind_Anonymous_Type_Declaration
+            then
+               --  The type declaration declares an anonymous type
+               --  and a named subtype.
+               Error_Msg_Sem
+                 ("'" & Image_Identifier (Decl)
+                  & "' declares both an anonymous type and a named subtype",
+                  Decl);
+            end if;
+         end if;
+         return;
+      end if;
+
+      --  LRM93 §5.1
+      --  An attribute specification for an attribute of a design unit
+      --  (ie an entity declaration, an architecture, a configuration, or a
+      --  package) must appear immediately within the declarative part of
+      --  that design unit.
+      case Get_Entity_Class (Attr) is
+         when Tok_Entity
+           | Tok_Architecture
+           | Tok_Configuration
+           | Tok_Package =>
+            if Get_Design_Unit (Decl) /= Get_Current_Design_Unit then
+               Error_Msg_Sem (Disp_Node (Attr) & " must appear immediatly "
+                              & "within " & Disp_Node (Decl), Attr);
+               return;
+            end if;
+         when others =>
+            null;
+      end case;
+
+      Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Attr));
+
+      --  LRM93 5.1
+      --  It is an error if a given attribute is associated more than once with
+      --  a given named entity.
+      --  LRM 5.1
+      --  Similarly, it is an error if two different attributes with the
+      --  same simple name (wether predefined or user-defined) are both
+      --  associated with a given named entity.
+      El := Get_Attribute_Value_Chain (Decl);
+      while El /= Null_Iir loop
+         declare
+            El_Attr : constant Iir_Attribute_Declaration :=
+              Get_Named_Entity (Get_Attribute_Designator
+                                  (Get_Attribute_Specification (El)));
+         begin
+            if El_Attr = Attr_Decl then
+               if Get_Attribute_Specification (El) = Attr then
+                  --  Was already specified with the same attribute value.
+                  --  This is possible only in one case:
+                  --
+                  --    signal S1       : real;
+                  --    alias  S1_too   : real is S1;
+                  --    attribute ATTR : T1;
+                  --    attribute ATTR of ALL : signal is '1';
+                  return;
+               end if;
+               if Check_Defined then
+                  Error_Msg_Sem
+                    (Disp_Node (Decl) & " has already " & Disp_Node (Attr),
+                     Attr);
+                  Error_Msg_Sem ("previous attribute specification at "
+                                 & Disp_Location (El), Attr);
+               end if;
+               return;
+            elsif Get_Identifier (El_Attr) = Get_Identifier (Attr_Decl) then
+               Error_Msg_Sem
+                 (Disp_Node (Decl) & " is already decorated with an "
+                  & Disp_Node (El_Attr), Attr);
+               Error_Msg_Sem
+                 ("(previous attribute specification was here)", El);
+               return;
+            end if;
+         end;
+         El := Get_Chain (El);
+      end loop;
+
+      El := Create_Iir (Iir_Kind_Attribute_Value);
+      Location_Copy (El, Attr);
+      Set_Name_Staticness (El, None);
+      Set_Attribute_Specification (El, Attr);
+      --  FIXME: create an expr_error node?
+      declare
+         Expr : Iir;
+      begin
+         Expr := Get_Expression (Attr);
+         if Expr = Error_Mark then
+            Set_Expr_Staticness (El, Locally);
+         else
+            Set_Expr_Staticness (El, Get_Expr_Staticness (Expr));
+         end if;
+      end;
+      Set_Designated_Entity (El, Decl);
+      Set_Type (El, Get_Type (Attr_Decl));
+      Set_Base_Name (El, El);
+      Set_Chain (El, Get_Attribute_Value_Chain (Decl));
+      Set_Attribute_Value_Chain (Decl, El);
+      Set_Spec_Chain (El, Get_Attribute_Value_Spec_Chain (Attr));
+      Set_Attribute_Value_Spec_Chain (Attr, El);
+
+      if (Flags.Vhdl_Std >= Vhdl_93c
+          and then Attr_Decl = Foreign_Attribute)
+        or else
+        (Flags.Vhdl_Std <= Vhdl_93c
+         and then Get_Identifier (Attr_Decl) = Std_Names.Name_Foreign)
+      then
+         --  LRM93 12.4
+         --  The 'FOREIGN attribute may be associated only with
+         --  architectures or with subprograms.
+         case Get_Entity_Class (Attr) is
+            when Tok_Architecture =>
+               null;
+
+            when Tok_Function
+              | Tok_Procedure =>
+               --  LRM93 12.4
+               --  In the latter case, the attribute specification must
+               --  appear in the declarative part in which the subprogram
+               --  is declared.
+               --  GHDL: huh, this is the case for any attributes.
+               null;
+
+            when others =>
+               Error_Msg_Sem
+                 ("'FOREIGN allowed only for architectures and subprograms",
+                  Attr);
+               return;
+         end case;
+
+         Set_Foreign_Flag (Decl, True);
+
+         declare
+            use Back_End;
+         begin
+            if Sem_Foreign /= null then
+               Sem_Foreign.all (Decl);
+            end if;
+         end;
+      end if;
+   end Attribute_A_Decl;
+
+   --  IS_DESIGNATORS if true if the entity name list is a list of designators.
+   --  Return TRUE if an entity was attributed.
+   function Sem_Named_Entities
+     (Scope : Iir;
+      Name : Iir;
+      Attr : Iir_Attribute_Specification;
+      Is_Designators : Boolean;
+      Check_Defined : Boolean)
+     return Boolean
+   is
+      Res : Boolean;
+
+      --  If declaration DECL matches then named entity ENT, apply attribute
+      --  specification and returns TRUE. Otherwise, return FALSE.
+      --  Note: ENT and DECL are different for aliases.
+      function Sem_Named_Entity1 (Ent : Iir; Decl : Iir) return Boolean
+      is
+         Ent_Id : constant Name_Id := Get_Identifier (Ent);
+      begin
+         if (Name = Null_Iir or else Ent_Id = Get_Identifier (Name))
+           and then Ent_Id /= Null_Identifier
+         then
+            if Is_Designators then
+               Xref_Ref (Name, Ent);
+            end if;
+            if Get_Visible_Flag (Ent) = False then
+               Error_Msg_Sem
+                 (Disp_Node (Ent) & " is not yet visible", Attr);
+            else
+               Attribute_A_Decl (Decl, Attr, Is_Designators, Check_Defined);
+               return True;
+            end if;
+         end if;
+         return False;
+      end Sem_Named_Entity1;
+
+      procedure Sem_Named_Entity (Ent : Iir) is
+      begin
+         case Get_Kind (Ent) is
+            when Iir_Kinds_Library_Unit_Declaration
+              | Iir_Kinds_Concurrent_Statement
+              | Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration
+              | Iir_Kinds_Sequential_Statement
+              | Iir_Kinds_Non_Alias_Object_Declaration
+              | Iir_Kind_Type_Declaration
+              | Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Component_Declaration
+              | Iir_Kind_Enumeration_Literal
+              | Iir_Kind_Unit_Declaration
+              | Iir_Kind_Group_Template_Declaration
+              | Iir_Kind_Group_Declaration =>
+               Res := Res or Sem_Named_Entity1 (Ent, Ent);
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               if not Is_Second_Subprogram_Specification (Ent) then
+                  Res := Res or Sem_Named_Entity1 (Ent, Ent);
+               end if;
+            when Iir_Kind_Object_Alias_Declaration =>
+               --  LRM93 5.1
+               --  An entity designator that denotes an alias of an object is
+               --  required to denote the entire object, and not a subelement
+               --  or slice thereof.
+               declare
+                  Decl : constant Iir := Get_Name (Ent);
+                  Base : constant Iir := Get_Object_Prefix (Decl, False);
+                  Applied : Boolean;
+               begin
+                  Applied := Sem_Named_Entity1 (Ent, Base);
+                  --  FIXME: check the alias denotes a local entity...
+                  if Applied
+                    and then Base /= Strip_Denoting_Name (Decl)
+                  then
+                     Error_Msg_Sem
+                       (Disp_Node (Ent) & " does not denote the entire object",
+                        Attr);
+                  end if;
+                  Res := Res or Applied;
+               end;
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               Res := Res
+                 or Sem_Named_Entity1 (Ent, Get_Named_Entity (Get_Name (Ent)));
+            when Iir_Kind_Attribute_Declaration
+              | Iir_Kind_Attribute_Specification
+              | Iir_Kind_Configuration_Specification
+              | Iir_Kind_Use_Clause =>
+               null;
+            when Iir_Kind_Procedure_Body
+              | Iir_Kind_Function_Body =>
+               null;
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               null;
+            when others =>
+               Error_Kind ("sem_named_entity", Ent);
+         end case;
+      end Sem_Named_Entity;
+
+      procedure Sem_Named_Entity_Chain (Chain_First : Iir)
+      is
+         El : Iir;
+         Def : Iir;
+      begin
+         El := Chain_First;
+         while El /= Null_Iir loop
+            exit when El = Attr;
+            Sem_Named_Entity (El);
+            case Get_Kind (El) is
+               when Iir_Kind_Type_Declaration =>
+                  Def := Get_Type_Definition (El);
+                  if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
+                     declare
+                        List : Iir_List;
+                        El1 : Iir;
+                     begin
+                        List := Get_Enumeration_Literal_List (Def);
+                        for I in Natural loop
+                           El1 := Get_Nth_Element (List, I);
+                           exit when El1 = Null_Iir;
+                           Sem_Named_Entity (El1);
+                        end loop;
+                     end;
+                  end if;
+               when Iir_Kind_Anonymous_Type_Declaration =>
+                  Def := Get_Type_Definition (El);
+                  if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
+                     declare
+                        El1 : Iir;
+                     begin
+                        El1 := Get_Unit_Chain (Def);
+                        while El1 /= Null_Iir loop
+                           Sem_Named_Entity (El1);
+                           El1 := Get_Chain (El1);
+                        end loop;
+                     end;
+                  end if;
+               when Iir_Kind_For_Loop_Statement
+                 | Iir_Kind_While_Loop_Statement =>
+                  Sem_Named_Entity_Chain (Get_Sequential_Statement_Chain (El));
+               when Iir_Kind_If_Statement =>
+                  declare
+                     Clause : Iir;
+                  begin
+                     Clause := El;
+                     while Clause /= Null_Iir loop
+                        Sem_Named_Entity_Chain
+                          (Get_Sequential_Statement_Chain (Clause));
+                        Clause := Get_Else_Clause (Clause);
+                     end loop;
+                  end;
+               when Iir_Kind_Case_Statement =>
+                  declare
+                     El1 : Iir;
+                  begin
+                     El1 := Get_Case_Statement_Alternative_Chain (El);
+                     while El1 /= Null_Iir loop
+                        Sem_Named_Entity_Chain (Get_Associated_Chain (El1));
+                        El1 := Get_Chain (El1);
+                     end loop;
+                  end;
+
+               when Iir_Kind_Generate_Statement =>
+                  --  INT-1991/issue 27
+                  --  Generate statements represent declarative region and
+                  --  have implicit declarative parts.
+                  --  Was: There is no declarative part in generate statement
+                  --  for VHDL 87.
+                  if False and then Flags.Vhdl_Std = Vhdl_87 then
+                     Sem_Named_Entity_Chain
+                       (Get_Concurrent_Statement_Chain (El));
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end Sem_Named_Entity_Chain;
+   begin
+      Res := False;
+
+      --  LRM 5.1  Attribute specification
+      --  o If a list of entity designators is supplied, then the
+      --  attribute specification applies to the named entities denoted
+      --  by those designators.
+      --
+      --  o If the reserved word OTHERS is supplied, then the attribute
+      --  specification applies to named entities of the specified class
+      --  that are declared in the immediately enclosing declarative
+      --  part [...]
+      --
+      --  o If the reserved word ALL is supplied, then the attribute
+      --  specification applies to all named entities of the specified
+      --  class that are declared in the immediatly enclosing
+      --  declarative part.
+
+      --  NOTE: therefore, ALL/OTHERS do not apply to named entities declared
+      --  beyond the immediate declarative part, such as design unit or
+      --  interfaces.
+      if Is_Designators then
+         --  LRM 5.1  Attribute specification
+         --  An attribute specification for an attribute of a design unit
+         --  (i.e. an entity declaration, an architecture, a configuration
+         --  or a package) must appear immediatly within the declarative part
+         --  of that design unit.
+         case Get_Kind (Scope) is
+            when Iir_Kind_Entity_Declaration
+              | Iir_Kind_Architecture_Body
+              | Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Package_Declaration =>
+               Sem_Named_Entity (Scope);
+            when others =>
+               null;
+         end case;
+
+         --  LRM 5.1  Attribute specification
+         --  Similarly, an attribute specification for an attribute of an
+         --  interface object of a design unit, subprogram or block statement
+         --  must appear immediatly within the declarative part of that design
+         --  unit, subprogram, or block statement.
+         case Get_Kind (Scope) is
+            when Iir_Kind_Entity_Declaration =>
+               Sem_Named_Entity_Chain (Get_Generic_Chain (Scope));
+               Sem_Named_Entity_Chain (Get_Port_Chain (Scope));
+            when Iir_Kind_Block_Statement =>
+               declare
+                  Header : constant Iir := Get_Block_Header (Scope);
+               begin
+                  if Header /= Null_Iir then
+                     Sem_Named_Entity_Chain (Get_Generic_Chain (Header));
+                     Sem_Named_Entity_Chain (Get_Port_Chain (Header));
+                  end if;
+               end;
+            when Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body =>
+               declare
+                  Spec : Iir;
+               begin
+                  Spec := Get_Subprogram_Specification (Scope);
+                  Sem_Named_Entity_Chain
+                    (Get_Interface_Declaration_Chain (Spec));
+               end;
+            when others =>
+               null;
+         end case;
+      end if;
+
+      case Get_Kind (Scope) is
+         when Iir_Kind_Entity_Declaration
+           | Iir_Kind_Architecture_Body
+           | Iir_Kind_Generate_Statement =>
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+            Sem_Named_Entity_Chain (Get_Concurrent_Statement_Chain (Scope));
+         when Iir_Kind_Block_Statement =>
+            declare
+               Guard : constant Iir := Get_Guard_Decl (Scope);
+            begin
+               if Guard /= Null_Iir then
+                  Sem_Named_Entity (Guard);
+               end if;
+            end;
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+            Sem_Named_Entity_Chain (Get_Concurrent_Statement_Chain (Scope));
+         when Iir_Kind_Configuration_Declaration =>
+            null;
+         when Iir_Kind_Package_Declaration =>
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+         when Iir_Kinds_Process_Statement =>
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+            Sem_Named_Entity_Chain (Get_Sequential_Statement_Chain (Scope));
+         when Iir_Kind_Package_Body =>
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
+            Sem_Named_Entity_Chain (Get_Sequential_Statement_Chain (Scope));
+         when others =>
+            Error_Kind ("sem_named_entities", Scope);
+      end case;
+      return Res;
+   end Sem_Named_Entities;
+
+   procedure Sem_Signature_Entity_Designator
+     (Sig : Iir_Signature; Attr : Iir_Attribute_Specification)
+   is
+      Prefix : Iir;
+      Inter : Name_Interpretation_Type;
+      List : Iir_List;
+      Name : Iir;
+   begin
+      List := Create_Iir_List;
+
+      --  Sem_Name cannot be used here (at least not directly) because only
+      --  the declarations of the current scope are considered.
+      Prefix := Get_Signature_Prefix (Sig);
+      Inter := Get_Interpretation (Get_Identifier (Prefix));
+      while Valid_Interpretation (Inter) loop
+         exit when not Is_In_Current_Declarative_Region (Inter);
+         if not Is_Potentially_Visible (Inter) then
+            Name := Get_Declaration (Inter);
+            --  LRM 5.1 Attribute Specification
+            --  The entity tag of an entity designator containing a signature
+            --  must denote the name of one or more subprograms or enumeration
+            --  literals.
+            case Get_Kind (Name) is
+               when Iir_Kind_Function_Declaration
+                 | Iir_Kind_Implicit_Function_Declaration
+                 | Iir_Kind_Procedure_Declaration
+                 | Iir_Kind_Implicit_Procedure_Declaration
+                 | Iir_Kind_Enumeration_Literal =>
+                  Append_Element (List, Name);
+               when others =>
+                  Error_Msg_Sem
+                    ("entity tag must denote a subprogram or a literal", Sig);
+            end case;
+         end if;
+         Inter := Get_Next_Interpretation (Inter);
+      end loop;
+
+      Name := Sem_Decls.Sem_Signature (Create_Overload_List (List), Sig);
+      if Name = Null_Iir then
+         return;
+      end if;
+
+      Set_Named_Entity (Prefix, Name);
+      Prefix := Finish_Sem_Name (Prefix);
+      Set_Signature_Prefix (Sig, Prefix);
+
+      Attribute_A_Decl (Name, Attr, True, True);
+   end Sem_Signature_Entity_Designator;
+
+   procedure Sem_Attribute_Specification
+     (Spec : Iir_Attribute_Specification;
+      Scope : Iir)
+   is
+      use Tokens;
+
+      Name : Iir;
+      Attr : Iir_Attribute_Declaration;
+      List : Iir_List;
+      Expr : Iir;
+      Res : Boolean;
+   begin
+      --  LRM93 5.1
+      --  The attribute designator must denote an attribute.
+      Name := Sem_Denoting_Name (Get_Attribute_Designator (Spec));
+      Set_Attribute_Designator (Spec, Name);
+
+      Attr := Get_Named_Entity (Name);
+      if Get_Kind (Attr) /= Iir_Kind_Attribute_Declaration then
+         Error_Class_Match (Name, "attribute");
+         return;
+      end if;
+
+      --  LRM 5.1
+      --  The type of the expression in the attribute specification must be
+      --  the same as (or implicitly convertible to) the type mark in the
+      --  corresponding attribute declaration.
+      Expr := Sem_Expression (Get_Expression (Spec), Get_Type (Attr));
+      if Expr /= Null_Iir then
+         Check_Read (Expr);
+         Set_Expression (Spec, Eval_Expr_If_Static (Expr));
+
+         --  LRM 5.1
+         --  If the entity name list denotes an entity declaration,
+         --  architecture body or configuration declaration, then the
+         --  expression is required to be locally static.
+         --  GHDL: test based on the entity_class.
+         case Get_Entity_Class (Spec) is
+            when Tok_Entity
+              | Tok_Architecture
+              | Tok_Configuration =>
+               if Get_Expr_Staticness (Expr) /= Locally then
+                  Error_Msg_Sem
+                    ("attribute expression for "
+                     & Image (Get_Entity_Class (Spec))
+                     & " must be locally static", Spec);
+               end if;
+            when others =>
+               null;
+         end case;
+      else
+         Set_Expression (Spec, Error_Mark);
+      end if;
+
+      --  LRM 5.1
+      --  The entity name list identifies those named entities, both
+      --  implicitly and explicitly defined, that inherit the attribute, as
+      --  defined below:
+      List := Get_Entity_Name_List (Spec);
+      if List = Iir_List_All then
+         --  o If the reserved word ALL is supplied, then the attribute
+         --  specification applies to all named entities of the specified
+         --  class that are declared in the immediatly enclosing
+         --  declarative part.
+         Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, True);
+         if Res = False and then Flags.Warn_Specs then
+            Warning_Msg_Sem
+              ("attribute specification apply to no named entity", Spec);
+         end if;
+      elsif List = Iir_List_Others then
+         --  o If the reserved word OTHERS is supplied, then the attribute
+         --  specification applies to named entities of the specified class
+         --  that are declared in the immediately enclosing declarative
+         --  part, provided that each such entity is not explicitly named
+         --  in the entity name list of a previous attribute specification
+         --  for the given attribute.
+         Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, False);
+         if Res = False and then Flags.Warn_Specs then
+            Warning_Msg_Sem
+              ("attribute specification apply to no named entity", Spec);
+         end if;
+      else
+         --  o If a list of entity designators is supplied, then the
+         --  attribute specification applies to the named entities denoted
+         --  by those designators.
+         declare
+            El : Iir;
+         begin
+            for I in Natural loop
+               El := Get_Nth_Element (List, I);
+               exit when El = Null_Iir;
+               if Get_Kind (El) = Iir_Kind_Signature then
+                  Sem_Signature_Entity_Designator (El, Spec);
+               else
+                  --  LRM 5.1
+                  --  It is an error if the class of those names is not the
+                  --  same as that denoted by entity class.
+                  if not Sem_Named_Entities (Scope, El, Spec, True, True) then
+                     Error_Msg_Sem
+                       ("no named entities '" & Image_Identifier (El)
+                        & "' in declarative part", El);
+                  end if;
+               end if;
+            end loop;
+         end;
+      end if;
+   end Sem_Attribute_Specification;
+
+   procedure Check_Post_Attribute_Specification
+     (Attr_Spec_Chain : Iir; Decl : Iir)
+   is
+      use Tokens;
+
+      Has_Error : Boolean;
+      Spec : Iir;
+      Decl_Class : Token_Type;
+      Decl_Class2 : Token_Type;
+      Ent_Class : Token_Type;
+   begin
+      --  Some declaration items can never be attributed.
+      Decl_Class2 := Tok_Eof;
+      case Get_Kind (Decl) is
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Use_Clause
+           | Iir_Kind_Attribute_Declaration
+           | Iir_Kinds_Signal_Attribute
+           | Iir_Kind_Disconnection_Specification =>
+            return;
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            --  A physical type definition declares units.
+            if Get_Kind (Get_Type_Definition (Decl))
+              = Iir_Kind_Physical_Type_Definition
+            then
+               Decl_Class := Tok_Units;
+            else
+               return;
+            end if;
+         when Iir_Kind_Attribute_Specification =>
+            Decl_Class := Get_Entity_Class (Decl);
+         when Iir_Kind_Type_Declaration =>
+            Decl_Class := Tok_Type;
+            --  An enumeration type declares literals.
+            if Get_Kind (Get_Type_Definition (Decl))
+              = Iir_Kind_Enumeration_Type_Definition
+            then
+               Decl_Class2 := Tok_Literal;
+            end if;
+         when Iir_Kind_Non_Object_Alias_Declaration
+           | Iir_Kind_Object_Alias_Declaration =>
+            Decl_Class := Get_Entity_Class_Kind (Get_Name (Decl));
+            --  NOTE: for non-object alias that declares an enumeration type
+            --  or a physical type, no need to set decl_class2, since
+            --  all implicit aliases are checked.
+         when others =>
+            Decl_Class := Get_Entity_Class_Kind (Decl);
+      end case;
+
+      Spec := Attr_Spec_Chain;
+      --  Skip itself (newly added, therefore first of the chain).
+      if Spec = Decl then
+         Spec := Get_Attribute_Specification_Chain (Spec);
+      end if;
+      while Spec /= Null_Iir loop
+         pragma Assert (Get_Entity_Name_List (Spec) in Iir_Lists_All_Others);
+         Ent_Class := Get_Entity_Class (Spec);
+         if Ent_Class = Decl_Class or Ent_Class = Decl_Class2 then
+            Has_Error := False;
+
+            if Get_Kind (Decl) = Iir_Kind_Attribute_Specification then
+               --  LRM 5.1  Attribute specifications
+               --  An attribute specification with the entity name list OTHERS
+               --  or ALL for a given entity class that appears in a
+               --  declarative part must be the last such specification for the
+               --  given attribute for the given entity class in that
+               --  declarative part.
+               if Get_Identifier (Get_Attribute_Designator (Decl))
+                 = Get_Identifier (Get_Attribute_Designator (Spec))
+               then
+                  Error_Msg_Sem
+                    ("no attribute specification may follow an "
+                       & "all/others spec", Decl);
+                  Has_Error := True;
+               end if;
+            else
+               --  LRM 5.1  Attribute specifications
+               --  It is an error if a named entity in the specificied entity
+               --  class is declared in a given declarative part following such
+               --  an attribute specification.
+               Error_Msg_Sem
+                 ("no named entity may follow an all/others attribute "
+                    & "specification", Decl);
+               Has_Error := True;
+            end if;
+            if Has_Error then
+               Error_Msg_Sem
+                 ("(previous all/others specification for the given "
+                    &"entity class)", Spec);
+            end if;
+         end if;
+         Spec := Get_Attribute_Specification_Chain (Spec);
+      end loop;
+   end Check_Post_Attribute_Specification;
+
+   --  Compare ATYPE and TYPE_MARK.
+   --  ATYPE is a type definition, which can be anonymous.
+   --  TYPE_MARK is a subtype definition, established from a type mark.
+   --   Therefore, it is the name of a type or a subtype.
+   --  Return TRUE iff the type mark of ATYPE is TYPE_MARK.
+   function Is_Same_Type_Mark (Atype : Iir; Type_Mark : Iir)
+                              return Boolean is
+   begin
+      if Get_Kind (Atype) in Iir_Kinds_Subtype_Definition
+        and then Is_Anonymous_Type_Definition (Atype)
+      then
+         --  FIXME: to be removed; used to catch uninitialized type_mark.
+         if Get_Subtype_Type_Mark (Atype) = Null_Iir then
+            raise Internal_Error;
+         end if;
+         return Get_Type (Get_Subtype_Type_Mark (Atype)) = Type_Mark;
+      else
+         return Atype = Type_Mark;
+      end if;
+   end Is_Same_Type_Mark;
+
+   procedure Sem_Disconnection_Specification
+     (Dis : Iir_Disconnection_Specification)
+   is
+      Type_Mark : Iir;
+      Atype : Iir;
+      Time_Expr : Iir;
+      List : Iir_List;
+      El : Iir;
+      Sig : Iir;
+      Prefix : Iir;
+   begin
+      --  Sem type mark.
+      Type_Mark := Get_Type_Mark (Dis);
+      Type_Mark := Sem_Type_Mark (Type_Mark);
+      Set_Type_Mark (Dis, Type_Mark);
+      Atype := Get_Type (Type_Mark);
+
+      --  LRM93 5.3
+      --  The time expression in a disconnection specification must be static
+      --  and must evaluate to a non-negative value.
+      Time_Expr := Sem_Expression
+        (Get_Expression (Dis), Time_Subtype_Definition);
+      if Time_Expr /= Null_Iir then
+         Check_Read (Time_Expr);
+         Set_Expression (Dis, Time_Expr);
+         if Get_Expr_Staticness (Time_Expr) < Globally then
+            Error_Msg_Sem ("time expression must be static", Time_Expr);
+         end if;
+      end if;
+
+      List := Get_Signal_List (Dis);
+      if List = Iir_List_All or List = Iir_List_Others then
+         --  FIXME: checks todo
+         null;
+      else
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+
+            Sem_Name (El);
+            El := Finish_Sem_Name (El);
+            Replace_Nth_Element (List, I, El);
+
+            Sig := Get_Named_Entity (El);
+            Sig := Name_To_Object (Sig);
+            if Sig /= Null_Iir then
+               Set_Type (El, Get_Type (Sig));
+               Prefix := Get_Object_Prefix (Sig);
+               --  LRM93 5.3
+               --  Each signal name in a signal list in a guarded signal
+               --  specification must be a locally static name that
+               --  denotes a guarded signal.
+               case Get_Kind (Prefix) is
+                  when Iir_Kind_Signal_Declaration
+                    | Iir_Kind_Interface_Signal_Declaration =>
+                     null;
+                  when others =>
+                     Error_Msg_Sem ("object must be a signal", El);
+                     return;
+               end case;
+               if Get_Name_Staticness (Sig) /= Locally then
+                  Error_Msg_Sem ("signal name must be locally static", El);
+               end if;
+               if Get_Signal_Kind (Prefix) = Iir_No_Signal_Kind then
+                  Error_Msg_Sem ("signal must be a guarded signal", El);
+               end if;
+               Set_Has_Disconnect_Flag (Prefix, True);
+
+               --  LRM93 5.3
+               --  If the guarded signal is a declared signal or a slice of
+               --  thereof, the type mark must be the same as the type mark
+               --  indicated in the guarded signal specification.
+               --  If the guarded signal is an array element of an explicitly
+               --  declared signal, the type mark must be the same as the
+               --  element subtype indication in the (explicit or implicit)
+               --  array type declaration that declares the base type of the
+               --  explicitly declared signal.
+               --  If the guarded signal is a record element of an explicitly
+               --  declared signal, then the type mark must be the same as
+               --  the type mark in the element subtype definition of the
+               --  record type declaration that declares the type of the
+               --  explicitly declared signal.
+               -- FIXME: to be checked: the expression type (as set by
+               --  sem_expression) may be a base type instead of a type mark.
+               if not Is_Same_Type_Mark (Get_Type (Sig), Atype) then
+                  Error_Msg_Sem ("type mark and signal type mismatch", El);
+               end if;
+
+               --  LRM93 5.3
+               --  Each signal must be declared in the declarative part
+               --  enclosing the disconnection specification.
+               --  FIXME: todo.
+            elsif Get_Designated_Entity (El) /= Error_Mark then
+               Error_Msg_Sem ("name must designate a signal", El);
+            end if;
+         end loop;
+      end if;
+   end Sem_Disconnection_Specification;
+
+   --  Semantize entity aspect ASPECT and return the entity declaration.
+   --  Return NULL_IIR if not found.
+   function Sem_Entity_Aspect (Aspect : Iir) return Iir is
+   begin
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Entity_Aspect_Entity =>
+            declare
+               Entity_Name : Iir;
+               Entity : Iir;
+               Arch_Name : Iir;
+               Arch_Unit : Iir;
+            begin
+               Entity_Name := Sem_Denoting_Name (Get_Entity_Name (Aspect));
+               Set_Entity_Name (Aspect, Entity_Name);
+               Entity := Get_Named_Entity (Entity_Name);
+               if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then
+                  Error_Class_Match (Entity_Name, "entity");
+                  return Null_Iir;
+               end if;
+               --  Note: dependency is added by Sem_Denoting_Name.
+
+               --  Check architecture.
+               Arch_Name := Get_Architecture (Aspect);
+               if Arch_Name /= Null_Iir then
+                  Arch_Unit := Libraries.Find_Secondary_Unit
+                    (Get_Design_Unit (Entity), Get_Identifier (Arch_Name));
+                  Set_Named_Entity (Arch_Name, Arch_Unit);
+                  if Arch_Unit /= Null_Iir then
+                     Xref_Ref (Arch_Name, Arch_Unit);
+                  end if;
+
+                  --  FIXME: may emit a warning if the architecture does not
+                  --  exist.
+                  --  Note: the design needs the architecture.
+                  Add_Dependence (Aspect);
+               end if;
+               return Entity;
+            end;
+
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            declare
+               Conf_Name : Iir;
+               Conf : Iir;
+            begin
+               Conf_Name :=
+                 Sem_Denoting_Name (Get_Configuration_Name (Aspect));
+               Set_Configuration_Name (Aspect, Conf_Name);
+               Conf := Get_Named_Entity (Conf_Name);
+               if Get_Kind (Conf) /= Iir_Kind_Configuration_Declaration then
+                  Error_Class_Match (Conf, "configuration");
+                  return Null_Iir;
+               end if;
+
+               return Get_Entity (Conf);
+            end;
+
+         when Iir_Kind_Entity_Aspect_Open =>
+            return Null_Iir;
+
+         when others =>
+            Error_Kind ("sem_entity_aspect", Aspect);
+      end case;
+   end Sem_Entity_Aspect;
+
+   procedure Sem_Binding_Indication (Bind : Iir_Binding_Indication;
+                                     Comp : Iir_Component_Declaration;
+                                     Parent : Iir;
+                                     Primary_Entity_Aspect : Iir)
+   is
+      Entity_Aspect : Iir;
+      Entity : Iir_Entity_Declaration;
+   begin
+      if Bind = Null_Iir then
+         raise Internal_Error;
+      end if;
+
+      Entity_Aspect := Get_Entity_Aspect (Bind);
+      if Entity_Aspect /= Null_Iir then
+         Entity := Sem_Entity_Aspect (Entity_Aspect);
+
+         --  LRM93 5.2.1  Binding Indication
+         --  An incremental binding indication must not have an entity aspect.
+         if Primary_Entity_Aspect /= Null_Iir then
+            Error_Msg_Sem
+              ("entity aspect not allowed for incremental binding", Bind);
+         end if;
+
+         --  Return now in case of error.
+         if Entity = Null_Iir then
+            return;
+         end if;
+      else
+         --  LRM93 5.2.1
+         --  When a binding indication is used in an explicit configuration
+         --  specification, it is an error if the entity aspect is absent.
+         case Get_Kind (Parent) is
+            when Iir_Kind_Component_Configuration =>
+               if Primary_Entity_Aspect = Null_Iir then
+                  Entity := Null_Iir;
+               else
+                  case Get_Kind (Primary_Entity_Aspect) is
+                     when Iir_Kind_Entity_Aspect_Entity =>
+                        Entity := Get_Entity (Primary_Entity_Aspect);
+                     when others =>
+                        Error_Kind
+                          ("sem_binding_indication", Primary_Entity_Aspect);
+                  end case;
+               end if;
+            when Iir_Kind_Configuration_Specification =>
+               Error_Msg_Sem
+                 ("entity aspect required in a configuration specification",
+                  Bind);
+               return;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end if;
+      if Entity = Null_Iir
+        or else Get_Kind (Entity) = Iir_Kind_Entity_Aspect_Open
+      then
+         --  LRM 5.2.1.1  Entity aspect
+         --  The third form of entity aspect is used to specify that the
+         --  indiciation of the design entity is to be defined.  In this case,
+         --  the immediatly enclosing binding indication is said to not
+         --  imply any design entity.  Furthermore, the immediatly enclosing
+         --  binding indication must not include a generic map aspect or a
+         --  port map aspect.
+         if Get_Generic_Map_Aspect_Chain (Bind) /= Null_Iir
+           or else Get_Port_Map_Aspect_Chain (Bind) /= Null_Iir
+         then
+            Error_Msg_Sem
+              ("map aspect not allowed for open entity aspect", Bind);
+            return;
+         end if;
+      else
+         Sem_Generic_Port_Association_Chain (Entity, Bind);
+
+         --  LRM 5.2.1 Binding Indication
+         --  If the generic map aspect or port map aspect of a binding
+         --  indication is not present, then the default rules as described
+         --  in 5.2.2 apply.
+         if Get_Generic_Map_Aspect_Chain (Bind) = Null_Iir
+           and then Primary_Entity_Aspect = Null_Iir
+         then
+            Set_Default_Generic_Map_Aspect_Chain
+              (Bind,
+               Create_Default_Map_Aspect (Comp, Entity, Map_Generic, Parent));
+         end if;
+         if Get_Port_Map_Aspect_Chain (Bind) = Null_Iir
+           and then Primary_Entity_Aspect = Null_Iir
+         then
+            Set_Default_Port_Map_Aspect_Chain
+              (Bind,
+               Create_Default_Map_Aspect (Comp, Entity, Map_Port, Parent));
+         end if;
+      end if;
+   end Sem_Binding_Indication;
+
+   --  Set configuration_specification or component_configuration SPEC to
+   --  component instantiation COMP.
+   procedure Apply_Configuration_Specification
+     (Comp : Iir_Component_Instantiation_Statement;
+      Spec : Iir;
+      Primary_Entity_Aspect : in out Iir)
+   is
+      Prev_Spec : Iir;
+      Prev_Conf : Iir;
+
+      procedure Prev_Spec_Error is
+      begin
+         Error_Msg_Sem
+           (Disp_Node (Comp)
+            & " is alreay bound by a configuration specification", Spec);
+         Error_Msg_Sem
+           ("(previous is " & Disp_Node (Prev_Spec) & ")", Prev_Spec);
+      end Prev_Spec_Error;
+
+      Prev_Binding : Iir_Binding_Indication;
+      Prev_Entity_Aspect : Iir;
+   begin
+      Prev_Spec := Get_Configuration_Specification (Comp);
+      if Prev_Spec /= Null_Iir then
+         case Get_Kind (Spec) is
+            when Iir_Kind_Configuration_Specification =>
+               Prev_Spec_Error;
+               return;
+            when Iir_Kind_Component_Configuration =>
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Prev_Spec_Error;
+                  Error_Msg_Sem
+                    ("(incremental binding is not allowed in vhdl87)", Spec);
+                  return;
+               end if;
+               --  Incremental binding.
+               Prev_Binding := Get_Binding_Indication (Prev_Spec);
+               if Prev_Binding /= Null_Iir then
+                  Prev_Entity_Aspect := Get_Entity_Aspect (Prev_Binding);
+                  if Primary_Entity_Aspect = Null_Iir then
+                     Primary_Entity_Aspect := Prev_Entity_Aspect;
+                  else
+                     --  FIXME: checks to do ?
+                     null;
+                  end if;
+               end if;
+            when others =>
+               Error_Kind ("apply_configuration_specification", Spec);
+         end case;
+      end if;
+      Prev_Conf := Get_Component_Configuration (Comp);
+      if Prev_Conf /= Null_Iir then
+         case Get_Kind (Spec) is
+            when Iir_Kind_Configuration_Specification =>
+               --  How can this happen ?
+               raise Internal_Error;
+            when Iir_Kind_Component_Configuration =>
+               Error_Msg_Sem
+                 (Disp_Node (Comp)
+                  & " is already bound by a component configuration",
+                  Spec);
+               Error_Msg_Sem
+                 ("(previous is " & Disp_Node (Prev_Conf) & ")", Prev_Conf);
+               return;
+            when others =>
+               Error_Kind ("apply_configuration_specification(2)", Spec);
+         end case;
+      end if;
+      if Get_Kind (Spec) = Iir_Kind_Configuration_Specification then
+         Set_Configuration_Specification (Comp, Spec);
+      end if;
+      Set_Component_Configuration (Comp, Spec);
+   end Apply_Configuration_Specification;
+
+   --  Semantize component_configuration or configuration_specification SPEC.
+   --  STMTS is the concurrent statement list related to SPEC.
+   procedure Sem_Component_Specification
+     (Parent_Stmts : Iir; Spec : Iir; Primary_Entity_Aspect : out Iir)
+   is
+      function Apply_Component_Specification
+        (Chain : Iir; Check_Applied : Boolean)
+        return Boolean
+      is
+         Comp : constant Iir := Get_Named_Entity (Get_Component_Name (Spec));
+         El : Iir;
+         Res : Boolean;
+      begin
+         El := Get_Concurrent_Statement_Chain (Chain);
+         Res := False;
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  if Is_Component_Instantiation (El)
+                    and then
+                    Get_Named_Entity (Get_Instantiated_Unit (El)) = Comp
+                    and then
+                    (not Check_Applied
+                     or else Get_Component_Configuration (El) = Null_Iir)
+                  then
+                     Apply_Configuration_Specification
+                       (El, Spec, Primary_Entity_Aspect);
+                     Res := True;
+                  end if;
+               when Iir_Kind_Generate_Statement =>
+                  if False and then Flags.Vhdl_Std = Vhdl_87 then
+                     Res := Res
+                       or Apply_Component_Specification (El, Check_Applied);
+                  end if;
+               when others =>
+                  null;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+         return Res;
+      end Apply_Component_Specification;
+
+      List : Iir_List;
+      El : Iir;
+      Inter : Sem_Scopes.Name_Interpretation_Type;
+      Comp : Iir;
+      Comp_Name : Iir;
+      Inst : Iir;
+      Inst_Unit : Iir;
+   begin
+      Primary_Entity_Aspect := Null_Iir;
+      Comp_Name := Sem_Denoting_Name (Get_Component_Name (Spec));
+      Set_Component_Name (Spec, Comp_Name);
+      Comp := Get_Named_Entity (Comp_Name);
+      if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+         Error_Class_Match (Comp_Name, "component");
+         return;
+      end if;
+
+      List := Get_Instantiation_List (Spec);
+      if List = Iir_List_All then
+         --  LRM93 5.2
+         --  * If the reserved word ALL is supplied, then the configuration
+         --    specification applies to all instances of the specified
+         --    component declaration whose labels are (implicitly) declared
+         --    in the immediately enclosing declarative region part.
+         --    This rule applies only to those component instantiation
+         --    statements whose corresponding instantiated units name
+         --    component.
+         if not Apply_Component_Specification (Parent_Stmts, False)
+           and then Flags.Warn_Specs
+         then
+            Warning_Msg_Sem
+              ("component specification applies to no instance", Spec);
+         end if;
+      elsif List = Iir_List_Others then
+         --  LRM93 5.2
+         --  * If the reserved word OTHERS is supplied, then the
+         --    configuration specification applies to instances of the
+         --    specified component declaration whoce labels are (implicitly)
+         --    declared in the immediatly enclosing declarative part,
+         --    provided that each such component instance is not explicitly
+         --    names in the instantiation list of a previous configuration
+         --    specification.
+         --    This rule applies only to those component instantiation
+         --    statements whose corresponding instantiated units name
+         --    components.
+         if not Apply_Component_Specification (Parent_Stmts, True)
+           and then Flags.Warn_Specs
+         then
+            Warning_Msg_Sem
+              ("component specification applies to no instance", Spec);
+         end if;
+      else
+         --  LRM93 5.2
+         --  * If a list of instantiation labels is supplied, then the
+         --    configuration specification applies to the corresponding
+         --    component instances.
+         --    Such labels must be (implicitly) declared within the
+         --    immediatly enclosing declarative part.
+         --    It is an error if these component instances are not instances
+         --    of the component declaration named in the component
+         --    specification.
+         --    It is also an error if any of the labels denote a component
+         --    instantiation statement whose corresponding instantiated unit
+         --    does not name a component.
+         -- FIXME: error message are *really* cryptic.
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            Inter := Sem_Scopes.Get_Interpretation (Get_Identifier (El));
+            if not Valid_Interpretation (Inter) then
+               Error_Msg_Sem ("no component instantation with label '"
+                              & Image_Identifier (El) & ''', El);
+            elsif not Is_In_Current_Declarative_Region (Inter) then
+               --  FIXME.
+               Error_Msg_Sem ("label not in block declarative part", El);
+            else
+               Inst := Get_Declaration (Inter);
+               if Get_Kind (Inst) /= Iir_Kind_Component_Instantiation_Statement
+               then
+                  Error_Msg_Sem ("label does not denote an instantiation", El);
+               else
+                  Inst_Unit := Get_Instantiated_Unit (Inst);
+                  if Is_Entity_Instantiation (Inst)
+                    or else (Get_Kind (Get_Named_Entity (Inst_Unit))
+                               /= Iir_Kind_Component_Declaration)
+                  then
+                     Error_Msg_Sem
+                       ("specification does not apply to direct instantiation",
+                        El);
+                  elsif Get_Named_Entity (Inst_Unit) /= Comp then
+                     Error_Msg_Sem ("component names mismatch", El);
+                  else
+                     Apply_Configuration_Specification
+                       (Inst, Spec, Primary_Entity_Aspect);
+                     Xref_Ref (El, Inst);
+                     Set_Named_Entity (El, Inst);
+                  end if;
+               end if;
+            end if;
+         end loop;
+      end if;
+   end Sem_Component_Specification;
+
+   procedure Sem_Configuration_Specification
+     (Parent_Stmts : Iir; Conf : Iir_Configuration_Specification)
+   is
+      Primary_Entity_Aspect : Iir;
+      Component : Iir;
+   begin
+      Sem_Component_Specification (Parent_Stmts, Conf, Primary_Entity_Aspect);
+      Component := Get_Named_Entity (Get_Component_Name (Conf));
+
+      --  Return now in case of error.
+      if Get_Kind (Component) /= Iir_Kind_Component_Declaration then
+         return;
+      end if;
+      --  Extend scope of component interface declaration.
+      Sem_Scopes.Open_Scope_Extension;
+      Sem_Scopes.Add_Component_Declarations (Component);
+      Sem_Binding_Indication (Get_Binding_Indication (Conf),
+                              Component, Conf, Primary_Entity_Aspect);
+      --  FIXME: check default port and generic association.
+      Sem_Scopes.Close_Scope_Extension;
+   end Sem_Configuration_Specification;
+
+   function Sem_Create_Default_Binding_Indication
+     (Comp : Iir_Component_Declaration;
+      Entity_Unit : Iir_Design_Unit;
+      Parent : Iir;
+      Force : Boolean)
+     return Iir_Binding_Indication
+   is
+      Entity : Iir_Entity_Declaration;
+      Entity_Name : Iir;
+      Aspect : Iir;
+      Res : Iir;
+      Design_Unit : Iir_Design_Unit;
+   begin
+      --  LRM 5.2.2
+      --  The default binding indication consists of a default entity aspect,
+      --  together with a default generic map aspect and a default port map
+      --  aspect, as appropriate.
+
+      if Entity_Unit = Null_Iir then
+         if not Force then
+            return Null_Iir;
+         end if;
+
+         --  LRM 5.2.2
+         --  If no visible entity declaration has the same simple name as that
+         --  of the instantiated component, then the default entity aspect is
+         --  OPEN.
+         Aspect := Create_Iir (Iir_Kind_Entity_Aspect_Open);
+         Location_Copy (Aspect, Comp);
+         Res := Create_Iir (Iir_Kind_Binding_Indication);
+         Set_Entity_Aspect (Res, Aspect);
+         return Res;
+      else
+         --  LRM 5.2.2
+         --  Otherwise, the default entity aspect is of the form:
+         --    ENTITY entity_name ( architecture_identifier)
+         --  where the entity name is the simple name of the instantiated
+         --  component and the architecture identifier is the same as the
+         --  simple name of the most recently analyzed architecture body
+         --  associated with the entity declaration.
+         --
+         --  If this rule is applied either to a binding indication contained
+         --  within a configuration specification or to a component
+         --  configuration that does not contain an explicit inner block
+         --  configuration, then the architecture identifier is determined
+         --  during elaboration of the design hierarchy containing the binding
+         --  indication.
+         --
+         --  Likewise, if a component instantiation statement contains an
+         --  instantiated unit containing the reserved word ENTITY, but does
+         --  not contain an explicitly specified architecture identifier, this
+         --  rule is applied during the elaboration of the design hierarchy
+         --  containing a component instantiation statement.
+         --
+         --  In all other cases, this rule is applied during analysis of the
+         --  binding indication.
+         --
+         --  It is an error if there is no architecture body associated with
+         --  the entity declaration denoted by an entity name that is the
+         --  simple name of the instantiated component.
+         null;
+      end if;
+
+      Design_Unit := Libraries.Load_Primary_Unit
+        (Get_Library (Get_Design_File (Entity_Unit)),
+         Get_Identifier (Get_Library_Unit (Entity_Unit)),
+         Parent);
+      if Design_Unit = Null_Iir then
+         --  Found an entity which is not in the library.
+         raise Internal_Error;
+      end if;
+
+      Entity := Get_Library_Unit (Design_Unit);
+
+      Res := Create_Iir (Iir_Kind_Binding_Indication);
+      Aspect := Create_Iir (Iir_Kind_Entity_Aspect_Entity);
+      Location_Copy (Aspect, Parent);
+
+      Entity_Name := Create_Iir (Iir_Kind_Simple_Name);
+      Location_Copy (Entity_Name, Parent);
+      Set_Named_Entity (Entity_Name, Entity);
+
+      Set_Entity_Name (Aspect, Entity_Name);
+      Set_Entity_Aspect (Res, Aspect);
+
+      --  LRM 5.2.2
+      --  The default binding indication includes a default generic map aspect
+      --  if the design entity implied by the entity aspect contains formal
+      --  generics.
+      Set_Generic_Map_Aspect_Chain
+        (Res, Create_Default_Map_Aspect (Comp, Entity, Map_Generic, Parent));
+
+      --  LRM 5.2.2
+      --  The default binding indication includes a default port map aspect
+      --  if the design entity implied by the entity aspect contains formal
+      --  ports.
+      Set_Port_Map_Aspect_Chain
+        (Res, Create_Default_Map_Aspect (Comp, Entity, Map_Port, Parent));
+
+      return Res;
+   end Sem_Create_Default_Binding_Indication;
+
+   --  LRM 5.2.2
+   --  The default binding indication includes a default generic map aspect
+   --  if the design entity implied by the entity aspect contains formal
+   --  generics.
+   --
+   --  The default generic map aspect associates each local generic in
+   --  the corresponding component instantiation (if any) with a formal
+   --  of the same simple name.
+   --  It is an error if such a formal does not exist, or if its mode and
+   --  type are not appropriate for such an association.
+   --  Any remaining unassociated formals are associated with the actual
+   --  designator OPEN.
+
+   --  LRM 5.2.2
+   --  The default binding indication includes a default port map aspect
+   --  if the design entity implied by the entity aspect contains formal
+   --  ports.
+   --
+   --  The default port map aspect associates each local port in the
+   --  corresponding component instantiation (if any) with a formal of
+   --  the same simple name.
+   --  It is an error if such a formal does not exist, or if its mode
+   --  and type are not appropriate for such an association.
+   --  Any remaining unassociated formals are associated with the actual
+   --  designator OPEN.
+   function Create_Default_Map_Aspect
+     (Comp : Iir; Entity : Iir; Kind : Map_Kind_Type; Parent : Iir)
+     return Iir
+   is
+      Res, Last : Iir;
+      Comp_El, Ent_El : Iir;
+      Assoc : Iir;
+      Found : Natural;
+      Comp_Chain : Iir;
+      Ent_Chain : Iir;
+      Error : Boolean;
+   begin
+      case Kind is
+         when Map_Generic =>
+            Ent_Chain := Get_Generic_Chain (Entity);
+            Comp_Chain := Get_Generic_Chain (Comp);
+         when Map_Port =>
+            Ent_Chain := Get_Port_Chain (Entity);
+            Comp_Chain := Get_Port_Chain (Comp);
+      end case;
+
+      --  If no formal, then there is no association list.
+      if Ent_Chain = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      --  No error found yet.
+      Error := False;
+
+      Sub_Chain_Init (Res, Last);
+      Found := 0;
+      Ent_El := Ent_Chain;
+      while Ent_El /= Null_Iir loop
+         --  Find the component generic/port with the same name.
+         Comp_El := Find_Name_In_Chain (Comp_Chain, Get_Identifier (Ent_El));
+         if Comp_El = Null_Iir then
+            Assoc := Create_Iir (Iir_Kind_Association_Element_Open);
+            Location_Copy (Assoc, Parent);
+         else
+            if not Are_Nodes_Compatible (Comp_El, Ent_El) then
+               if not Error then
+                  Error_Msg_Sem
+                    ("for default port binding of " & Disp_Node (Parent)
+                       & ":", Parent);
+               end if;
+               Error_Msg_Sem
+                 ("type of " & Disp_Node (Comp_El)
+                    & " declarared at " & Disp_Location (Comp_El), Parent);
+               Error_Msg_Sem
+                 ("not compatible with type of " & Disp_Node (Ent_El)
+                    & " declarared at " & Disp_Location (Ent_El), Parent);
+               Error := True;
+            elsif Kind = Map_Port
+              and then not Check_Port_Association_Restriction
+              (Ent_El, Comp_El, Null_Iir)
+            then
+               if not Error then
+                  Error_Msg_Sem
+                    ("for default port binding of " & Disp_Node (Parent)
+                       & ":", Parent);
+               end if;
+               Error_Msg_Sem
+                 ("cannot associate "
+                    & Get_Mode_Name (Get_Mode (Ent_El))
+                    & " " & Disp_Node (Ent_El)
+                    & " declarared at " & Disp_Location (Ent_El), Parent);
+               Error_Msg_Sem
+                 ("with actual port of mode "
+                    & Get_Mode_Name (Get_Mode (Comp_El))
+                    & " declared at " & Disp_Location (Comp_El), Parent);
+               Error := True;
+            end if;
+            Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression);
+            Location_Copy (Assoc, Parent);
+            Set_Actual (Assoc, Comp_El);
+            Found := Found + 1;
+         end if;
+         Set_Whole_Association_Flag (Assoc, True);
+         Set_Formal (Assoc, Ent_El);
+         if Kind = Map_Port
+           and then not Error
+           and then Comp_El /= Null_Iir
+         then
+            Set_Collapse_Signal_Flag
+              (Assoc, Can_Collapse_Signals (Assoc, Ent_El));
+         end if;
+         Sub_Chain_Append (Res, Last, Assoc);
+         Ent_El := Get_Chain (Ent_El);
+      end loop;
+      if Iir_Chains.Get_Chain_Length (Comp_Chain) /= Found then
+         --  At least one component generic/port cannot be associated with
+         --  the entity one.
+         Error := True;
+         --  Disp unassociated interfaces.
+         Comp_El := Comp_Chain;
+         while Comp_El /= Null_Iir loop
+            Ent_El := Find_Name_In_Chain (Ent_Chain, Get_Identifier (Comp_El));
+            if Ent_El = Null_Iir then
+               Error_Msg_Sem (Disp_Node (Comp_El) & " has no association in "
+                              & Disp_Node (Entity), Parent);
+            end if;
+            Comp_El := Get_Chain (Comp_El);
+         end loop;
+      end if;
+      if Error then
+         return Null_Iir;
+      else
+         return Res;
+      end if;
+   end Create_Default_Map_Aspect;
+
+   --  LRM93 §5.2.2
+   function Get_Visible_Entity_Declaration (Comp: Iir_Component_Declaration)
+     return Iir_Design_Unit
+   is
+      function Is_Entity_Declaration (Decl : Iir) return Boolean is
+      begin
+         return Get_Kind (Decl) = Iir_Kind_Design_Unit and then
+           Get_Kind (Get_Library_Unit (Decl)) = Iir_Kind_Entity_Declaration;
+      end Is_Entity_Declaration;
+
+      Inter : Name_Interpretation_Type;
+      Name : Name_Id;
+      Decl : Iir;
+      Target_Lib : Iir;
+   begin
+      Name := Get_Identifier (Comp);
+      Inter := Get_Interpretation (Name);
+
+      if Valid_Interpretation (Inter) then
+         --  A visible entity declaration is either:
+         --
+         --  a) An entity declaration that has the same simple name as that of
+         --     the instantiated component and that is directly visible
+         --     (see 10.3),
+         Decl := Get_Declaration (Inter);
+         if Is_Entity_Declaration (Decl) then
+            return Decl;
+         end if;
+
+         --  b)  An entity declaration that has the same simple name that of
+         --      the instantiated component and that would be directly
+         --      visible in the absence of a directly visible (see 10.3)
+         --      component declaration with the same simple name as that
+         --      of the entity declaration, or
+         if Get_Kind (Decl) = Iir_Kind_Component_Declaration then
+            Inter := Get_Under_Interpretation (Name);
+            if Valid_Interpretation (Inter) then
+               Decl := Get_Declaration (Inter);
+               if Is_Entity_Declaration (Decl) then
+                  return Decl;
+               end if;
+            end if;
+         end if;
+      end if;
+
+      --  VHDL02:
+      --  c) An entity declaration denoted by "L.C", where L is the target
+      --     library and C is the simple name of the instantiated component.
+      --     The target library is the library logical name of the library
+      --     containing the design unit in which the component C is
+      --     declared.
+      if Flags.Flag_Syn_Binding
+        or Flags.Vhdl_Std >= Vhdl_02
+        or Flags.Vhdl_Std = Vhdl_93c
+      then
+         --  Find target library.
+         Target_Lib := Comp;
+         while Get_Kind (Target_Lib) /= Iir_Kind_Library_Declaration loop
+            Target_Lib := Get_Parent (Target_Lib);
+         end loop;
+
+         Decl := Libraries.Find_Primary_Unit (Target_Lib, Name);
+         if Decl /= Null_Iir and then Is_Entity_Declaration (Decl) then
+            return Decl;
+         end if;
+      end if;
+
+      --  --syn-binding
+      --  Search for any entity.
+      if Flags.Flag_Syn_Binding then
+         Decl := Libraries.Find_Entity_For_Component (Name);
+         if Decl /= Null_Iir then
+            return Decl;
+         end if;
+      end if;
+
+      return Null_Iir;
+   end Get_Visible_Entity_Declaration;
+
+   --  Explain why there is no default binding for COMP.
+   procedure Explain_No_Visible_Entity (Comp: Iir_Component_Declaration)
+   is
+      Inter : Name_Interpretation_Type;
+      Name : Name_Id;
+      Decl : Iir;
+   begin
+      Name := Get_Identifier (Comp);
+      Inter := Get_Interpretation (Name);
+
+      if Valid_Interpretation (Inter) then
+         --  A visible entity declaration is either:
+         --
+         --  a) An entity declaration that has the same simple name as that of
+         --     the instantiated component and that is directly visible
+         --     (see 10.3),
+         Decl := Get_Declaration (Inter);
+         Warning_Msg_Elab ("visible declaration for " & Name_Table.Image (Name)
+                           & " is " & Disp_Node (Decl), Decl);
+
+         --  b)  An entity declaration that has the same simple name that of
+         --      the instantiated component and that would be directly
+         --      visible in the absence of a directly visible (see 10.3)
+         --      component declaration with the same simple name as that
+         --      of the entity declaration, or
+         if Get_Kind (Decl) = Iir_Kind_Component_Declaration then
+            Inter := Get_Under_Interpretation (Name);
+            if Valid_Interpretation (Inter) then
+               Decl := Get_Declaration (Inter);
+               Warning_Msg_Elab ("interpretation behind the component is "
+                                 & Disp_Node (Decl), Comp);
+            end if;
+         end if;
+      end if;
+
+      --  VHDL02:
+      --  c) An entity declaration denoted by "L.C", where L is the target
+      --     library and C is the simple name of the instantiated component.
+      --     The target library is the library logical name of the library
+      --     containing the design unit in which the component C is
+      --     declared.
+      if Flags.Vhdl_Std >= Vhdl_02
+        or else Flags.Vhdl_Std = Vhdl_93c
+      then
+         Decl := Comp;
+         while Get_Kind (Decl) /= Iir_Kind_Library_Declaration loop
+            Decl := Get_Parent (Decl);
+         end loop;
+
+         Warning_Msg_Elab ("no entity """ & Name_Table.Image (Name) & """ in "
+                           & Disp_Node (Decl), Comp);
+      end if;
+   end Explain_No_Visible_Entity;
+
+   procedure Sem_Specification_Chain (Decls_Parent : Iir; Parent_Stmts: Iir)
+   is
+      Decl: Iir;
+   begin
+      Decl := Get_Declaration_Chain (Decls_Parent);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Configuration_Specification =>
+               Sem_Configuration_Specification (Parent_Stmts, Decl);
+            when others =>
+               null;
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Sem_Specification_Chain;
+end Sem_Specs;
diff --git a/src/sem_specs.ads b/src/sem_specs.ads
new file mode 100644
index 000000000..c27207b01
--- /dev/null
+++ b/src/sem_specs.ads
@@ -0,0 +1,88 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+with Tokens;
+
+package Sem_Specs is
+   function Get_Entity_Class_Kind (Decl : Iir) return Tokens.Token_Type;
+
+   procedure Sem_Attribute_Specification
+     (Spec : Iir_Attribute_Specification; Scope : Iir);
+
+   --  Check declarations following an ALL/OTHERS attribute specification.
+   --  ATTR_SPEC_CHAIN is the linked list of all attribute specifications whith
+   --  the entity name list ALL or OTHERS until the current declaration DECL.
+   --  So no specification in the chain must match the declaration.
+   procedure Check_Post_Attribute_Specification
+     (Attr_Spec_Chain : Iir; Decl : Iir);
+
+   procedure Sem_Disconnection_Specification
+     (Dis : Iir_Disconnection_Specification);
+
+   procedure Sem_Configuration_Specification
+     (Parent_Stmts : Iir; Conf : Iir_Configuration_Specification);
+
+   --  Analyze binding indication BIND of configuration specification or
+   --  component configuration PARENT.
+   --  PRIMARY_ENTITY_ASPECT is not Null_Iir for an incremental binding.
+   procedure Sem_Binding_Indication (Bind : Iir_Binding_Indication;
+                                     Comp : Iir_Component_Declaration;
+                                     Parent : Iir;
+                                     Primary_Entity_Aspect : Iir);
+
+   --  Semantize entity aspect ASPECT and return the entity declaration.
+   --  Return NULL_IIR if not found.
+   function Sem_Entity_Aspect (Aspect : Iir) return Iir;
+
+   --  Semantize component_configuration or configuration_specification SPEC.
+   --  STMTS is the concurrent statement list related to SPEC.
+   procedure Sem_Component_Specification
+     (Parent_Stmts : Iir; Spec : Iir; Primary_Entity_Aspect : out Iir);
+
+   --  Create a default binding indication for component COMP which will be
+   --  bound with entity ENTITY_UNIT.
+   --  If ENTITY_UNIT is NULL_IIR, the component is not bound.
+   --  If FORCE is True, a binding indication will be created even if the
+   --   component is not bound (this is an open binding indication).
+   --  PARENT is used to report error.
+   function Sem_Create_Default_Binding_Indication
+     (Comp : Iir_Component_Declaration;
+      Entity_Unit : Iir_Design_Unit;
+      Parent : Iir;
+      Force : Boolean)
+     return Iir_Binding_Indication;
+
+   --  Create a default generic or port map aspect that associates all elements
+   --  of ENTITY (if any) to elements of COMP with the same name or to
+   --  an open association.
+   --  If KIND is GENERIC_MAP, apply this on generics, if KIND is PORT_MAP,
+   --  apply this on ports.
+   --  PARENT is used to report errors.
+   type Map_Kind_Type is (Map_Generic, Map_Port);
+   function Create_Default_Map_Aspect
+     (Comp : Iir; Entity : Iir; Kind : Map_Kind_Type; Parent : Iir)
+     return Iir;
+
+   --  Explain why there is no default binding for COMP.
+   procedure Explain_No_Visible_Entity (Comp: Iir_Component_Declaration);
+
+   function Get_Visible_Entity_Declaration (Comp: Iir_Component_Declaration)
+                                           return Iir_Design_Unit;
+
+   procedure Sem_Specification_Chain (Decls_Parent : Iir; Parent_Stmts: Iir);
+end Sem_Specs;
diff --git a/src/sem_stmts.adb b/src/sem_stmts.adb
new file mode 100644
index 000000000..b5912fbc6
--- /dev/null
+++ b/src/sem_stmts.adb
@@ -0,0 +1,2007 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Errorout; use Errorout;
+with Types; use Types;
+with Flags; use Flags;
+with Sem_Specs; use Sem_Specs;
+with Std_Package; use Std_Package;
+with Sem; use Sem;
+with Sem_Decls; use Sem_Decls;
+with Sem_Expr; use Sem_Expr;
+with Sem_Names; use Sem_Names;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Types;
+with Sem_Psl;
+with Std_Names;
+with Evaluation; use Evaluation;
+with Iirs_Utils; use Iirs_Utils;
+with Xrefs; use Xrefs;
+
+package body Sem_Stmts is
+   -- Process is the scope, this is also the process for which drivers can
+   -- be created.
+   -- Note: FIRST_STMT is the first statement, which can be get by:
+   --  get_sequential_statement_chain (usual)
+   --  get_associated_chain (for case statement).
+   procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir);
+
+   -- Access to the current subprogram or process.
+   Current_Subprogram: Iir := Null_Iir;
+
+   function Get_Current_Subprogram return Iir is
+   begin
+      return Current_Subprogram;
+   end Get_Current_Subprogram;
+
+   -- Access to the current concurrent statement.
+   -- Null_iir if no one.
+   Current_Concurrent_Statement : Iir := Null_Iir;
+
+   function Get_Current_Concurrent_Statement return Iir is
+   begin
+      return Current_Concurrent_Statement;
+   end Get_Current_Concurrent_Statement;
+
+   Current_Declarative_Region_With_Signals :
+     Implicit_Signal_Declaration_Type := (Null_Iir, Null_Iir);
+
+   procedure Push_Signals_Declarative_Part
+     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir) is
+   begin
+      Cell := Current_Declarative_Region_With_Signals;
+      Current_Declarative_Region_With_Signals := (Decls_Parent, Null_Iir);
+   end Push_Signals_Declarative_Part;
+
+   procedure Pop_Signals_Declarative_Part
+     (Cell: in Implicit_Signal_Declaration_Type) is
+   begin
+      Current_Declarative_Region_With_Signals := Cell;
+   end Pop_Signals_Declarative_Part;
+
+   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir)
+   is
+      Last : Iir renames
+        Current_Declarative_Region_With_Signals.Last_Decl;
+   begin
+      if Current_Declarative_Region_With_Signals.Decls_Parent = Null_Iir then
+         raise Internal_Error;
+      end if;
+      if Last = Null_Iir then
+         Last := Get_Declaration_Chain
+           (Current_Declarative_Region_With_Signals.Decls_Parent);
+      end if;
+      if Last = Null_Iir then
+         Set_Declaration_Chain
+           (Current_Declarative_Region_With_Signals.Decls_Parent, Sig);
+      else
+         while Get_Chain (Last) /= Null_Iir loop
+            Last := Get_Chain (Last);
+         end loop;
+         Set_Chain (Last, Sig);
+      end if;
+      Last := Sig;
+   end Add_Declaration_For_Implicit_Signal;
+
+   --  LRM 8 Sequential statements.
+   --  All statements may be labeled.
+   --  Such labels are implicitly declared at the beginning of the declarative
+   --  part of the innermost enclosing process statement of subprogram body.
+   procedure Sem_Sequential_Labels (First_Stmt : Iir)
+   is
+      Stmt: Iir;
+      Label: Name_Id;
+   begin
+      Stmt := First_Stmt;
+      while Stmt /= Null_Iir loop
+         Label := Get_Label (Stmt);
+         if Label /= Null_Identifier then
+            Sem_Scopes.Add_Name (Stmt);
+            Name_Visible (Stmt);
+            Xref_Decl (Stmt);
+         end if;
+
+         --  Some statements have sub-lists of statements.
+         case Get_Kind (Stmt) is
+            when Iir_Kind_For_Loop_Statement
+              | Iir_Kind_While_Loop_Statement =>
+               Sem_Sequential_Labels (Get_Sequential_Statement_Chain (Stmt));
+            when Iir_Kind_If_Statement =>
+               declare
+                  Clause : Iir;
+               begin
+                  Clause := Stmt;
+                  while Clause /= Null_Iir loop
+                     Sem_Sequential_Labels
+                       (Get_Sequential_Statement_Chain (Clause));
+                     Clause := Get_Else_Clause (Clause);
+                  end loop;
+               end;
+            when Iir_Kind_Case_Statement =>
+               declare
+                  El : Iir;
+               begin
+                  El := Get_Case_Statement_Alternative_Chain (Stmt);
+                  while El /= Null_Iir loop
+                     Sem_Sequential_Labels (Get_Associated_Chain (El));
+                     El := Get_Chain (El);
+                  end loop;
+               end;
+            when others =>
+               null;
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Sem_Sequential_Labels;
+
+   procedure Fill_Array_From_Aggregate_Associated
+     (Chain : Iir; Nbr : in out Natural; Arr : Iir_Array_Acc)
+   is
+      El : Iir;
+      Ass : Iir;
+   begin
+      El := Chain;
+      while El /= Null_Iir loop
+         Ass := Get_Associated_Expr (El);
+         if Get_Kind (Ass) = Iir_Kind_Aggregate then
+            Fill_Array_From_Aggregate_Associated
+              (Get_Association_Choices_Chain (Ass), Nbr, Arr);
+         else
+            if Arr /= null then
+               Arr (Nbr) := Ass;
+            end if;
+            Nbr := Nbr + 1;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+   end Fill_Array_From_Aggregate_Associated;
+
+   --  Return TRUE iff there is no common elements designed by N1 and N2.
+   --  N1 and N2 are static names.
+   --  FIXME:  The current implementation is completly wrong; should check from
+   --   prefix to suffix.
+   function Is_Disjoint (N1, N2: Iir) return Boolean
+   is
+      List1, List2 : Iir_List;
+      El1, El2 : Iir;
+   begin
+      if N1 = N2 then
+         return False;
+      end if;
+      if Get_Kind (N1) = Iir_Kind_Indexed_Name
+        and then Get_Kind (N2) = Iir_Kind_Indexed_Name
+      then
+         if Is_Disjoint (Get_Prefix (N1), Get_Prefix (N2)) then
+            return True;
+         end if;
+         --  Check indexes.
+         List1 := Get_Index_List (N1);
+         List2 := Get_Index_List (N2);
+         for I in Natural loop
+            El1 := Get_Nth_Element (List1, I);
+            El2 := Get_Nth_Element (List2, I);
+            exit when El1 = Null_Iir;
+            El1 := Eval_Expr (El1);
+            Replace_Nth_Element (List1, I, El1);
+            El2 := Eval_Expr (El2);
+            Replace_Nth_Element (List2, I, El2);
+            --  EL are of discrete type.
+            if Get_Value (El1) /= Get_Value (El2) then
+               return True;
+            end if;
+         end loop;
+         return False;
+      elsif Get_Kind (N1) in Iir_Kinds_Denoting_Name
+        and then Get_Kind (N2) in Iir_Kinds_Denoting_Name
+      then
+         return Get_Named_Entity (N1) /= Get_Named_Entity (N2);
+      else
+         return True;
+      end if;
+   end Is_Disjoint;
+
+   procedure Check_Uniq_Aggregate_Associated
+     (Aggr : Iir_Aggregate; Nbr : Natural)
+   is
+      Index : Natural;
+      Arr : Iir_Array_Acc;
+      Chain : Iir;
+      V_I, V_J : Iir;
+   begin
+      Chain := Get_Association_Choices_Chain (Aggr);
+      --  Count number of associated values, and create the array.
+      --  Already done: use nbr.
+      -- Fill_Array_From_Aggregate_Associated (List, Nbr, null);
+      Arr := new Iir_Array (0 .. Nbr - 1);
+      --  Fill the array.
+      Index := 0;
+      Fill_Array_From_Aggregate_Associated (Chain, Index, Arr);
+      if Index /= Nbr then
+         --  Should be the same.
+         raise Internal_Error;
+      end if;
+      --  Check each element is uniq.
+      for I in Arr.all'Range loop
+         V_I := Name_To_Object (Arr (I));
+         if Get_Name_Staticness (V_I) = Locally then
+            for J in 0 .. I - 1 loop
+               V_J := Name_To_Object (Arr (J));
+               if Get_Name_Staticness (V_J) = Locally
+                 and then not Is_Disjoint (V_I, V_J)
+               then
+                  Error_Msg_Sem ("target is assigned more than once", Arr (I));
+                  Error_Msg_Sem (" (previous assignment is here)", Arr (J));
+                  Free (Arr);
+                  return;
+               end if;
+            end loop;
+         end if;
+      end loop;
+      Free (Arr);
+      return;
+   end Check_Uniq_Aggregate_Associated;
+
+   --  Do checks for the target of an assignment.
+   procedure Check_Simple_Signal_Target
+     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness);
+   --  STMT is used to localize the error (if any).
+   procedure Check_Simple_Variable_Target
+     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness);
+
+   -- Semantic associed with signal mode.
+   -- See §4.3.3
+   type Boolean_Array_Of_Iir_Mode is array (Iir_Mode) of Boolean;
+   Iir_Mode_Readable : constant Boolean_Array_Of_Iir_Mode :=
+     (Iir_Unknown_Mode => False,
+      Iir_In_Mode => True,
+      Iir_Out_Mode => False,
+      Iir_Inout_Mode => True,
+      Iir_Buffer_Mode => True,
+      Iir_Linkage_Mode => False);
+   Iir_Mode_Writable : constant Boolean_Array_Of_Iir_Mode :=
+     (Iir_Unknown_Mode => False,
+      Iir_In_Mode => False,
+      Iir_Out_Mode => True,
+      Iir_Inout_Mode => True,
+      Iir_Buffer_Mode => True,
+      Iir_Linkage_Mode => False);
+
+   procedure Check_Aggregate_Target
+     (Stmt : Iir; Target : Iir; Nbr : in out Natural)
+   is
+      Choice : Iir;
+      Ass : Iir;
+   begin
+      Choice := Get_Association_Choices_Chain (Target);
+      while Choice /= Null_Iir loop
+         case Get_Kind (Choice) is
+            when Iir_Kind_Choice_By_Range =>
+               --  LRM93 8.4
+               --  It is an error if an element association in such an
+               --  aggregate contains an OTHERS choice or a choice that is
+               --  a discrete range.
+               Error_Msg_Sem ("discrete range choice not allowed for target",
+                              Choice);
+            when Iir_Kind_Choice_By_Others =>
+               --  LRM93 8.4
+               --  It is an error if an element association in such an
+               --  aggregate contains an OTHERS choice or a choice that is
+               --  a discrete range.
+               Error_Msg_Sem ("others choice not allowed for target", Choice);
+            when Iir_Kind_Choice_By_Expression
+              | Iir_Kind_Choice_By_Name
+              | Iir_Kind_Choice_By_None =>
+               --  LRM93 9.4
+               --  Such a target may not only contain locally static signal
+               --  names [...]
+               Ass := Get_Associated_Expr (Choice);
+               if Get_Kind (Ass) = Iir_Kind_Aggregate then
+                  Check_Aggregate_Target (Stmt, Ass, Nbr);
+               else
+                  if Get_Kind (Stmt) = Iir_Kind_Variable_Assignment_Statement
+                  then
+                     Check_Simple_Variable_Target (Stmt, Ass, Locally);
+                  else
+                     Check_Simple_Signal_Target (Stmt, Ass, Locally);
+                  end if;
+                  Nbr := Nbr + 1;
+               end if;
+            when others =>
+               Error_Kind ("check_aggregate_target", Choice);
+         end case;
+         Choice := Get_Chain (Choice);
+      end loop;
+   end Check_Aggregate_Target;
+
+   procedure Check_Simple_Signal_Target
+     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness)
+   is
+      Target_Object : Iir;
+      Target_Prefix : Iir;
+      Guarded_Target : Tri_State_Type;
+      Targ_Obj_Kind : Iir_Kind;
+   begin
+      Target_Object := Name_To_Object (Target);
+      if Target_Object = Null_Iir then
+         Error_Msg_Sem ("target is not a signal name", Target);
+         return;
+      end if;
+
+      Target_Prefix := Get_Object_Prefix (Target_Object);
+      Targ_Obj_Kind := Get_Kind (Target_Prefix);
+      case Targ_Obj_Kind is
+         when Iir_Kind_Interface_Signal_Declaration =>
+            if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
+               Error_Msg_Sem
+                 (Disp_Node (Target_Prefix) & " can't be assigned", Target);
+            else
+               Sem_Add_Driver (Target_Object, Stmt);
+            end if;
+         when Iir_Kind_Signal_Declaration =>
+            Sem_Add_Driver (Target_Object, Stmt);
+         when Iir_Kind_Guard_Signal_Declaration =>
+            Error_Msg_Sem ("implicit GUARD signal cannot be assigned", Stmt);
+            return;
+         when others =>
+            Error_Msg_Sem ("target (" & Disp_Node (Get_Base_Name (Target))
+                           & ") is not a signal", Stmt);
+            return;
+      end case;
+      if Get_Name_Staticness (Target_Object) < Staticness then
+         Error_Msg_Sem ("signal name must be static", Stmt);
+      end if;
+
+      --  LRM93 2.1.1.2
+      --  A formal signal parameter is a guarded signal if and only if
+      --  it is associated with an actual signal that is a guarded
+      --  signal.
+      --  GHDL: a formal signal interface of a subprogram has no static
+      --   kind.  This is determined at run-time, according to the actual
+      --   associated with the formal.
+      --  GHDL: parent of target cannot be a function.
+      if Targ_Obj_Kind = Iir_Kind_Interface_Signal_Declaration
+        and then
+        Get_Kind (Get_Parent (Target_Prefix)) = Iir_Kind_Procedure_Declaration
+      then
+         Guarded_Target := Unknown;
+      else
+         if Get_Signal_Kind (Target_Prefix) /= Iir_No_Signal_Kind then
+            Guarded_Target := True;
+         else
+            Guarded_Target := False;
+         end if;
+      end if;
+
+      case Get_Guarded_Target_State (Stmt) is
+         when Unknown =>
+            Set_Guarded_Target_State (Stmt, Guarded_Target);
+         when True
+           | False =>
+            if Get_Guarded_Target_State (Stmt) /= Guarded_Target then
+               --  LRM93 9.5
+               --  It is an error if the target of a concurrent signal
+               --  assignment is neither a guarded target nor an
+               --  unguarded target.
+               Error_Msg_Sem ("guarded and unguarded target", Target);
+            end if;
+      end case;
+   end Check_Simple_Signal_Target;
+
+   procedure Check_Simple_Variable_Target
+     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness)
+   is
+      Target_Object : Iir;
+      Target_Prefix : Iir;
+   begin
+      Target_Object := Name_To_Object (Target);
+      if Target_Object = Null_Iir then
+         Error_Msg_Sem ("target is not a variable name", Stmt);
+         return;
+      end if;
+      Target_Prefix := Get_Object_Prefix (Target_Object);
+      case Get_Kind (Target_Prefix) is
+         when Iir_Kind_Interface_Variable_Declaration =>
+            if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
+               Error_Msg_Sem (Disp_Node (Target_Prefix)
+                              & " cannot be written (bad mode)", Target);
+               return;
+            end if;
+         when Iir_Kind_Variable_Declaration =>
+            null;
+         when Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference  =>
+            --  LRM 3.3
+            --  An object designated by an access type is always an object of
+            --  class variable.
+            null;
+         when others =>
+            Error_Msg_Sem (Disp_Node (Target_Prefix)
+                           & " is not a variable to be assigned", Stmt);
+            return;
+      end case;
+      if Get_Name_Staticness (Target_Object) < Staticness then
+         Error_Msg_Sem
+           ("element of aggregate of variables must be a static name", Target);
+      end if;
+   end Check_Simple_Variable_Target;
+
+   procedure Check_Target (Stmt : Iir; Target : Iir)
+   is
+      Nbr : Natural;
+   begin
+      if Get_Kind (Target) = Iir_Kind_Aggregate then
+         Nbr := 0;
+         Check_Aggregate_Target (Stmt, Target, Nbr);
+         Check_Uniq_Aggregate_Associated (Target, Nbr);
+      else
+         if Get_Kind (Stmt) = Iir_Kind_Variable_Assignment_Statement then
+            Check_Simple_Variable_Target (Stmt, Target, None);
+         else
+            Check_Simple_Signal_Target (Stmt, Target, None);
+         end if;
+      end if;
+   end Check_Target;
+
+   --  Return FALSE in case of error.
+   function Sem_Signal_Assignment_Target_And_Option (Stmt: Iir; Sig_Type : Iir)
+     return Boolean
+   is
+      --  The target of the assignment.
+      Target: Iir;
+      --  The value that will be assigned.
+      Expr: Iir;
+      Ok : Boolean;
+   begin
+      Ok := True;
+      -- Find the signal.
+      Target := Get_Target (Stmt);
+
+      if Sig_Type = Null_Iir
+        and then Get_Kind (Target) = Iir_Kind_Aggregate
+      then
+         --  Do not try to analyze an aggregate if its type is unknown.
+         --  A target cannot be a qualified type and its type should be
+         --  determine by the context (LRM93 7.3.2 Aggregates).
+         Ok := False;
+      else
+         --  Analyze the target
+         Target := Sem_Expression (Target, Sig_Type);
+         if Target /= Null_Iir then
+            Set_Target (Stmt, Target);
+            Check_Target (Stmt, Target);
+            Sem_Types.Set_Type_Has_Signal (Get_Type (Target));
+         else
+            Ok := False;
+         end if;
+      end if;
+
+      Expr := Get_Reject_Time_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Expr := Sem_Expression (Expr, Time_Type_Definition);
+         if Expr /= Null_Iir then
+            Check_Read (Expr);
+            Set_Reject_Time_Expression (Stmt, Expr);
+         else
+            Ok := False;
+         end if;
+      end if;
+      return Ok;
+   end Sem_Signal_Assignment_Target_And_Option;
+
+   -- Semantize a waveform_list WAVEFORM_LIST that is assigned via statement
+   -- ASSIGN_STMT to a subelement or a slice of a signal SIGNAL_DECL.
+   procedure Sem_Waveform_Chain
+     (Assign_Stmt: Iir;
+      Waveform_Chain : Iir_Waveform_Element;
+      Waveform_Type : in out Iir)
+   is
+      pragma Unreferenced (Assign_Stmt);
+      Expr: Iir;
+      We: Iir_Waveform_Element;
+      Time, Last_Time : Iir_Int64;
+   begin
+      if Waveform_Chain = Null_Iir then
+         --  Unaffected.
+         return;
+      end if;
+
+      --  Start with -1 to allow after 0 ns.
+      Last_Time := -1;
+      We := Waveform_Chain;
+      while We /= Null_Iir loop
+         Expr := Get_We_Value (We);
+         if Get_Kind (Expr) = Iir_Kind_Null_Literal then
+            --  GHDL: allowed only if target is guarded; this is checked by
+            --  sem_check_waveform_list.
+            null;
+         else
+            if Get_Kind (Expr) = Iir_Kind_Aggregate
+              and then Waveform_Type = Null_Iir
+            then
+               Error_Msg_Sem
+                 ("type of waveform is unknown, use qualified type", Expr);
+            else
+               Expr := Sem_Expression (Expr, Waveform_Type);
+               if Expr /= Null_Iir then
+                  Check_Read (Expr);
+                  Set_We_Value (We, Eval_Expr_If_Static (Expr));
+                  if Waveform_Type = Null_Iir then
+                     Waveform_Type := Get_Type (Expr);
+                  end if;
+               end if;
+            end if;
+         end if;
+
+         if Get_Time (We) /= Null_Iir then
+            Expr := Sem_Expression (Get_Time (We), Time_Type_Definition);
+            if Expr /= Null_Iir then
+               Set_Time (We, Expr);
+               Check_Read (Expr);
+
+               if Get_Expr_Staticness (Expr) = Locally
+                 or else (Get_Kind (Expr) = Iir_Kind_Physical_Int_Literal
+                          and then Flags.Flag_Time_64)
+               then
+                  --  LRM 8.4
+                  --  It is an error if the time expression in a waveform
+                  --  element evaluates to a negative value.
+                  --
+                  --  LRM 8.4.1
+                  --  It is an error if the sequence of new transactions is not
+                  --  in ascending order with repect to time.
+                  -- GHDL: this must be checked at run-time, but this is also
+                  --  checked now for static expressions.
+                  if Get_Expr_Staticness (Expr) = Locally then
+                     --  The expression is static, and therefore may be
+                     --  evaluated.
+                     Expr := Eval_Expr (Expr);
+                     Set_Time (We, Expr);
+                     Time := Get_Value (Expr);
+                  else
+                     --  The expression is a physical literal (common case).
+                     --  Extract its value.
+                     Time := Get_Physical_Value (Expr);
+                  end if;
+                  if Time < 0 then
+                     Error_Msg_Sem
+                       ("waveform time expression must be >= 0", Expr);
+                  elsif Time <= Last_Time then
+                     Error_Msg_Sem
+                       ("time must be greather than previous transaction",
+                        Expr);
+                  else
+                     Last_Time := Time;
+                  end if;
+               end if;
+            end if;
+         else
+            if We /= Waveform_Chain then
+               --  Time expression must be in ascending order.
+               Error_Msg_Sem ("time expression required here", We);
+            end if;
+
+            --  LRM93 12.6.4
+            --  It is an error if the execution of any postponed process causes
+            --  a delta cycle to occur immediatly after the current simulation
+            --  cycle.
+            --  GHDL: try to warn for such an error; note the context may be
+            --   a procedure body.
+            if Current_Concurrent_Statement /= Null_Iir then
+               case Get_Kind (Current_Concurrent_Statement) is
+                  when Iir_Kind_Sensitized_Process_Statement
+                    | Iir_Kind_Process_Statement
+                    | Iir_Kind_Concurrent_Conditional_Signal_Assignment
+                    | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+                     if Get_Postponed_Flag (Current_Concurrent_Statement) then
+                        Warning_Msg_Sem
+                          ("waveform may cause a delta cycle in a " &
+                           "postponed process", We);
+                     end if;
+                  when others =>
+                     --  Context is a subprogram.
+                     null;
+               end case;
+            end if;
+
+            Last_Time := 0;
+         end if;
+         We := Get_Chain (We);
+      end loop;
+      return;
+   end Sem_Waveform_Chain;
+
+   -- Semantize a waveform chain WAVEFORM_CHAIN that is assigned via statement
+   -- ASSIGN_STMT to a subelement or a slice of a signal SIGNAL_DECL.
+   procedure Sem_Check_Waveform_Chain
+     (Assign_Stmt: Iir; Waveform_Chain: Iir_Waveform_Element)
+   is
+      We: Iir_Waveform_Element;
+      Expr : Iir;
+      Targ_Type : Iir;
+   begin
+      if Waveform_Chain = Null_Iir then
+         return;
+      end if;
+
+      Targ_Type := Get_Type (Get_Target (Assign_Stmt));
+
+      We := Waveform_Chain;
+      while We /= Null_Iir loop
+         Expr := Get_We_Value (We);
+         if Get_Kind (Expr) = Iir_Kind_Null_Literal then
+            --  This is a null waveform element.
+            --  LRM93 8.4.1
+            --  It is an error if the target of a signal assignment statement
+            --  containing a null waveform is not a guarded signal or an
+            --  aggregate of guarded signals.
+            if Get_Guarded_Target_State (Assign_Stmt) = False then
+               Error_Msg_Sem
+                 ("null transactions can be assigned only to guarded signals",
+                  Assign_Stmt);
+            end if;
+         else
+            if not Check_Implicit_Conversion (Targ_Type, Expr) then
+               Error_Msg_Sem
+                 ("length of value does not match length of target", We);
+            end if;
+         end if;
+         We := Get_Chain (We);
+      end loop;
+   end Sem_Check_Waveform_Chain;
+
+   procedure Sem_Signal_Assignment (Stmt: Iir)
+   is
+      Target : Iir;
+      Waveform_Type : Iir;
+   begin
+      Target := Get_Target (Stmt);
+      if Get_Kind (Target) /= Iir_Kind_Aggregate then
+         if not Sem_Signal_Assignment_Target_And_Option (Stmt, Null_Iir) then
+            return;
+         end if;
+
+         -- check the expression.
+         Waveform_Type := Get_Type (Get_Target (Stmt));
+         if Waveform_Type /= Null_Iir then
+            Sem_Waveform_Chain
+              (Stmt, Get_Waveform_Chain (Stmt), Waveform_Type);
+            Sem_Check_Waveform_Chain (Stmt, Get_Waveform_Chain (Stmt));
+         end if;
+      else
+         Waveform_Type := Null_Iir;
+         Sem_Waveform_Chain (Stmt, Get_Waveform_Chain (Stmt), Waveform_Type);
+         if Waveform_Type = Null_Iir
+           or else
+           not Sem_Signal_Assignment_Target_And_Option (Stmt, Waveform_Type)
+         then
+            return;
+         end if;
+         Sem_Check_Waveform_Chain (Stmt, Get_Waveform_Chain (Stmt));
+      end if;
+   end Sem_Signal_Assignment;
+
+   procedure Sem_Variable_Assignment (Stmt: Iir) is
+      Target: Iir;
+      Expr: Iir;
+      Target_Type : Iir;
+   begin
+      -- Find the variable.
+      Target := Get_Target (Stmt);
+      Expr := Get_Expression (Stmt);
+
+      --  LRM93 8.5 Variable assignment statement
+      --  If the target of the variable assignment statement is in the form of
+      --  an aggregate, then the type of the aggregate must be determinable
+      --  from the context, excluding the aggregate itself but including the
+      --  fact that the type of the aggregate must be a composite type.  The
+      --  base type of the expression on the right-hand side must be the
+      --  same as the base type of the aggregate.
+      --
+      --  GHDL: this means that the type can only be deduced from the
+      --  expression (and not from the target).
+      if Get_Kind (Target) = Iir_Kind_Aggregate then
+         if Get_Kind (Expr) = Iir_Kind_Aggregate then
+            Error_Msg_Sem ("can't determine type, use type qualifier", Expr);
+            return;
+         end if;
+         Expr := Sem_Composite_Expression (Get_Expression (Stmt));
+         if Expr = Null_Iir then
+            return;
+         end if;
+         Check_Read (Expr);
+         Set_Expression (Stmt, Expr);
+         Target_Type := Get_Type (Expr);
+
+         --  An aggregate cannot be analyzed without a type.
+         --  FIXME: partially analyze the aggregate ?
+         if Target_Type = Null_Iir then
+            return;
+         end if;
+
+         --  FIXME: check elements are identified at most once.
+      else
+         Target_Type := Null_Iir;
+      end if;
+
+      Target := Sem_Expression (Target, Target_Type);
+      if Target = Null_Iir then
+         return;
+      end if;
+      Set_Target (Stmt, Target);
+
+      Check_Target (Stmt, Target);
+
+      if Get_Kind (Target) /= Iir_Kind_Aggregate then
+         Expr := Sem_Expression (Expr, Get_Type (Target));
+         if Expr /= Null_Iir then
+            Check_Read (Expr);
+            Expr := Eval_Expr_If_Static (Expr);
+            Set_Expression (Stmt, Expr);
+         end if;
+      end if;
+      if not Check_Implicit_Conversion (Get_Type (Target), Expr) then
+         Warning_Msg_Sem
+           ("expression length does not match target length", Stmt);
+      end if;
+   end Sem_Variable_Assignment;
+
+   procedure Sem_Return_Statement (Stmt: Iir_Return_Statement) is
+      Expr: Iir;
+   begin
+      if Current_Subprogram = Null_Iir then
+         Error_Msg_Sem ("return statement not in a subprogram body", Stmt);
+         return;
+      end if;
+      Expr := Get_Expression (Stmt);
+      case Get_Kind (Current_Subprogram) is
+         when Iir_Kind_Procedure_Declaration =>
+            if Expr /= Null_Iir then
+               Error_Msg_Sem
+                 ("return in a procedure can't have an expression", Stmt);
+            end if;
+            return;
+         when Iir_Kind_Function_Declaration =>
+            if Expr = Null_Iir then
+               Error_Msg_Sem
+                 ("return in a function must have an expression", Stmt);
+               return;
+            end if;
+         when Iir_Kinds_Process_Statement =>
+            Error_Msg_Sem ("return statement not allowed in a process", Stmt);
+            return;
+         when others =>
+            Error_Kind ("sem_return_statement", Stmt);
+      end case;
+      Set_Type (Stmt, Get_Return_Type (Current_Subprogram));
+      Expr := Sem_Expression (Expr, Get_Return_Type (Current_Subprogram));
+      if Expr /= Null_Iir then
+         Check_Read (Expr);
+         Set_Expression (Stmt, Eval_Expr_If_Static (Expr));
+      end if;
+   end Sem_Return_Statement;
+
+   -- Sem for concurrent and sequential assertion statements.
+   procedure Sem_Report_Statement (Stmt : Iir)
+   is
+      Expr : Iir;
+   begin
+      Expr := Get_Report_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Expr := Sem_Expression (Expr, String_Type_Definition);
+         Check_Read (Expr);
+         Expr := Eval_Expr_If_Static (Expr);
+         Set_Report_Expression (Stmt, Expr);
+      end if;
+
+      Expr := Get_Severity_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Expr := Sem_Expression (Expr, Severity_Level_Type_Definition);
+         Check_Read (Expr);
+         Set_Severity_Expression (Stmt, Expr);
+      end if;
+   end Sem_Report_Statement;
+
+   procedure Sem_Assertion_Statement (Stmt: Iir)
+   is
+      Expr : Iir;
+   begin
+      Expr := Get_Assertion_Condition (Stmt);
+      Expr := Sem_Condition (Expr);
+      Expr := Eval_Expr_If_Static (Expr);
+      Set_Assertion_Condition (Stmt, Expr);
+
+      Sem_Report_Statement (Stmt);
+   end Sem_Assertion_Statement;
+
+   --  Semantize a list of case choice LIST, and check for correct CHOICE type.
+   procedure Sem_Case_Choices
+     (Choice : Iir; Chain : in out Iir; Loc : Location_Type)
+   is
+      --  Check restrictions on the expression of a One-Dimensional Character
+      --  Array Type (ODCAT) given by LRM 8.8
+      --  Return FALSE in case of violation.
+      function Check_Odcat_Expression (Expr : Iir) return Boolean
+      is
+         Expr_Type : constant Iir := Get_Type (Expr);
+      begin
+         --  LRM 8.8 Case Statement
+         --  If the expression is of a one-dimensional character array type,
+         --  then the expression must be one of the following:
+         case Get_Kind (Expr) is
+            when Iir_Kinds_Object_Declaration
+              | Iir_Kind_Selected_Element =>
+               --  FIXME: complete the list.
+               --  * the name of an object whose subtype is locally static.
+               if Get_Type_Staticness (Expr_Type) /= Locally then
+                  Error_Msg_Sem ("object subtype is not locally static",
+                                 Choice);
+                  return False;
+               end if;
+            when Iir_Kind_Indexed_Name =>
+               --  LRM93
+               --  * an indexed name whose prefix is one of the members of
+               --    this list and whose indexing expressions are locally
+               --    static expression.
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Sem ("indexed name not allowed here in vhdl87",
+                                 Expr);
+                  return False;
+               end if;
+               if not Check_Odcat_Expression (Get_Prefix (Expr)) then
+                  return False;
+               end if;
+               --  GHDL: I don't understand why the indexing expressions
+               --  must be locally static.  So I don't check this in 93c.
+               if Flags.Vhdl_Std /= Vhdl_93c
+                 and then
+                 Get_Expr_Staticness (Get_First_Element
+                                      (Get_Index_List (Expr))) /= Locally
+               then
+                  Error_Msg_Sem ("indexing expression must be locally static",
+                                 Expr);
+                  return False;
+               end if;
+            when Iir_Kind_Slice_Name =>
+               --  LRM93
+               --  * a slice name whose prefix is one of the members of this
+               --    list and whose discrete range is a locally static
+               --    discrete range.
+
+               --  LRM87/INT1991 IR96
+               --  then the expression must be either a slice name whose
+               --  discrete range is locally static, or ..
+               if False and Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Sem
+                    ("slice not allowed as case expression in vhdl87", Expr);
+                  return False;
+               end if;
+               if not Check_Odcat_Expression (Get_Prefix (Expr)) then
+                  return False;
+               end if;
+               if Get_Type_Staticness (Expr_Type) /= Locally then
+                  Error_Msg_Sem ("slice discrete range must be locally static",
+                                 Expr);
+                  return False;
+               end if;
+            when Iir_Kind_Function_Call =>
+               --  LRM93
+               --  * a function call whose return type mark denotes a
+               --    locally static subtype.
+               if Flags.Vhdl_Std = Vhdl_87 then
+                  Error_Msg_Sem ("function call not allowed here in vhdl87",
+                                 Expr);
+                  return False;
+               end if;
+               if Get_Type_Staticness (Expr_Type) /= Locally then
+                  Error_Msg_Sem ("function call type is not locally static",
+                                 Expr);
+               end if;
+            when Iir_Kind_Qualified_Expression
+              | Iir_Kind_Type_Conversion =>
+               --  * a qualified expression or type conversion whose type mark
+               --    denotes a locally static subtype.
+               if Get_Type_Staticness (Expr_Type) /= Locally then
+                  Error_Msg_Sem ("type mark is not a locally static subtype",
+                                 Expr);
+                  return False;
+               end if;
+            when Iir_Kind_Simple_Name
+              | Iir_Kind_Selected_Name =>
+               return Check_Odcat_Expression (Get_Named_Entity (Expr));
+            when others =>
+               Error_Msg_Sem ("bad form of case expression (refer to LRM 8.8)",
+                              Choice);
+               return False;
+         end case;
+         return True;
+      end Check_Odcat_Expression;
+
+      Choice_Type : Iir;
+      Low, High : Iir;
+      El_Type : Iir;
+   begin
+      --  LRM 8.8  Case Statement
+      --  The expression must be of a discrete type, or of a one-dimensional
+      --  array type whose element base type is a character type.
+      Choice_Type := Get_Type (Choice);
+      case Get_Kind (Choice_Type) is
+         when Iir_Kinds_Discrete_Type_Definition =>
+            Sem_Choices_Range
+              (Chain, Choice_Type, False, True, Loc, Low, High);
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            if not Is_One_Dimensional_Array_Type (Choice_Type) then
+               Error_Msg_Sem
+                 ("expression must be of a one-dimensional array type",
+                  Choice);
+               return;
+            end if;
+            El_Type := Get_Base_Type (Get_Element_Subtype (Choice_Type));
+            if Get_Kind (El_Type) /= Iir_Kind_Enumeration_Type_Definition then
+               --  FIXME: check character.
+               Error_Msg_Sem
+                 ("element type of the expression must be a character type",
+                  Choice);
+               return;
+            end if;
+            if not Check_Odcat_Expression (Choice) then
+               return;
+            end if;
+            Sem_String_Choices_Range (Chain, Choice);
+         when others =>
+            Error_Msg_Sem ("type of expression must be discrete", Choice);
+      end case;
+   end Sem_Case_Choices;
+
+   procedure Sem_Case_Statement (Stmt: Iir_Case_Statement)
+   is
+      Expr: Iir;
+      Chain : Iir;
+      El: Iir;
+   begin
+      Expr := Get_Expression (Stmt);
+      -- FIXME: overload.
+      Expr := Sem_Case_Expression (Expr);
+      if Expr = Null_Iir then
+         return;
+      end if;
+      Check_Read (Expr);
+      Set_Expression (Stmt, Expr);
+      Chain := Get_Case_Statement_Alternative_Chain (Stmt);
+      Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
+      Set_Case_Statement_Alternative_Chain (Stmt, Chain);
+      -- Sem on associated.
+      El := Chain;
+      while El /= Null_Iir loop
+         Sem_Sequential_Statements_Internal (Get_Associated_Chain (El));
+         El := Get_Chain (El);
+      end loop;
+   end Sem_Case_Statement;
+
+   --  Sem the sensitivity list LIST.
+   procedure Sem_Sensitivity_List (List: Iir_Designator_List)
+   is
+      El: Iir;
+      Res: Iir;
+      Prefix : Iir;
+   begin
+      if List = Iir_List_All then
+         return;
+      end if;
+
+      for I in Natural loop
+         -- El is an iir_identifier.
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+
+         Sem_Name (El);
+
+         Res := Get_Named_Entity (El);
+         if Res = Error_Mark then
+            null;
+         elsif Is_Overload_List (Res) or else not Is_Object_Name (Res) then
+            Error_Msg_Sem ("a sensitivity element must be a signal name", El);
+         else
+            Res := Finish_Sem_Name (El);
+            Prefix := Get_Object_Prefix (Res);
+            case Get_Kind (Prefix) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration
+                 | Iir_Kinds_Signal_Attribute =>
+                  null;
+               when Iir_Kind_Interface_Signal_Declaration =>
+                  if not Iir_Mode_Readable (Get_Mode (Prefix)) then
+                     Error_Msg_Sem
+                       (Disp_Node (Res) & " of mode out"
+                        & " can't be in a sensivity list", El);
+                  end if;
+               when others =>
+                  Error_Msg_Sem (Disp_Node (Res)
+                                 & " is neither a signal nor a port", El);
+            end case;
+            --  LRM 9.2
+            --  Only static signal names (see section 6.1) for which reading
+            --  is permitted may appear in the sensitivity list of a process
+            --  statement.
+
+            --  LRM 8.1  Wait statement
+            --  Each signal name in the sensitivity list must be a static
+            --  signal name, and each name must denote a signal for which
+            --  reading is permitted.
+            if Get_Name_Staticness (Res) < Globally then
+               Error_Msg_Sem ("sensitivity element " & Disp_Node (Res)
+                              & " must be a static name", El);
+            end if;
+
+            Replace_Nth_Element (List, I, Res);
+         end if;
+      end loop;
+   end Sem_Sensitivity_List;
+
+   procedure Sem_Wait_Statement (Stmt: Iir_Wait_Statement)
+   is
+      Expr: Iir;
+      Sensitivity_List : Iir_List;
+   begin
+      --  Check validity.
+      case Get_Kind (Current_Subprogram) is
+         when Iir_Kind_Process_Statement =>
+            null;
+         when Iir_Kinds_Function_Declaration =>
+            --  LRM93 §8.2
+            --  It is an error if a wait statement appears in a function
+            --  subprogram [...]
+            Error_Msg_Sem
+              ("wait statement not allowed in a function subprogram", Stmt);
+            return;
+         when Iir_Kinds_Procedure_Declaration =>
+            --  LRM93 §8.2
+            --  [It is an error ...] or in a procedure that has a parent that
+            --  is a function subprogram.
+            --  LRM93 §8.2
+            --  [...] or in a procedure that has a parent that is such a
+            --  process statement.
+            -- GHDL: this is checked at the end of analysis or during
+            --  elaboration.
+            Set_Wait_State (Current_Subprogram, True);
+         when Iir_Kind_Sensitized_Process_Statement =>
+            --  LRM93 §8.2
+            --  Furthermore, it is an error if a wait statement appears in an
+            --  explicit process statement that includes a sensitivity list,
+            --  [...]
+            Error_Msg_Sem
+              ("wait statement not allowed in a sensitized process", Stmt);
+            return;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Sensitivity_List := Get_Sensitivity_List (Stmt);
+      if Sensitivity_List /= Null_Iir_List then
+         Sem_Sensitivity_List (Sensitivity_List);
+      end if;
+      Expr := Get_Condition_Clause (Stmt);
+      if Expr /= Null_Iir then
+         Expr := Sem_Condition (Expr);
+         Set_Condition_Clause (Stmt, Expr);
+      end if;
+      Expr := Get_Timeout_Clause (Stmt);
+      if Expr /= Null_Iir then
+         Expr := Sem_Expression (Expr, Time_Type_Definition);
+         if Expr /= Null_Iir then
+            Check_Read (Expr);
+            Expr := Eval_Expr_If_Static (Expr);
+            Set_Timeout_Clause (Stmt, Expr);
+            if Get_Expr_Staticness (Expr) = Locally
+              and then Get_Value (Expr) < 0
+            then
+               Error_Msg_Sem ("timeout value must be positive", Stmt);
+            end if;
+         end if;
+      end if;
+   end Sem_Wait_Statement;
+
+   procedure Sem_Exit_Next_Statement (Stmt : Iir)
+   is
+      Cond: Iir;
+      Loop_Label : Iir;
+      Loop_Stmt: Iir;
+      P : Iir;
+   begin
+      Cond := Get_Condition (Stmt);
+      if Cond /= Null_Iir then
+         Cond := Sem_Condition (Cond);
+         Set_Condition (Stmt, Cond);
+      end if;
+
+      Loop_Label := Get_Loop_Label (Stmt);
+      if Loop_Label /= Null_Iir then
+         Loop_Label := Sem_Denoting_Name (Loop_Label);
+         Set_Loop_Label (Stmt, Loop_Label);
+         Loop_Stmt := Get_Named_Entity (Loop_Label);
+         case Get_Kind (Loop_Stmt) is
+            when Iir_Kind_For_Loop_Statement
+              | Iir_Kind_While_Loop_Statement =>
+               null;
+            when others =>
+               Error_Class_Match (Loop_Label, "loop statement");
+               Loop_Stmt := Null_Iir;
+         end case;
+      else
+         Loop_Stmt := Null_Iir;
+      end if;
+
+      --  Check the current statement is inside the labeled loop.
+      P := Stmt;
+      loop
+         P := Get_Parent (P);
+         case Get_Kind (P) is
+            when Iir_Kind_While_Loop_Statement
+              | Iir_Kind_For_Loop_Statement =>
+               if Loop_Stmt = Null_Iir or else P = Loop_Stmt then
+                  exit;
+               end if;
+            when Iir_Kind_If_Statement
+              | Iir_Kind_Elsif
+              | Iir_Kind_Case_Statement =>
+               null;
+            when others =>
+               --  FIXME: should emit a message for label mismatch.
+               Error_Msg_Sem ("exit/next must be inside a loop", Stmt);
+               exit;
+         end case;
+      end loop;
+   end Sem_Exit_Next_Statement;
+
+   -- Process is the scope, this is also the process for which drivers can
+   -- be created.
+   procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir)
+   is
+      Stmt: Iir;
+   begin
+      Stmt := First_Stmt;
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Null_Statement =>
+               null;
+            when Iir_Kind_If_Statement =>
+               declare
+                  Clause: Iir := Stmt;
+                  Cond: Iir;
+               begin
+                  while Clause /= Null_Iir loop
+                     Cond := Get_Condition (Clause);
+                     if Cond /= Null_Iir then
+                        Cond := Sem_Condition (Cond);
+                        Set_Condition (Clause, Cond);
+                     end if;
+                     Sem_Sequential_Statements_Internal
+                       (Get_Sequential_Statement_Chain (Clause));
+                     Clause := Get_Else_Clause (Clause);
+                  end loop;
+               end;
+            when Iir_Kind_For_Loop_Statement =>
+               declare
+                  Iterator: Iir;
+               begin
+                  --  LRM 10.1 Declarative region
+                  --  9. A loop statement.
+                  Open_Declarative_Region;
+
+                  Set_Is_Within_Flag (Stmt, True);
+                  Iterator := Get_Parameter_Specification (Stmt);
+                  Sem_Scopes.Add_Name (Iterator);
+                  Sem_Iterator (Iterator, None);
+                  Set_Visible_Flag (Iterator, True);
+                  Sem_Sequential_Statements_Internal
+                    (Get_Sequential_Statement_Chain (Stmt));
+                  Set_Is_Within_Flag (Stmt, False);
+
+                  Close_Declarative_Region;
+               end;
+            when Iir_Kind_While_Loop_Statement =>
+               declare
+                  Cond: Iir;
+               begin
+                  Cond := Get_Condition (Stmt);
+                  if Cond /= Null_Iir then
+                     Cond := Sem_Condition (Cond);
+                     Set_Condition (Stmt, Cond);
+                  end if;
+                  Sem_Sequential_Statements_Internal
+                    (Get_Sequential_Statement_Chain (Stmt));
+               end;
+            when Iir_Kind_Signal_Assignment_Statement =>
+               Sem_Signal_Assignment (Stmt);
+               if Current_Concurrent_Statement /= Null_Iir and then
+                 Get_Kind (Current_Concurrent_Statement)
+                 in Iir_Kinds_Process_Statement
+                 and then Get_Passive_Flag (Current_Concurrent_Statement)
+               then
+                  Error_Msg_Sem
+                    ("signal statement forbidden in passive process", Stmt);
+               end if;
+            when Iir_Kind_Variable_Assignment_Statement =>
+               Sem_Variable_Assignment (Stmt);
+            when Iir_Kind_Return_Statement =>
+               Sem_Return_Statement (Stmt);
+            when Iir_Kind_Assertion_Statement =>
+               Sem_Assertion_Statement (Stmt);
+            when Iir_Kind_Report_Statement =>
+               Sem_Report_Statement (Stmt);
+            when Iir_Kind_Case_Statement =>
+               Sem_Case_Statement (Stmt);
+            when Iir_Kind_Wait_Statement =>
+               Sem_Wait_Statement (Stmt);
+            when Iir_Kind_Procedure_Call_Statement =>
+               Sem_Procedure_Call (Get_Procedure_Call (Stmt), Stmt);
+            when Iir_Kind_Next_Statement
+              | Iir_Kind_Exit_Statement =>
+               Sem_Exit_Next_Statement (Stmt);
+            when others =>
+               Error_Kind ("sem_sequential_statements_Internal", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Sem_Sequential_Statements_Internal;
+
+   procedure Sem_Sequential_Statements (Decl : Iir; Body_Parent : Iir)
+   is
+      Outer_Subprogram: Iir;
+   begin
+      Outer_Subprogram := Current_Subprogram;
+      Current_Subprogram := Decl;
+
+      -- Sem declarations
+      Sem_Sequential_Labels (Get_Sequential_Statement_Chain (Body_Parent));
+      Sem_Declaration_Chain (Body_Parent);
+      Sem_Specification_Chain (Body_Parent, Null_Iir);
+
+      -- Sem statements.
+      Sem_Sequential_Statements_Internal
+        (Get_Sequential_Statement_Chain (Body_Parent));
+
+      Check_Full_Declaration (Body_Parent, Body_Parent);
+
+      Current_Subprogram := Outer_Subprogram;
+   end Sem_Sequential_Statements;
+
+   --  Sem the instantiated unit of STMT and return the node constaining
+   --  ports and generics (either a entity_declaration or a component
+   --  declaration).
+   function Sem_Instantiated_Unit
+     (Stmt : Iir_Component_Instantiation_Statement)
+     return Iir
+   is
+      Inst : Iir;
+      Comp_Name : Iir;
+      Comp : Iir;
+   begin
+      Inst := Get_Instantiated_Unit (Stmt);
+
+      if Get_Kind (Inst) in Iir_Kinds_Denoting_Name then
+         Comp := Get_Named_Entity (Inst);
+         if Comp /= Null_Iir then
+            --  Already semantized before, while trying to separate
+            --  concurrent procedure calls from instantiation stmts.
+            pragma Assert (Get_Kind (Comp) = Iir_Kind_Component_Declaration);
+            return Comp;
+         end if;
+         --  The component may be an entity or a configuration.
+         Comp_Name := Sem_Denoting_Name (Inst);
+         Set_Instantiated_Unit (Stmt, Comp_Name);
+         Comp := Get_Named_Entity (Comp_Name);
+         if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+            Error_Class_Match (Comp_Name, "component");
+            return Null_Iir;
+         end if;
+         return Comp;
+      else
+         return Sem_Entity_Aspect (Inst);
+      end if;
+   end Sem_Instantiated_Unit;
+
+   procedure Sem_Component_Instantiation_Statement
+     (Stmt: Iir_Component_Instantiation_Statement; Is_Passive : Boolean)
+   is
+      Decl : Iir;
+      Entity_Unit : Iir_Design_Unit;
+      Bind : Iir_Binding_Indication;
+   begin
+      --  FIXME: move this check in parse ?
+      if Is_Passive then
+         Error_Msg_Sem ("component instantiation forbidden in entity", Stmt);
+      end if;
+
+      -- Check for label.
+      --  This cannot be moved in parse since a procedure_call may be revert
+      --  into a component instantiation.
+      if Get_Label (Stmt) = Null_Identifier then
+         Error_Msg_Sem ("component instantiation requires a label", Stmt);
+      end if;
+
+      --  Look for the component.
+      Decl := Sem_Instantiated_Unit (Stmt);
+      if Decl = Null_Iir then
+         return;
+      end if;
+
+      -- The association
+      Sem_Generic_Port_Association_Chain (Decl, Stmt);
+
+      --  FIXME: add sources for signals, in order to detect multiple sources
+      --  to unresolved signals.
+      --  What happen if the component is not bound ?
+
+      --  Create a default binding indication if necessary.
+      if Get_Component_Configuration (Stmt) = Null_Iir
+        and then Get_Kind (Decl) = Iir_Kind_Component_Declaration
+      then
+         Entity_Unit := Get_Visible_Entity_Declaration (Decl);
+         if Entity_Unit = Null_Iir then
+            if Flags.Warn_Default_Binding
+              and then not Flags.Flag_Elaborate
+            then
+               Warning_Msg_Sem ("no default binding for instantiation of "
+                                & Disp_Node (Decl), Stmt);
+               Explain_No_Visible_Entity (Decl);
+            end if;
+         elsif Flags.Flag_Elaborate
+           and then (Flags.Flag_Elaborate_With_Outdated
+                     or else Get_Date (Entity_Unit) in Date_Valid)
+         then
+            Bind := Sem_Create_Default_Binding_Indication
+              (Decl, Entity_Unit, Stmt, False);
+            Set_Default_Binding_Indication (Stmt, Bind);
+         end if;
+      end if;
+   end Sem_Component_Instantiation_Statement;
+
+   --  Note: a statement such as
+   --    label1: name;
+   --  can be parsed as a procedure call statement or as a
+   --  component instantiation statement.
+   --  Check now and revert in case of error.
+   function Sem_Concurrent_Procedure_Call_Statement
+     (Stmt : Iir; Is_Passive : Boolean) return Iir
+   is
+      Call : Iir_Procedure_Call;
+      Decl : Iir;
+      Label : Name_Id;
+      N_Stmt : Iir_Component_Instantiation_Statement;
+      Imp : Iir;
+   begin
+      Call := Get_Procedure_Call (Stmt);
+      if Get_Parameter_Association_Chain (Call) = Null_Iir then
+         Imp := Get_Prefix (Call);
+         Sem_Name (Imp);
+         Set_Prefix (Call, Imp);
+
+         Decl := Get_Named_Entity (Imp);
+         if Get_Kind (Decl) = Iir_Kind_Component_Declaration then
+            N_Stmt := Create_Iir (Iir_Kind_Component_Instantiation_Statement);
+            Label := Get_Label (Stmt);
+            Set_Label (N_Stmt, Label);
+            Set_Parent (N_Stmt, Get_Parent (Stmt));
+            Set_Instantiated_Unit (N_Stmt, Finish_Sem_Name (Imp));
+            Location_Copy (N_Stmt, Stmt);
+
+            if Label /= Null_Identifier then
+               --  A component instantiation statement must have
+               --  a label, this condition is checked during the
+               --  sem of the statement.
+               Sem_Scopes.Replace_Name (Label, Stmt, N_Stmt);
+            end if;
+
+            Free_Iir (Stmt);
+            Free_Iir (Call);
+
+            Sem_Component_Instantiation_Statement (N_Stmt, Is_Passive);
+            return N_Stmt;
+         end if;
+      end if;
+      Sem_Procedure_Call (Call, Stmt);
+
+      if Is_Passive then
+         Imp := Get_Implementation (Call);
+         if Get_Kind (Imp) = Iir_Kind_Procedure_Declaration then
+            Decl := Get_Interface_Declaration_Chain (Imp);
+            while Decl /= Null_Iir loop
+               if Get_Mode (Decl) in Iir_Out_Modes then
+                  Error_Msg_Sem (Disp_Node (Imp) & " is not passive", Stmt);
+                  exit;
+               end if;
+               Decl := Get_Chain (Decl);
+            end loop;
+         end if;
+      end if;
+
+      return Stmt;
+   end Sem_Concurrent_Procedure_Call_Statement;
+
+   procedure Sem_Block_Statement (Stmt: Iir_Block_Statement)
+   is
+      Expr: Iir;
+      Guard : Iir_Guard_Signal_Declaration;
+      Header : Iir_Block_Header;
+      Generic_Chain : Iir;
+      Port_Chain : Iir;
+   begin
+      --  LRM 10.1 Declarative region.
+      --  7. A block statement.
+      Open_Declarative_Region;
+
+      Set_Is_Within_Flag (Stmt, True);
+
+      Header := Get_Block_Header (Stmt);
+      if Header /= Null_Iir then
+         Generic_Chain := Get_Generic_Chain (Header);
+         Sem_Interface_Chain (Generic_Chain, Generic_Interface_List);
+         Port_Chain := Get_Port_Chain (Header);
+         Sem_Interface_Chain (Port_Chain, Port_Interface_List);
+
+         --  LRM 9.1
+         --  Such actuals are evaluated in the context of the enclosing
+         --  declarative region.
+         --  GHDL: close the declarative region...
+         Set_Is_Within_Flag (Stmt, False);
+         Close_Declarative_Region;
+
+         Sem_Generic_Port_Association_Chain (Header, Header);
+
+         --  ... and reopen-it.
+         Open_Declarative_Region;
+         Set_Is_Within_Flag (Stmt, True);
+         Add_Declarations_From_Interface_Chain (Generic_Chain);
+         Add_Declarations_From_Interface_Chain (Port_Chain);
+      end if;
+
+      --  LRM93 9.1
+      --  If a guard expression appears after the reserved word BLOCK, then a
+      --  signal with the simple name GUARD of predefined type BOOLEAN is
+      --  implicitly declared at the beginning of the declarative part of the
+      --  block, and the guard expression defined the value of that signal at
+      --  any given time.
+      Guard := Get_Guard_Decl (Stmt);
+      if Guard /= Null_Iir then
+         --  LRM93 9.1
+         --  The type of the guard expression must be type BOOLEAN.
+         --  GHDL: guard expression must be semantized before creating the
+         --   implicit GUARD signal, since the expression may reference GUARD.
+         Set_Expr_Staticness (Guard, None);
+         Set_Name_Staticness (Guard, Locally);
+         Expr := Get_Guard_Expression (Guard);
+         Expr := Sem_Condition (Expr);
+         if Expr /= Null_Iir then
+            Set_Guard_Expression (Guard, Expr);
+         end if;
+
+         --  FIXME: should extract sensivity now and set the has_active flag
+         --  on signals, since the guard expression is evaluated when one of
+         --  its signal is active.  However, how can a bug be introduced by
+         --  evaluating only when signals have events ?
+
+         --  the guard expression is an implicit definition of a signal named
+         --  GUARD.  Create this definition.  This is necessary for the type.
+         Set_Identifier (Guard, Std_Names.Name_Guard);
+         Set_Type (Guard, Boolean_Type_Definition);
+         Set_Block_Statement (Guard, Stmt);
+         Sem_Scopes.Add_Name (Guard);
+         Set_Visible_Flag (Guard, True);
+      end if;
+
+      Sem_Block (Stmt, True);
+      Set_Is_Within_Flag (Stmt, False);
+      Close_Declarative_Region;
+   end Sem_Block_Statement;
+
+   procedure Sem_Generate_Statement (Stmt : Iir_Generate_Statement)
+   is
+      Scheme : Iir;
+   begin
+      --  LRM93 10.1 Declarative region.
+      --  12. A generate statement.
+      Open_Declarative_Region;
+
+      Scheme := Get_Generation_Scheme (Stmt);
+      if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+         Sem_Scopes.Add_Name (Scheme);
+         --  LRM93 §7.4.2 (Globally Static Primaries)
+         --   4. a generate parameter;
+         Sem_Iterator (Scheme, Globally);
+         Set_Visible_Flag (Scheme, True);
+         --  LRM93 §9.7
+         --  The discrete range in a generation scheme of the first form must
+         --  be a static discrete range;
+         if Get_Type (Scheme) /= Null_Iir
+           and then Get_Type_Staticness (Get_Type (Scheme)) < Globally
+         then
+            Error_Msg_Sem ("range must be a static discrete range", Stmt);
+         end if;
+      else
+         Scheme := Sem_Condition (Scheme);
+         --  LRM93 §9.7
+         --  the condition in a generation scheme of the second form must be
+         --  a static expression.
+         if Scheme /= Null_Iir
+           and then Get_Expr_Staticness (Scheme) < Globally
+         then
+            Error_Msg_Sem ("condition must be a static expression", Stmt);
+         else
+            Set_Generation_Scheme (Stmt, Scheme);
+         end if;
+      end if;
+
+      Sem_Block (Stmt, True); -- Flags.Vhdl_Std /= Vhdl_87);
+      Close_Declarative_Region;
+   end Sem_Generate_Statement;
+
+   procedure Sem_Process_Statement (Proc: Iir) is
+   begin
+      Set_Is_Within_Flag (Proc, True);
+
+      --  LRM 10.1
+      --  8. A process statement
+      Open_Declarative_Region;
+
+      -- Sem declarations
+      Sem_Sequential_Statements (Proc, Proc);
+
+      Close_Declarative_Region;
+
+      Set_Is_Within_Flag (Proc, False);
+
+      if Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement
+        and then Get_Callees_List (Proc) /= Null_Iir_List
+      then
+         --  Check there is no wait statement in subprograms called.
+         --  Also in the case of all-sensitized process, check that package
+         --  subprograms don't read signals.
+         Sem.Add_Analysis_Checks_List (Proc);
+      end if;
+   end Sem_Process_Statement;
+
+   procedure Sem_Sensitized_Process_Statement
+     (Proc: Iir_Sensitized_Process_Statement) is
+   begin
+      Sem_Sensitivity_List (Get_Sensitivity_List (Proc));
+      Sem_Process_Statement (Proc);
+   end Sem_Sensitized_Process_Statement;
+
+   procedure Sem_Guard (Stmt: Iir)
+   is
+      Guard: Iir;
+      Guard_Interpretation : Name_Interpretation_Type;
+   begin
+      Guard := Get_Guard (Stmt);
+      if Guard = Null_Iir then
+         --  This assignment is not guarded.
+
+         --  LRM93 9.5
+         --  It is an error if a concurrent signal assignment is not a guarded
+         --  assignment, and the target of the concurrent signal assignment
+         --  is a guarded target.
+         if Get_Guarded_Target_State (Stmt) = True then
+            Error_Msg_Sem
+              ("not a guarded assignment for a guarded target", Stmt);
+         end if;
+         return;
+      end if;
+      if Guard /= Stmt then
+         -- if set, guard must be equal to stmt here.
+         raise Internal_Error;
+      end if;
+      Guard_Interpretation := Get_Interpretation (Std_Names.Name_Guard);
+      if not Valid_Interpretation (Guard_Interpretation) then
+         Error_Msg_Sem ("no guard signals for this guarded assignment", Stmt);
+         return;
+      end if;
+
+      Guard := Get_Declaration (Guard_Interpretation);
+      -- LRM93 9.5:
+      -- The signal GUARD [...] an explicitly declared signal of type
+      -- BOOLEAN that is visible at the point of the concurrent signal
+      -- assignment statement
+      -- FIXME.
+      case Get_Kind (Guard) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when others =>
+            Error_Msg_Sem ("visible GUARD object is not a signal", Stmt);
+            Error_Msg_Sem ("GUARD object is " & Disp_Node (Guard), Stmt);
+            return;
+      end case;
+
+      if Get_Type (Guard) /= Boolean_Type_Definition then
+         Error_Msg_Sem ("GUARD is not of boolean type", Guard);
+      end if;
+      Set_Guard (Stmt, Guard);
+   end Sem_Guard;
+
+   procedure Sem_Concurrent_Conditional_Signal_Assignment
+     (Stmt: Iir_Concurrent_Conditional_Signal_Assignment)
+   is
+      Cond_Wf : Iir_Conditional_Waveform;
+      Expr : Iir;
+      Wf_Chain : Iir_Waveform_Element;
+      Target_Type : Iir;
+      Target : Iir;
+   begin
+      Target := Get_Target (Stmt);
+      if Get_Kind (Target) /= Iir_Kind_Aggregate then
+         if not Sem_Signal_Assignment_Target_And_Option (Stmt, Null_Iir) then
+            return;
+         end if;
+         Target := Get_Target (Stmt);
+         Target_Type := Get_Type (Target);
+      else
+         Target_Type := Null_Iir;
+      end if;
+
+      Cond_Wf := Get_Conditional_Waveform_Chain (Stmt);
+      while Cond_Wf /= Null_Iir loop
+         Wf_Chain := Get_Waveform_Chain (Cond_Wf);
+         Sem_Waveform_Chain (Stmt, Wf_Chain, Target_Type);
+         Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
+         Expr := Get_Condition (Cond_Wf);
+         if Expr /= Null_Iir then
+            Expr := Sem_Condition (Expr);
+            if Expr /= Null_Iir then
+               Set_Condition (Cond_Wf, Expr);
+            end if;
+         end if;
+         Cond_Wf := Get_Chain (Cond_Wf);
+      end loop;
+      Sem_Guard (Stmt);
+      if Get_Kind (Target) = Iir_Kind_Aggregate then
+         if not Sem_Signal_Assignment_Target_And_Option (Stmt, Target_Type)
+         then
+            return;
+         end if;
+      end if;
+   end Sem_Concurrent_Conditional_Signal_Assignment;
+
+   procedure Sem_Concurrent_Selected_Signal_Assignment (Stmt: Iir)
+   is
+      Expr: Iir;
+      Chain : Iir;
+      El: Iir;
+      Waveform_Type : Iir;
+      Target : Iir;
+      Assoc_El : Iir;
+   begin
+      Target := Get_Target (Stmt);
+      Chain := Get_Selected_Waveform_Chain (Stmt);
+      Waveform_Type := Null_Iir;
+
+      if Get_Kind (Target) = Iir_Kind_Aggregate then
+         --  LRM 9.5  Concurrent Signal Assgnment Statements.
+         --  The process statement equivalent to a concurrent signal assignment
+         --  statement [...] is constructed as follows: [...]
+         --
+         --  LRM 9.5.2  Selected Signa Assignment
+         --  The characteristics of the selected expression, the waveforms and
+         --  the choices in the selected assignment statement must be such that
+         --  the case statement in the equivalent statement is a legal
+         --  statement
+
+         --  Find the first waveform that will appear in the equivalent
+         --  process statement, and extract type from it.
+         Assoc_El := Null_Iir;
+         El := Chain;
+
+         while El /= Null_Iir loop
+            Assoc_El := Get_Associated_Expr (El);
+            exit when Assoc_El /= Null_Iir;
+            El := Get_Chain (El);
+         end loop;
+         if Assoc_El = Null_Iir then
+            Error_Msg_Sem
+              ("cannot determine type of the aggregate target", Target);
+         else
+            Sem_Waveform_Chain (Stmt, Assoc_El, Waveform_Type);
+         end if;
+         if Waveform_Type = Null_Iir then
+            --  Type of target still unknown.
+            --  Since the target is an aggregate, we won't be able to
+            --  semantize it.
+            --  Avoid a crash.
+            return;
+         end if;
+      end if;
+      if not Sem_Signal_Assignment_Target_And_Option (Stmt, Waveform_Type) then
+         return;
+      end if;
+      Waveform_Type := Get_Type (Get_Target (Stmt));
+
+      -- Sem on associated.
+      if Waveform_Type /= Null_Iir then
+         El := Chain;
+         while El /= Null_Iir loop
+            Sem_Waveform_Chain
+              (Stmt, Get_Associated_Chain (El), Waveform_Type);
+            Sem_Check_Waveform_Chain (Stmt, Get_Associated_Chain (El));
+            El := Get_Chain (El);
+         end loop;
+      end if;
+
+      --  The choices.
+      Expr := Sem_Case_Expression (Get_Expression (Stmt));
+      if Expr = Null_Iir then
+         return;
+      end if;
+      Check_Read (Expr);
+      Set_Expression (Stmt, Expr);
+      Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
+      Set_Selected_Waveform_Chain (Stmt, Chain);
+
+      Sem_Guard (Stmt);
+   end Sem_Concurrent_Selected_Signal_Assignment;
+
+   procedure Simple_Simultaneous_Statement (Stmt : Iir) is
+      Left, Right : Iir;
+      Res_Type : Iir;
+   begin
+      Left := Get_Simultaneous_Left (Stmt);
+      Right := Get_Simultaneous_Right (Stmt);
+
+      Left := Sem_Expression_Ov (Left, Null_Iir);
+      Right := Sem_Expression_Ov (Right, Null_Iir);
+
+      --  Give up in case of error
+      if Left = Null_Iir or else Right = Null_Iir then
+         return;
+      end if;
+
+      Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right));
+      if Res_Type = Null_Iir then
+         Error_Msg_Sem ("types of left and right expressions are incompatible",
+                        Stmt);
+         return;
+      end if;
+
+      --  FIXME: check for nature type...
+   end Simple_Simultaneous_Statement;
+
+   procedure Sem_Concurrent_Statement_Chain (Parent : Iir)
+   is
+      Is_Passive : constant Boolean :=
+        Get_Kind (Parent) = Iir_Kind_Entity_Declaration;
+      El: Iir;
+      Prev_El : Iir;
+      Prev_Concurrent_Statement : Iir;
+      Prev_Psl_Default_Clock : Iir;
+   begin
+      Prev_Concurrent_Statement := Current_Concurrent_Statement;
+      Prev_Psl_Default_Clock := Current_Psl_Default_Clock;
+
+      El := Get_Concurrent_Statement_Chain (Parent);
+      Prev_El := Null_Iir;
+      while El /= Null_Iir loop
+         Current_Concurrent_Statement := El;
+
+         case Get_Kind (El) is
+            when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+               if Is_Passive then
+                  Error_Msg_Sem ("signal assignment forbidden in entity", El);
+               end if;
+               Sem_Concurrent_Conditional_Signal_Assignment (El);
+            when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+               if Is_Passive then
+                  Error_Msg_Sem ("signal assignment forbidden in entity", El);
+               end if;
+               Sem_Concurrent_Selected_Signal_Assignment (El);
+            when Iir_Kind_Sensitized_Process_Statement =>
+               Set_Passive_Flag (El, Is_Passive);
+               Sem_Sensitized_Process_Statement (El);
+            when Iir_Kind_Process_Statement =>
+               Set_Passive_Flag (El, Is_Passive);
+               Sem_Process_Statement (El);
+            when Iir_Kind_Component_Instantiation_Statement =>
+               Sem_Component_Instantiation_Statement (El, Is_Passive);
+            when Iir_Kind_Concurrent_Assertion_Statement =>
+               --  FIXME: must check assertion expressions does not contain
+               --  non-passive subprograms ??
+               Sem_Assertion_Statement (El);
+            when Iir_Kind_Block_Statement =>
+               if Is_Passive then
+                  Error_Msg_Sem ("block forbidden in entity", El);
+               end if;
+               Sem_Block_Statement (El);
+            when Iir_Kind_Generate_Statement =>
+               if Is_Passive then
+                  Error_Msg_Sem ("generate statement forbidden in entity", El);
+               end if;
+               Sem_Generate_Statement (El);
+            when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+               declare
+                  Next_El : Iir;
+                  N_Stmt : Iir;
+               begin
+                  Next_El := Get_Chain (El);
+                  N_Stmt := Sem_Concurrent_Procedure_Call_Statement
+                    (El, Is_Passive);
+                  if N_Stmt /= El then
+                     --  Replace this node.
+                     El := N_Stmt;
+                     if Prev_El = Null_Iir then
+                        Set_Concurrent_Statement_Chain (Parent, El);
+                     else
+                        Set_Chain (Prev_El, El);
+                     end if;
+                     Set_Chain (El, Next_El);
+                  end if;
+               end;
+            when Iir_Kind_Psl_Declaration =>
+               Sem_Psl.Sem_Psl_Declaration (El);
+            when Iir_Kind_Psl_Assert_Statement
+              | Iir_Kind_Psl_Cover_Statement =>
+               Sem_Psl.Sem_Psl_Assert_Statement (El);
+            when Iir_Kind_Psl_Default_Clock =>
+               Sem_Psl.Sem_Psl_Default_Clock (El);
+            when Iir_Kind_Simple_Simultaneous_Statement =>
+               Simple_Simultaneous_Statement (El);
+            when others =>
+               Error_Kind ("sem_concurrent_statement_chain", El);
+         end case;
+         Prev_El := El;
+         El := Get_Chain (El);
+      end loop;
+
+      Current_Concurrent_Statement := Prev_Concurrent_Statement;
+      Current_Psl_Default_Clock := Prev_Psl_Default_Clock;
+   end Sem_Concurrent_Statement_Chain;
+
+   --  Put labels in declarative region.
+   procedure Sem_Labels_Chain (Parent : Iir)
+   is
+      Stmt: Iir;
+      Label: Name_Id;
+   begin
+      Stmt := Get_Concurrent_Statement_Chain (Parent);
+      while Stmt /= Null_Iir loop
+
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Psl_Declaration =>
+               --  Special case for in-lined PSL declarations.
+               null;
+            when others =>
+               Label := Get_Label (Stmt);
+
+               if Label /= Null_Identifier then
+                  Sem_Scopes.Add_Name (Stmt);
+                  Name_Visible (Stmt);
+                  Xref_Decl (Stmt);
+               end if;
+         end case;
+
+         --  INT-1991/issue report 27
+         --  Generate statements represent declarative region and have
+         --  implicit declarative part.
+         if False
+           and then Flags.Vhdl_Std = Vhdl_87
+           and then Get_Kind (Stmt) = Iir_Kind_Generate_Statement
+         then
+            Sem_Labels_Chain (Stmt);
+         end if;
+
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Sem_Labels_Chain;
+
+   procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean)
+   is
+      Implicit : Implicit_Signal_Declaration_Type;
+   begin
+      Push_Signals_Declarative_Part (Implicit, Blk);
+
+      if Sem_Decls then
+         Sem_Labels_Chain (Blk);
+         Sem_Declaration_Chain (Blk);
+      end if;
+
+      Sem_Concurrent_Statement_Chain (Blk);
+
+      if Sem_Decls then
+         --  FIXME: do it only if there is conf. spec. in the declarative
+         --  part.
+         Sem_Specification_Chain (Blk, Blk);
+         Check_Full_Declaration (Blk, Blk);
+      end if;
+
+      Pop_Signals_Declarative_Part (Implicit);
+   end Sem_Block;
+
+   --  Add a driver for SIG.
+   --  STMT is used in case of error (it is the statement that creates the
+   --   driver).
+   --  Do nothing if:
+   --    The current statement list does not belong to a process,
+   --    SIG is a formal signal interface.
+   procedure Sem_Add_Driver (Sig : Iir; Stmt : Iir)
+   is
+      Sig_Object : Iir;
+      Sig_Object_Type : Iir;
+   begin
+      if Sig = Null_Iir then
+         return;
+      end if;
+      Sig_Object := Get_Object_Prefix (Sig);
+      Sig_Object_Type := Get_Type (Sig_Object);
+
+      --  LRM 4.3.1.2 Signal Declaration
+      --  It is an error if, after the elaboration of a description, a
+      --  signal has multiple sources and it is not a resolved signal.
+
+      --  Check for multiple driver for a unresolved signal declaration.
+      --  Do this only if the object is a non-composite signal declaration.
+      --  NOTE: THIS IS DISABLED, since the assignment may be within a
+      --  generate statement.
+      if False
+        and then Get_Kind (Sig_Object) = Iir_Kind_Signal_Declaration
+        and then Get_Kind (Sig_Object_Type)
+        not in Iir_Kinds_Composite_Type_Definition
+        and then not Get_Resolved_Flag (Sig_Object_Type)
+      then
+         if Get_Signal_Driver (Sig_Object) /= Null_Iir and then
+           Get_Signal_Driver (Sig_Object) /= Current_Concurrent_Statement
+         then
+            Error_Msg_Sem ("unresolved " & Disp_Node (Sig_Object)
+                           & " has already a driver at "
+                           & Disp_Location (Get_Signal_Driver (Sig_Object)),
+                           Stmt);
+         else
+            Set_Signal_Driver (Sig_Object, Current_Concurrent_Statement);
+         end if;
+      end if;
+
+      --  LRM 8.4.1
+      --  If a given procedure is declared by a declarative item that is not
+      --  contained within a process statement, and if a signal assignment
+      --  statement appears in that procedure, then the target of the
+      --  assignment statement must be a formal parameter of the given
+      --  procedure or of a parent of that procedure, or an aggregate of such
+      --  formal parameters.
+      --  Similarly, if a given procedure is declared by a declarative item
+      --  that is not contained within a process statement and if a signal is
+      --  associated with an INOUT or OUT mode signal parameter in a
+      --  subprogram call within that procedure, then the signal so associated
+      --  must be a formal parameter of the given procedure or of a parent of
+      --  that procedure.
+      if Current_Concurrent_Statement = Null_Iir
+        or else (Get_Kind (Current_Concurrent_Statement)
+                 not in Iir_Kinds_Process_Statement)
+      then
+         --  Not within a process statement.
+         if Current_Subprogram = Null_Iir then
+            --  not within a subprogram: concurrent statement.
+            return;
+         end if;
+
+         --  Within a subprogram.
+         if Get_Kind (Sig_Object) = Iir_Kind_Signal_Declaration
+           or else (Get_Kind (Get_Parent (Sig_Object))
+                    /= Iir_Kind_Procedure_Declaration)
+         then
+            Error_Msg_Sem
+              (Disp_Node (Sig_Object) & " is not a formal parameter", Stmt);
+         end if;
+      end if;
+   end Sem_Add_Driver;
+end Sem_Stmts;
diff --git a/src/sem_stmts.ads b/src/sem_stmts.ads
new file mode 100644
index 000000000..d3eeb8c09
--- /dev/null
+++ b/src/sem_stmts.ads
@@ -0,0 +1,87 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Sem_Stmts is
+   --  Semantize declarations and concurrent statements of BLK, which is
+   --  either an architecture_declaration, and entity_declaration or
+   --  a block_statement.
+   --  If SEM_DECLS is true, then semantize the declarations of BLK.
+   procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean);
+
+   --  Analyze the concurrent statements of PARENT.
+   procedure Sem_Concurrent_Statement_Chain (Parent : Iir);
+
+   --  Some signals are implicitly declared.  This is the case for signals
+   --  declared by an attribute ('stable, 'quiet and 'transaction).
+   --  Note: guard signals are also implicitly declared, but with a guard
+   --   expression, which is located.
+   --  Since these signals need resources and are not easily located (can be
+   --  nearly in every expression), it is useful to add a node into a
+   --  declaration list to declare them.
+   --  However, only a few declaration_list can declare signals.  These
+   --  declarations lists must register and unregister themselves with
+   --  push_declarative_region_with_signals and
+   --  pop_declarative_region_with_signals.
+   type Implicit_Signal_Declaration_Type is private;
+
+   procedure Push_Signals_Declarative_Part
+     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir);
+
+   procedure Pop_Signals_Declarative_Part
+     (Cell: in Implicit_Signal_Declaration_Type);
+
+   -- Declare an implicit signal.
+   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir);
+
+   --  Semantize declaration chain and sequential statement chain
+   --  of BODY_PARENT.
+   --  DECL is the declaration for these chains (DECL is the declaration, which
+   --   is different from the bodies).
+   --  This is used by processes and subprograms semantization.
+   procedure Sem_Sequential_Statements (Decl : Iir; Body_Parent : Iir);
+
+   --  Sem for concurrent and sequential assertion statements.
+   procedure Sem_Report_Statement (Stmt : Iir);
+
+   -- Get the current subprogram or process.
+   function Get_Current_Subprogram return Iir;
+   pragma Inline (Get_Current_Subprogram);
+
+   --  Get the current concurrent statement, or NULL_IIR if none.
+   function Get_Current_Concurrent_Statement return Iir;
+   pragma Inline (Get_Current_Concurrent_Statement);
+
+   --  Current PSL default_clock declaration.
+   --  Automatically saved and restore while analyzing concurrent statements.
+   Current_Psl_Default_Clock : Iir;
+
+   --  Add a driver for SIG.
+   --  STMT is used in case of error (it is the statement that creates the
+   --   driver).
+   --  Do nothing if:
+   --    The current statement list does not belong to a process,
+   --    SIG is a formal signal interface.
+   procedure Sem_Add_Driver (Sig : Iir; Stmt : Iir);
+private
+   type Implicit_Signal_Declaration_Type is record
+      Decls_Parent : Iir;
+      Last_Decl : Iir;
+   end record;
+
+end Sem_Stmts;
diff --git a/src/sem_types.adb b/src/sem_types.adb
new file mode 100644
index 000000000..12f276be1
--- /dev/null
+++ b/src/sem_types.adb
@@ -0,0 +1,2210 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Libraries;
+with Flags; use Flags;
+with Types; use Types;
+with Errorout; use Errorout;
+with Evaluation; use Evaluation;
+with Sem;
+with Sem_Expr; use Sem_Expr;
+with Sem_Scopes; use Sem_Scopes;
+with Sem_Names; use Sem_Names;
+with Sem_Decls;
+with Sem_Inst;
+with Name_Table;
+with Std_Names;
+with Iirs_Utils; use Iirs_Utils;
+with Std_Package; use Std_Package;
+with Ieee.Std_Logic_1164;
+with Xrefs; use Xrefs;
+
+package body Sem_Types is
+   --  Mark the resolution function (this may be required by the back-end to
+   --  generate resolver).
+   procedure Mark_Resolution_Function (Subtyp : Iir)
+   is
+      Func : Iir_Function_Declaration;
+   begin
+      if not Get_Resolved_Flag (Subtyp) then
+         return;
+      end if;
+
+      Func := Has_Resolution_Function (Subtyp);
+      --  Maybe the type is resolved through its elements.
+      if Func /= Null_Iir then
+         Set_Resolution_Function_Flag (Func, True);
+      end if;
+   end Mark_Resolution_Function;
+
+   procedure Set_Type_Has_Signal (Atype : Iir)
+   is
+      Orig : Iir;
+   begin
+      --  Sanity check: ATYPE can be a signal type (eg: not an access type)
+      if not Get_Signal_Type_Flag (Atype) then
+         --  Do not crash since this may be called on an erroneous design.
+         return;
+      end if;
+
+      --  If the type is already marked, nothing to do.
+      if Get_Has_Signal_Flag (Atype) then
+         return;
+      end if;
+
+      --  This type is used to declare a signal.
+      Set_Has_Signal_Flag (Atype, True);
+
+      --  If this type was instantiated, also mark the origin.
+      Orig := Sem_Inst.Get_Origin (Atype);
+      if Orig /= Null_Iir then
+         Set_Type_Has_Signal (Orig);
+      end if;
+
+      --  Mark resolution function, and for composite types, also mark type
+      --  of elements.
+      case Get_Kind (Atype) is
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Floating_Type_Definition =>
+            null;
+         when Iir_Kinds_Scalar_Subtype_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            Set_Type_Has_Signal (Get_Base_Type (Atype));
+            Mark_Resolution_Function (Atype);
+         when Iir_Kind_Array_Subtype_Definition =>
+            Set_Type_Has_Signal (Get_Base_Type (Atype));
+            Mark_Resolution_Function (Atype);
+            Set_Type_Has_Signal (Get_Element_Subtype (Atype));
+         when Iir_Kind_Array_Type_Definition =>
+            Set_Type_Has_Signal (Get_Element_Subtype (Atype));
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               El_List : constant Iir_List :=
+                 Get_Elements_Declaration_List (Atype);
+               El : Iir;
+            begin
+               for I in Natural loop
+                  El := Get_Nth_Element (El_List, I);
+                  exit when El = Null_Iir;
+                  Set_Type_Has_Signal (Get_Type (El));
+               end loop;
+            end;
+         when Iir_Kind_Error =>
+            null;
+         when Iir_Kind_Incomplete_Type_Definition =>
+            --  No need to copy the flag.
+            null;
+         when others =>
+            Error_Kind ("set_type_has_signal(2)", Atype);
+      end case;
+   end Set_Type_Has_Signal;
+
+   --  Sem a range expression that appears in an integer, real or physical
+   --  type definition.
+   --
+   --  Both left and right bounds must be of the same type class, ie
+   --  integer types, or if INT_ONLY is false, real types.
+   --  However, the two bounds need not have the same type.
+   function Sem_Type_Range_Expression (Expr : Iir; Int_Only : Boolean)
+                                      return Iir
+   is
+      Left, Right: Iir;
+      Bt_L_Kind, Bt_R_Kind : Iir_Kind;
+   begin
+      Left := Sem_Expression_Universal (Get_Left_Limit (Expr));
+      Right := Sem_Expression_Universal (Get_Right_Limit (Expr));
+      if Left = Null_Iir or Right = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      --  Emit error message for overflow and replace with a value to avoid
+      --  error storm.
+      if Get_Kind (Left) = Iir_Kind_Overflow_Literal then
+         Error_Msg_Sem ("overflow in left bound", Left);
+         Left := Build_Extreme_Value
+           (Get_Direction (Expr) = Iir_Downto, Left);
+      end if;
+      if Get_Kind (Right) = Iir_Kind_Overflow_Literal then
+         Error_Msg_Sem ("overflow in right bound", Right);
+         Right := Build_Extreme_Value
+           (Get_Direction (Expr) = Iir_To, Right);
+      end if;
+      Set_Left_Limit (Expr, Left);
+      Set_Right_Limit (Expr, Right);
+
+      Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Left),
+                                      Get_Expr_Staticness (Right)));
+
+      Bt_L_Kind := Get_Kind (Get_Base_Type (Get_Type (Left)));
+      Bt_R_Kind := Get_Kind (Get_Base_Type (Get_Type (Right)));
+
+      if Int_Only then
+         if Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_R_Kind = Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("left bound must be an integer expression", Left);
+            return Null_Iir;
+         end if;
+         if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_L_Kind = Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("right bound must be an integer expression", Left);
+            return Null_Iir;
+         end if;
+         if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition
+           and then Bt_L_Kind /= Iir_Kind_Integer_Type_Definition
+         then
+            Error_Msg_Sem ("each bound must be an integer expression", Expr);
+            return Null_Iir;
+         end if;
+      else
+         if Bt_L_Kind /= Bt_R_Kind then
+            Error_Msg_Sem
+              ("left and right bounds must be of the same type class", Expr);
+            return Null_Iir;
+         end if;
+         case Bt_L_Kind is
+            when Iir_Kind_Integer_Type_Definition
+              | Iir_Kind_Floating_Type_Definition =>
+               null;
+         when others =>
+            --  Enumeration range are not allowed to define a new type.
+            Error_Msg_Sem
+              ("bad range type, only integer or float is allowed", Expr);
+            return Null_Iir;
+         end case;
+      end if;
+
+      return Expr;
+   end Sem_Type_Range_Expression;
+
+   function Create_Integer_Type (Loc : Iir; Constraint : Iir; Decl : Iir)
+                                return Iir
+   is
+      Ntype: Iir_Integer_Subtype_Definition;
+      Ndef: Iir_Integer_Type_Definition;
+   begin
+      Ntype := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+      Location_Copy (Ntype, Loc);
+      Ndef := Create_Iir (Iir_Kind_Integer_Type_Definition);
+      Location_Copy (Ndef, Loc);
+      Set_Base_Type (Ndef, Ndef);
+      Set_Type_Declarator (Ndef, Decl);
+      Set_Type_Staticness (Ndef, Locally);
+      Set_Signal_Type_Flag (Ndef, True);
+      Set_Base_Type (Ntype, Ndef);
+      Set_Type_Declarator (Ntype, Decl);
+      Set_Range_Constraint (Ntype, Constraint);
+      Set_Type_Staticness (Ntype, Get_Expr_Staticness (Constraint));
+      Set_Resolved_Flag (Ntype, False);
+      Set_Signal_Type_Flag (Ntype, True);
+      if Get_Type_Staticness (Ntype) /= Locally then
+         Error_Msg_Sem ("range constraint of type must be locally static",
+                        Decl);
+      end if;
+      return Ntype;
+   end Create_Integer_Type;
+
+   function Range_Expr_To_Type_Definition (Expr : Iir; Decl: Iir)
+     return Iir
+   is
+      Rng : Iir;
+      Res : Iir;
+      Base_Type : Iir;
+   begin
+      if Sem_Type_Range_Expression (Expr, False) = Null_Iir then
+         return Null_Iir;
+      end if;
+      Rng := Eval_Range_If_Static (Expr);
+      if Get_Expr_Staticness (Rng) /= Locally then
+         --  FIXME: create an artificial range to avoid error storm ?
+         null;
+      end if;
+
+      case Get_Kind (Get_Base_Type (Get_Type (Get_Left_Limit (Rng)))) is
+         when Iir_Kind_Integer_Type_Definition =>
+            Res := Create_Integer_Type (Expr, Rng, Decl);
+         when Iir_Kind_Floating_Type_Definition =>
+            declare
+               Ntype: Iir_Floating_Subtype_Definition;
+               Ndef: Iir_Floating_Type_Definition;
+            begin
+               Ntype := Create_Iir (Iir_Kind_Floating_Subtype_Definition);
+               Location_Copy (Ntype, Expr);
+               Ndef := Create_Iir (Iir_Kind_Floating_Type_Definition);
+               Location_Copy (Ndef, Expr);
+               Set_Base_Type (Ndef, Ndef);
+               Set_Type_Declarator (Ndef, Decl);
+               Set_Type_Staticness (Ndef, Get_Expr_Staticness (Expr));
+               Set_Signal_Type_Flag (Ndef, True);
+               Set_Base_Type (Ntype, Ndef);
+               Set_Type_Declarator (Ntype, Decl);
+               Set_Range_Constraint (Ntype, Rng);
+               Set_Resolved_Flag (Ntype, False);
+               Set_Type_Staticness (Ntype, Get_Expr_Staticness (Expr));
+               Set_Signal_Type_Flag (Ntype, True);
+               Res := Ntype;
+            end;
+         when others =>
+            --  sem_range_expression should catch such errors.
+            raise Internal_Error;
+      end case;
+
+      --  A type and a subtype were declared.  The type of the bounds are now
+      --  used for the implicit subtype declaration.  But the type of the
+      --  bounds aren't of the type of the type declaration (this is 'obvious'
+      --  because they exist before the type declaration).  Override their
+      --  type.  This is doable without destroying information as they are
+      --  either literals (of type convertible_xx_type_definition) or an
+      --  evaluated literal.
+      --
+      --  Overriding makes these implicit subtype homogenous with explicit
+      --  subtypes.
+      Base_Type := Get_Base_Type (Res);
+      Set_Type (Rng, Base_Type);
+      Set_Type (Get_Left_Limit (Rng), Base_Type);
+      Set_Type (Get_Right_Limit (Rng), Base_Type);
+
+      return Res;
+   end Range_Expr_To_Type_Definition;
+
+   function Create_Physical_Literal (Val : Iir_Int64; Unit : Iir) return Iir
+   is
+      Lit : Iir;
+   begin
+      Lit := Create_Iir (Iir_Kind_Physical_Int_Literal);
+      Set_Value (Lit, Val);
+      Set_Unit_Name (Lit, Unit);
+      Set_Expr_Staticness (Lit, Locally);
+      Set_Type (Lit, Get_Type (Unit));
+      Location_Copy (Lit, Unit);
+      return Lit;
+   end Create_Physical_Literal;
+
+   --  Analyze a physical type definition.  Create a subtype.
+   function Sem_Physical_Type_Definition (Range_Expr: Iir; Decl : Iir)
+      return Iir_Physical_Subtype_Definition
+   is
+      Unit: Iir_Unit_Declaration;
+      Unit_Name : Iir;
+      Def : Iir_Physical_Type_Definition;
+      Sub_Type: Iir_Physical_Subtype_Definition;
+      Range_Expr1: Iir;
+      Val : Iir;
+      Lit : Iir_Physical_Int_Literal;
+   begin
+      Def := Get_Type (Range_Expr);
+
+      --  LRM93 4.1
+      --  The simple name declared by a type declaration denotes the
+      --  declared type, unless the type declaration declares both a base
+      --  type and a subtype of the base type, in which case the simple name
+      --  denotes the subtype, and the base type is anonymous.
+      Set_Type_Declarator (Def, Decl);
+      Set_Base_Type (Def, Def);
+      Set_Resolved_Flag (Def, False);
+      Set_Type_Staticness (Def, Locally);
+      Set_Signal_Type_Flag (Def, True);
+
+      --  Set the type definition of the type declaration (it was currently the
+      --  range expression).  Do it early so that the units can be referenced
+      --  by expanded names.
+      Set_Type_Definition (Decl, Def);
+
+      --  LRM93 3.1.3
+      --  Each bound of a range constraint that is used in a physical type
+      --  definition must be a locally static expression of some integer type
+      --  but the two bounds need not have the same integer type.
+      case Get_Kind (Range_Expr) is
+         when Iir_Kind_Range_Expression =>
+            Range_Expr1 := Sem_Type_Range_Expression (Range_Expr, True);
+         when others =>
+            Error_Kind ("sem_physical_type_definition", Range_Expr);
+      end case;
+      if Range_Expr1 /= Null_Iir then
+         if Get_Expr_Staticness (Range_Expr1) /= Locally then
+            Error_Msg_Sem
+              ("range constraint for a physical type must be static",
+               Range_Expr1);
+            Range_Expr1 := Null_Iir;
+         else
+            Range_Expr1 := Eval_Range_If_Static (Range_Expr1);
+         end if;
+      end if;
+
+      --  Create the subtype.
+      Sub_Type := Create_Iir (Iir_Kind_Physical_Subtype_Definition);
+      Location_Copy (Sub_Type, Range_Expr);
+      Set_Base_Type (Sub_Type, Def);
+      Set_Signal_Type_Flag (Sub_Type, True);
+
+      --  Analyze the primary unit.
+      Unit := Get_Unit_Chain (Def);
+
+      Unit_Name := Build_Simple_Name (Unit, Unit);
+      Lit := Create_Physical_Literal (1, Unit_Name);
+      Set_Physical_Unit_Value (Unit, Lit);
+
+      Sem_Scopes.Add_Name (Unit);
+      Set_Type (Unit, Def);
+      Set_Expr_Staticness (Unit, Locally);
+      Set_Name_Staticness (Unit, Locally);
+      Set_Visible_Flag (Unit, True);
+      Xref_Decl (Unit);
+
+      if Range_Expr1 /= Null_Iir then
+         declare
+            --  Convert an integer literal to a physical literal.
+            --  This is used to convert bounds.
+            function Lit_To_Phys_Lit (Lim : Iir_Integer_Literal)
+              return Iir_Physical_Int_Literal
+            is
+               Res : Iir_Physical_Int_Literal;
+            begin
+               Res := Create_Iir (Iir_Kind_Physical_Int_Literal);
+               Location_Copy (Res, Lim);
+               Set_Type (Res, Def);
+               Set_Value (Res, Get_Value (Lim));
+               Set_Unit_Name (Res, Get_Primary_Unit_Name (Def));
+               Set_Expr_Staticness (Res, Locally);
+               Set_Literal_Origin (Res, Lim);
+               return Res;
+            end Lit_To_Phys_Lit;
+
+            Phys_Range : Iir_Range_Expression;
+         begin
+            --  Create the physical range.
+            Phys_Range := Create_Iir (Iir_Kind_Range_Expression);
+            Location_Copy (Phys_Range, Range_Expr1);
+            Set_Type (Phys_Range, Def);
+            Set_Direction (Phys_Range, Get_Direction (Range_Expr1));
+            Set_Left_Limit
+              (Phys_Range, Lit_To_Phys_Lit (Get_Left_Limit (Range_Expr1)));
+            Set_Right_Limit
+              (Phys_Range, Lit_To_Phys_Lit (Get_Right_Limit (Range_Expr1)));
+            Set_Expr_Staticness
+              (Phys_Range, Get_Expr_Staticness (Range_Expr1));
+
+            Set_Range_Constraint (Sub_Type, Phys_Range);
+            --  This must be locally...
+            Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (Range_Expr1));
+
+            --  FIXME: the original range is not used.  Reuse it ?
+            Free_Iir (Range_Expr);
+         end;
+      end if;
+      Set_Resolved_Flag (Sub_Type, False);
+
+      --  Analyze secondary units.
+      Unit := Get_Chain (Unit);
+      while Unit /= Null_Iir loop
+         Sem_Scopes.Add_Name (Unit);
+         Val := Sem_Expression (Get_Physical_Literal (Unit), Def);
+         if Val /= Null_Iir then
+            Set_Physical_Literal (Unit, Val);
+            Val := Eval_Physical_Literal (Val);
+            Set_Physical_Unit_Value (Unit, Val);
+
+            --  LRM93 §3.1
+            --  The position number of unit names need not lie within the range
+            --  specified by the range constraint.
+            --  GHDL: this was not true in VHDL87.
+            --  GHDL: This is not so simple if 1 is not included in the range.
+            if False and then Flags.Vhdl_Std = Vhdl_87
+              and then Range_Expr1 /= Null_Iir
+            then
+               if not Eval_Int_In_Range (Get_Value (Unit), Range_Expr1) then
+                  Error_Msg_Sem
+                    ("physical literal does not lie within the range", Unit);
+               end if;
+            end if;
+         else
+            --  Avoid errors storm.
+            Set_Physical_Literal (Unit, Get_Primary_Unit (Def));
+            Set_Physical_Unit_Value (Unit, Lit);
+         end if;
+
+         Set_Type (Unit, Def);
+         Set_Expr_Staticness (Unit, Locally);
+         Set_Name_Staticness (Unit, Locally);
+         Sem_Scopes.Name_Visible (Unit);
+         Xref_Decl (Unit);
+         Unit := Get_Chain (Unit);
+      end loop;
+
+      return Sub_Type;
+   end Sem_Physical_Type_Definition;
+
+   --  Return true iff decl is std.textio.text
+   function Is_Text_Type_Declaration (Decl : Iir_Type_Declaration)
+     return Boolean
+   is
+      use Std_Names;
+      P : Iir;
+   begin
+      if Get_Identifier (Decl) /= Name_Text then
+         return False;
+      end if;
+      P := Get_Parent (Decl);
+      if Get_Kind (P) /= Iir_Kind_Package_Declaration
+        or else Get_Identifier (P) /= Name_Textio
+      then
+         return False;
+      end if;
+      --  design_unit, design_file, library_declaration.
+      P := Get_Library (Get_Design_File (Get_Design_Unit (P)));
+      if P /= Libraries.Std_Library then
+         return False;
+      end if;
+      return True;
+   end Is_Text_Type_Declaration;
+
+   procedure Check_No_File_Type (El_Type : Iir; Loc : Iir) is
+   begin
+      case Get_Kind (El_Type) is
+         when Iir_Kind_File_Type_Definition =>
+            Error_Msg_Sem
+              ("element of file type is not allowed in a composite type", Loc);
+         when others =>
+            null;
+      end case;
+   end Check_No_File_Type;
+
+   --  Semantize the array_element type of array type DEF.
+   --  Set resolved_flag of DEF.
+   procedure Sem_Array_Element (Def : Iir)
+   is
+      El_Type : Iir;
+   begin
+      El_Type := Get_Element_Subtype_Indication (Def);
+      El_Type := Sem_Subtype_Indication (El_Type);
+      if El_Type = Null_Iir then
+         Set_Type_Staticness (Def, None);
+         Set_Resolved_Flag (Def, False);
+         return;
+      end if;
+      Set_Element_Subtype_Indication (Def, El_Type);
+
+      El_Type := Get_Type_Of_Subtype_Indication (El_Type);
+      Set_Element_Subtype (Def, El_Type);
+      Check_No_File_Type (El_Type, Def);
+      Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (El_Type));
+
+      --  LRM93 §3.2.1.1
+      --  The same requirement exists [must define a constrained
+      --  array subtype] [...] for the element subtype indication
+      --  of an array type definition, if the type of the array
+      --  element is itself an array type.
+      if Vhdl_Std < Vhdl_08
+        and then not Is_Fully_Constrained_Type (El_Type)
+      then
+         Error_Msg_Sem ("array element of unconstrained "
+                        & Disp_Node (El_Type) & " is not allowed", Def);
+      end if;
+      Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type));
+   end Sem_Array_Element;
+
+   procedure Sem_Protected_Type_Declaration (Type_Decl : Iir_Type_Declaration)
+   is
+      Decl : Iir_Protected_Type_Declaration;
+      El : Iir;
+   begin
+      Decl := Get_Type_Definition (Type_Decl);
+      Set_Base_Type (Decl, Decl);
+      Set_Resolved_Flag (Decl, False);
+      Set_Signal_Type_Flag (Decl, False);
+      Set_Type_Staticness (Decl, None);
+
+      --  LRM 10.3 Visibility
+      --  [...] except in the declaration of a design_unit or a protected type
+      --  declaration, in which case it starts immediatly after the reserved
+      --  word is occuring after the identifier of the design unit or
+      --  protected type declaration.
+      Set_Visible_Flag (Type_Decl, True);
+
+      --  LRM 10.1
+      --  n) A protected type declaration, together with the corresponding
+      --     body.
+      Open_Declarative_Region;
+
+      Sem_Decls.Sem_Declaration_Chain (Decl);
+      El := Get_Declaration_Chain (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Use_Clause
+              | Iir_Kind_Attribute_Specification =>
+               null;
+            when Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Function_Declaration =>
+               declare
+                  Inter : Iir;
+                  Inter_Type : Iir;
+               begin
+                  Inter := Get_Interface_Declaration_Chain (El);
+                  while Inter /= Null_Iir loop
+                     Inter_Type := Get_Type (Inter);
+                     if Inter_Type /= Null_Iir
+                       and then Get_Signal_Type_Flag (Inter_Type) = False
+                       and then Get_Kind (Inter_Type)
+                       /= Iir_Kind_Protected_Type_Declaration
+                     then
+                        Error_Msg_Sem
+                          ("formal parameter method must not be "
+                           & "access or file type", Inter);
+                     end if;
+                     Inter := Get_Chain (Inter);
+                  end loop;
+                  if Get_Kind (El) = Iir_Kind_Function_Declaration then
+                     Inter_Type := Get_Return_Type (El);
+                     if Inter_Type /= Null_Iir
+                       and then Get_Signal_Type_Flag (Inter_Type) = False
+                     then
+                        Error_Msg_Sem
+                          ("method return type must not be access of file",
+                           El);
+                     end if;
+                  end if;
+               end;
+            when others =>
+               Error_Msg_Sem
+                 (Disp_Node (El)
+                  & " are not allowed in protected type declaration", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      Close_Declarative_Region;
+   end Sem_Protected_Type_Declaration;
+
+   procedure Sem_Protected_Type_Body (Bod : Iir)
+   is
+      Inter : Name_Interpretation_Type;
+      Type_Decl : Iir;
+      Decl : Iir;
+      El : Iir;
+   begin
+      --  LRM 3.5 Protected types.
+      --  Each protected type declaration appearing immediatly within a given
+      --  declaration region must have exactly one corresponding protected type
+      --  body appearing immediatly within the same declarative region and
+      --  textually subsequent to the protected type declaration.
+      --
+      --  Similarly, each protected type body appearing immediatly within a
+      --  given declarative region must have exactly one corresponding
+      --  protected type declaration appearing immediatly within the same
+      --  declarative region and textually prior to the protected type body.
+      Inter := Get_Interpretation (Get_Identifier (Bod));
+      if Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      then
+         Type_Decl := Get_Declaration (Inter);
+         if Get_Kind (Type_Decl) = Iir_Kind_Type_Declaration then
+            Decl := Get_Type_Definition (Type_Decl);
+         else
+            Decl := Null_Iir;
+         end if;
+      else
+         Decl := Null_Iir;
+      end if;
+
+      if Decl /= Null_Iir
+        and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Declaration
+      then
+         Set_Protected_Type_Declaration (Bod, Decl);
+         if Get_Protected_Type_Body (Decl) /= Null_Iir then
+            Error_Msg_Sem
+              ("protected type body already declared for "
+               & Disp_Node (Decl), Bod);
+            Error_Msg_Sem
+              ("(previous body)", Get_Protected_Type_Body (Decl));
+            Decl := Null_Iir;
+         elsif not Get_Visible_Flag (Type_Decl) then
+            --  Can this happen ?
+            Error_Msg_Sem
+              ("protected type declaration not yet visible", Bod);
+            Error_Msg_Sem
+              ("(location of protected type declaration)", Decl);
+            Decl := Null_Iir;
+         else
+            Set_Protected_Type_Body (Decl, Bod);
+         end if;
+      else
+         Error_Msg_Sem
+           ("no protected type declaration for this body", Bod);
+         if Decl /= Null_Iir then
+            Error_Msg_Sem
+              ("(found " & Disp_Node (Decl) & " declared here)", Decl);
+            Decl := Null_Iir;
+         end if;
+      end if;
+
+      --  LRM 10.1
+      --  n) A protected type declaration, together with the corresponding
+      --     body.
+      Open_Declarative_Region;
+
+      if Decl /= Null_Iir then
+         Xref_Body (Bod, Decl);
+         Add_Protected_Type_Declarations (Decl);
+      end if;
+
+      Sem_Decls.Sem_Declaration_Chain (Bod);
+
+      El := Get_Declaration_Chain (Bod);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Procedure_Declaration
+              | Iir_Kind_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration
+              | Iir_Kind_Implicit_Function_Declaration =>
+               null;
+            when Iir_Kind_Procedure_Body
+              | Iir_Kind_Function_Body =>
+               null;
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Anonymous_Type_Declaration =>
+               null;
+            when Iir_Kind_Subtype_Declaration
+              | Iir_Kind_Constant_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_File_Declaration =>
+               null;
+            when Iir_Kind_Object_Alias_Declaration
+              | Iir_Kind_Non_Object_Alias_Declaration =>
+               null;
+            when Iir_Kind_Attribute_Declaration
+              | Iir_Kind_Attribute_Specification
+              | Iir_Kind_Use_Clause
+              | Iir_Kind_Group_Template_Declaration
+              | Iir_Kind_Group_Declaration =>
+               null;
+            when others =>
+               Error_Msg_Sem
+                 (Disp_Node (El) & " not allowed in a protected type body",
+                  El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      Sem_Decls.Check_Full_Declaration (Bod, Bod);
+
+      --  LRM 3.5.2 Protected type bodies
+      --  Each subprogram declaration appearing in a given protected type
+      --  declaration shall have a corresponding subprogram body appearing in
+      --  the corresponding protected type body.
+      if Decl /= Null_Iir then
+         Sem_Decls.Check_Full_Declaration (Decl, Bod);
+      end if;
+
+      Close_Declarative_Region;
+   end Sem_Protected_Type_Body;
+
+   --  Return the constraint state from CONST (the initial state) and ATYPE,
+   --  as if ATYPE was a new element of a record.
+   function Update_Record_Constraint (Const : Iir_Constraint; Atype : Iir)
+                                     return Iir_Constraint is
+   begin
+      if Get_Kind (Atype) not in Iir_Kinds_Composite_Type_Definition then
+         return Const;
+      end if;
+
+      case Const is
+         when Fully_Constrained
+           | Unconstrained =>
+            if Get_Constraint_State (Atype) = Const then
+               return Const;
+            else
+               return Partially_Constrained;
+            end if;
+         when Partially_Constrained =>
+            return Partially_Constrained;
+      end case;
+   end Update_Record_Constraint;
+
+   function Get_Array_Constraint (Def : Iir) return Iir_Constraint
+   is
+      El_Type : constant Iir := Get_Element_Subtype (Def);
+      Index : constant Boolean :=
+        Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition
+        and then Get_Index_Constraint_Flag (Def);
+   begin
+      if Get_Kind (El_Type) in Iir_Kinds_Composite_Type_Definition then
+         case Get_Constraint_State (El_Type) is
+            when Fully_Constrained =>
+               if Index then
+                  return Fully_Constrained;
+               else
+                  return Partially_Constrained;
+               end if;
+            when Partially_Constrained =>
+               return Partially_Constrained;
+            when Unconstrained =>
+               if not Index then
+                  return Unconstrained;
+               else
+                  return Partially_Constrained;
+               end if;
+         end case;
+      else
+         if Index then
+            return Fully_Constrained;
+         else
+            return Unconstrained;
+         end if;
+      end if;
+   end Get_Array_Constraint;
+
+   function Sem_Enumeration_Type_Definition  (Def: Iir; Decl: Iir) return Iir
+   is
+   begin
+      Set_Base_Type (Def, Def);
+      Set_Type_Staticness (Def, Locally);
+      Set_Signal_Type_Flag (Def, True);
+
+      --  Makes all literal visible.
+      declare
+         El: Iir;
+         Literal_List: Iir_List;
+         Only_Characters : Boolean := True;
+      begin
+         Literal_List := Get_Enumeration_Literal_List (Def);
+         for I in Natural loop
+            El := Get_Nth_Element (Literal_List, I);
+            exit when El = Null_Iir;
+            Set_Expr_Staticness (El, Locally);
+            Set_Name_Staticness (El, Locally);
+            Set_Type (El, Def);
+            Set_Enumeration_Decl (El, El);
+            Sem.Compute_Subprogram_Hash (El);
+            Sem_Scopes.Add_Name (El);
+            Name_Visible (El);
+            Xref_Decl (El);
+            if Only_Characters
+              and then not Name_Table.Is_Character (Get_Identifier (El))
+            then
+               Only_Characters := False;
+            end if;
+         end loop;
+         Set_Only_Characters_Flag (Def, Only_Characters);
+      end;
+      Set_Resolved_Flag (Def, False);
+
+      Create_Range_Constraint_For_Enumeration_Type (Def);
+
+      --  Identifier IEEE.Std_Logic_1164.Std_Ulogic.
+      if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic
+        and then
+        Get_Parent (Decl) = Ieee.Std_Logic_1164.Std_Logic_1164_Pkg
+      then
+         Ieee.Std_Logic_1164.Std_Ulogic_Type := Def;
+      end if;
+
+      return Def;
+   end Sem_Enumeration_Type_Definition;
+
+   function Sem_Record_Type_Definition (Def: Iir) return Iir
+   is
+      --  Semantized type of previous element
+      Last_Type : Iir;
+
+      El_List : constant Iir_List := Get_Elements_Declaration_List (Def);
+      El: Iir;
+      El_Type : Iir;
+      Resolved_Flag : Boolean;
+      Staticness : Iir_Staticness;
+      Constraint : Iir_Constraint;
+   begin
+      --  LRM 10.1
+      --  5. A record type declaration,
+      Open_Declarative_Region;
+
+      Resolved_Flag := True;
+      Last_Type := Null_Iir;
+      Staticness := Locally;
+      Constraint := Fully_Constrained;
+      Set_Signal_Type_Flag (Def, True);
+
+      for I in Natural loop
+         El := Get_Nth_Element (El_List, I);
+         exit when El = Null_Iir;
+
+         El_Type := Get_Subtype_Indication (El);
+         if El_Type /= Null_Iir then
+            --  Be careful for a declaration list (r,g,b: integer).
+            El_Type := Sem_Subtype_Indication (El_Type);
+            Set_Subtype_Indication (El, El_Type);
+            El_Type := Get_Type_Of_Subtype_Indication (El_Type);
+            Last_Type := El_Type;
+         else
+            El_Type := Last_Type;
+         end if;
+         if El_Type /= Null_Iir then
+            Set_Type (El, El_Type);
+            Check_No_File_Type (El_Type, El);
+            if not Get_Signal_Type_Flag (El_Type) then
+               Set_Signal_Type_Flag (Def, False);
+            end if;
+
+            --  LRM93 3.2.1.1
+            --  The same requirement [must define a constrained array
+            --  subtype] exits for the subtype indication of an
+            --  element declaration, if the type of the record
+            --  element is an array type.
+            if Vhdl_Std < Vhdl_08
+              and then not Is_Fully_Constrained_Type (El_Type)
+            then
+               Error_Msg_Sem
+                 ("element declaration of unconstrained "
+                    & Disp_Node (El_Type) & " is not allowed", El);
+            end if;
+            Resolved_Flag :=
+              Resolved_Flag and Get_Resolved_Flag (El_Type);
+            Staticness := Min (Staticness,
+                               Get_Type_Staticness (El_Type));
+            Constraint := Update_Record_Constraint
+              (Constraint, El_Type);
+         else
+            Staticness := None;
+         end if;
+         Sem_Scopes.Add_Name (El);
+         Name_Visible (El);
+         Xref_Decl (El);
+      end loop;
+      Close_Declarative_Region;
+      Set_Base_Type (Def, Def);
+      Set_Resolved_Flag (Def, Resolved_Flag);
+      Set_Type_Staticness (Def, Staticness);
+      Set_Constraint_State (Def, Constraint);
+      return Def;
+   end Sem_Record_Type_Definition;
+
+   function Sem_Unbounded_Array_Type_Definition (Def: Iir) return Iir
+   is
+      Index_List : constant Iir_List :=
+        Get_Index_Subtype_Definition_List (Def);
+      Index_Type : Iir;
+   begin
+      Set_Base_Type (Def, Def);
+
+      for I in Natural loop
+         Index_Type := Get_Nth_Element (Index_List, I);
+         exit when Index_Type = Null_Iir;
+
+         Index_Type := Sem_Type_Mark (Index_Type);
+         Replace_Nth_Element (Index_List, I, Index_Type);
+
+         Index_Type := Get_Type (Index_Type);
+         if Get_Kind (Index_Type) not in Iir_Kinds_Discrete_Type_Definition
+         then
+            Error_Msg_Sem ("an index type of an array must be a discrete type",
+                           Index_Type);
+            --  FIXME: disp type Index_Type ?
+         end if;
+      end loop;
+
+      Set_Index_Subtype_List (Def, Index_List);
+
+      Sem_Array_Element (Def);
+      Set_Constraint_State (Def, Get_Array_Constraint (Def));
+
+      --  According to LRM93 7.4.1, an unconstrained array type is not static.
+      Set_Type_Staticness (Def, None);
+
+      return Def;
+   end Sem_Unbounded_Array_Type_Definition;
+
+   --  Return the subtype declaration corresponding to the base type of ATYPE
+   --  (for integer and real types), or the type for enumerated types.  To say
+   --  that differently, it returns the type or subtype which defines the
+   --  original range.
+   function Get_First_Subtype_Declaration (Atype : Iir) return Iir is
+      Base_Type : constant Iir := Get_Base_Type (Atype);
+      Base_Decl : constant Iir := Get_Type_Declarator (Base_Type);
+   begin
+      if Get_Kind (Base_Type) = Iir_Kind_Enumeration_Type_Definition then
+         pragma Assert (Get_Kind (Base_Decl) = Iir_Kind_Type_Declaration);
+         return Base_Decl;
+      else
+         return Get_Type_Declarator (Get_Subtype_Definition (Base_Decl));
+      end if;
+   end Get_First_Subtype_Declaration;
+
+   function Sem_Constrained_Array_Type_Definition (Def: Iir; Decl: Iir)
+                                                  return Iir
+   is
+      Index_Type : Iir;
+      Index_Name : Iir;
+      Index_List : Iir_List;
+      Base_Index_List : Iir_List;
+      El_Type : Iir;
+      Staticness : Iir_Staticness;
+
+      -- array_type_definition, which is the same as the subtype,
+      -- but without any constraint in the indexes.
+      Base_Type: Iir;
+   begin
+      --  LRM08 5.3.2.1  Array types
+      --  A constrained array definition similarly defines both an array
+      --  type and a subtype of this type.
+      --  - The array type is an implicitely declared anonymous type,
+      --    this type is defined by an (implicit) unbounded array
+      --    definition in which the element subtype indication either
+      --    denotes the base type of the subtype denoted by the element
+      --    subtype indication of the constrained array definition, if
+      --    that subtype is a composite type, or otherwise is the
+      --    element subtype indication of the constrained array
+      --    definition, and in which the type mark of each index subtype
+      --    definition denotes the subtype defined by the corresponding
+      --    discrete range.
+      --  - The array subtype is the subtype obtained by imposition of
+      --    the index constraint on the array type and if the element
+      --    subtype indication of the constrained array definition
+      --    denotes a fully or partially constrained composite subtype,
+      --    imposition of the constraint of that subtype as an array
+      --    element constraint on the array type.
+
+      -- FIXME: all indexes must be either constrained or
+      -- unconstrained.
+      -- If all indexes are unconstrained, this is really a type
+      -- otherwise, this is a subtype.
+
+      -- Create a definition for the base type of subtype DEF.
+      Base_Type := Create_Iir (Iir_Kind_Array_Type_Definition);
+      Location_Copy (Base_Type, Def);
+      Set_Base_Type (Base_Type, Base_Type);
+      Set_Type_Declarator (Base_Type, Decl);
+      Base_Index_List := Create_Iir_List;
+      Set_Index_Subtype_Definition_List (Base_Type, Base_Index_List);
+      Set_Index_Subtype_List (Base_Type, Base_Index_List);
+
+      Staticness := Locally;
+      Index_List := Get_Index_Constraint_List (Def);
+      for I in Natural loop
+         Index_Type := Get_Nth_Element (Index_List, I);
+         exit when Index_Type = Null_Iir;
+
+         Index_Name := Sem_Discrete_Range_Integer (Index_Type);
+         if Index_Name /= Null_Iir then
+            Index_Name := Range_To_Subtype_Indication (Index_Name);
+         else
+            --  Avoid errors.
+            Index_Name :=
+              Build_Simple_Name (Natural_Subtype_Declaration, Index_Type);
+            Set_Type (Index_Name, Natural_Subtype_Definition);
+         end if;
+
+         Replace_Nth_Element (Index_List, I, Index_Name);
+
+         Index_Type := Get_Index_Type (Index_Name);
+         Staticness := Min (Staticness, Get_Type_Staticness (Index_Type));
+
+         --  Set the index subtype definition for the array base type.
+         if Get_Kind (Index_Name) in Iir_Kinds_Denoting_Name then
+            Index_Type := Index_Name;
+         else
+            pragma Assert
+              (Get_Kind (Index_Name) in Iir_Kinds_Subtype_Definition);
+            Index_Type := Get_Subtype_Type_Mark (Index_Name);
+            if Index_Type = Null_Iir then
+               --  From a range expression like '1 to 4' or from an attribute
+               --  name.
+               declare
+                  Subtype_Decl : constant Iir :=
+                    Get_First_Subtype_Declaration (Index_Name);
+               begin
+                  Index_Type := Build_Simple_Name (Subtype_Decl, Index_Name);
+                  Set_Type (Index_Type, Get_Type (Subtype_Decl));
+               end;
+            end if;
+         end if;
+         Append_Element (Base_Index_List, Index_Type);
+      end loop;
+      Set_Index_Subtype_List (Def, Index_List);
+
+      -- Element type.
+      Set_Element_Subtype_Indication (Base_Type, Get_Element_Subtype (Def));
+      Sem_Array_Element (Base_Type);
+      El_Type := Get_Element_Subtype (Base_Type);
+      Set_Element_Subtype (Def, El_Type);
+
+      Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Base_Type));
+
+      --  According to LRM93 §7.4.1, an unconstrained array type
+      --  is not static.
+      Set_Type_Staticness (Base_Type, None);
+      Set_Type_Staticness (Def, Min (Staticness,
+                                     Get_Type_Staticness (El_Type)));
+
+      Set_Type_Declarator (Base_Type, Decl);
+      Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def));
+      Set_Index_Constraint_Flag (Def, True);
+      Set_Constraint_State (Def, Get_Array_Constraint (Def));
+      Set_Constraint_State (Base_Type, Get_Array_Constraint (Base_Type));
+      Set_Base_Type (Def, Base_Type);
+      Set_Subtype_Type_Mark (Def, Null_Iir);
+      return Def;
+   end Sem_Constrained_Array_Type_Definition;
+
+   function Sem_Access_Type_Definition (Def: Iir) return Iir
+   is
+      D_Type : Iir;
+   begin
+      D_Type := Sem_Subtype_Indication
+        (Get_Designated_Subtype_Indication (Def), True);
+      Set_Designated_Subtype_Indication (Def, D_Type);
+
+      D_Type := Get_Type_Of_Subtype_Indication (D_Type);
+      if D_Type /= Null_Iir then
+         case Get_Kind (D_Type) is
+            when Iir_Kind_Incomplete_Type_Definition =>
+               Append_Element (Get_Incomplete_Type_List (D_Type), Def);
+            when Iir_Kind_File_Type_Definition =>
+               --  LRM 3.3
+               --  The designated type must not be a file type.
+               Error_Msg_Sem ("designated type must not be a file type", Def);
+            when others =>
+               null;
+         end case;
+         Set_Designated_Type (Def, D_Type);
+      end if;
+      Set_Base_Type (Def, Def);
+      Set_Type_Staticness (Def, None);
+      Set_Resolved_Flag (Def, False);
+      Set_Signal_Type_Flag (Def, False);
+      return Def;
+   end Sem_Access_Type_Definition;
+
+   function Sem_File_Type_Definition (Def: Iir; Decl: Iir) return Iir
+   is
+      Type_Mark : Iir;
+   begin
+      Type_Mark := Sem_Type_Mark (Get_File_Type_Mark (Def));
+      Set_File_Type_Mark (Def, Type_Mark);
+
+      Type_Mark := Get_Type (Type_Mark);
+
+      if Get_Kind (Type_Mark) = Iir_Kind_Error then
+         null;
+      elsif Get_Signal_Type_Flag (Type_Mark) = False then
+         --  LRM 3.4
+         --  The base type of this subtype must not be a file type
+         --  or an access type.
+         --  If the base type is a composite type, it must not
+         --  contain a subelement of an access type.
+         Error_Msg_Sem
+           (Disp_Node (Type_Mark) & " cannot be a file type", Def);
+      elsif Get_Kind (Type_Mark) in Iir_Kinds_Array_Type_Definition then
+         --  LRM 3.4
+         --  If the base type is an array type, it must be a one
+         --  dimensional array type.
+         if not Is_One_Dimensional_Array_Type (Type_Mark) then
+            Error_Msg_Sem
+              ("multi-dimensional " & Disp_Node (Type_Mark)
+                 & " cannot be a file type", Def);
+         end if;
+      end if;
+
+      Set_Base_Type (Def, Def);
+      Set_Resolved_Flag (Def, False);
+      Set_Text_File_Flag (Def, Is_Text_Type_Declaration (Decl));
+      Set_Signal_Type_Flag (Def, False);
+      Set_Type_Staticness (Def, None);
+      return Def;
+   end Sem_File_Type_Definition;
+
+   function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            return Sem_Enumeration_Type_Definition (Def, Decl);
+
+         when Iir_Kind_Range_Expression =>
+            if Get_Type (Def) /= Null_Iir then
+               return Sem_Physical_Type_Definition (Def, Decl);
+            else
+               return Range_Expr_To_Type_Definition (Def, Decl);
+            end if;
+
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Parenthesis_Name =>
+            if Get_Type (Def) /= Null_Iir then
+               return Sem_Physical_Type_Definition (Def, Decl);
+            end if;
+            --  Nb: the attribute is expected to be a 'range or
+            --  a 'reverse_range attribute.
+            declare
+               Res : Iir;
+            begin
+               Res := Sem_Discrete_Range_Expression (Def, Null_Iir, True);
+               if Res = Null_Iir then
+                  return Null_Iir;
+               end if;
+               --  This cannot be a floating range.
+               return Create_Integer_Type (Def, Res, Decl);
+            end;
+
+         when Iir_Kind_Array_Subtype_Definition =>
+            return Sem_Constrained_Array_Type_Definition (Def, Decl);
+
+         when Iir_Kind_Array_Type_Definition =>
+            return Sem_Unbounded_Array_Type_Definition (Def);
+
+         when Iir_Kind_Record_Type_Definition =>
+            return Sem_Record_Type_Definition (Def);
+
+         when Iir_Kind_Access_Type_Definition =>
+            return Sem_Access_Type_Definition (Def);
+
+         when Iir_Kind_File_Type_Definition =>
+            return Sem_File_Type_Definition (Def, Decl);
+
+         when Iir_Kind_Protected_Type_Declaration =>
+            Sem_Protected_Type_Declaration (Decl);
+            return Def;
+
+         when others =>
+            Error_Kind ("sem_type_definition", Def);
+            return Def;
+      end case;
+   end Sem_Type_Definition;
+
+   function Range_To_Subtype_Indication (A_Range: Iir) return Iir
+   is
+      Sub_Type: Iir;
+      Range_Type : Iir;
+   begin
+      case Get_Kind (A_Range) is
+         when Iir_Kind_Range_Expression
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            --  Create a sub type.
+            Range_Type := Get_Type (A_Range);
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return A_Range;
+         when Iir_Kinds_Discrete_Type_Definition =>
+            --  A_RANGE is already a subtype definition.
+            return A_Range;
+         when others =>
+            Error_Kind ("range_to_subtype_indication", A_Range);
+            return Null_Iir;
+      end case;
+
+      case Get_Kind (Range_Type) is
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            Sub_Type := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            Sub_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition =>
+            Sub_Type := Create_Iir (Iir_Kind_Floating_Subtype_Definition);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Location_Copy (Sub_Type, A_Range);
+      Set_Range_Constraint (Sub_Type, A_Range);
+      Set_Base_Type (Sub_Type, Get_Base_Type (Range_Type));
+      Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (A_Range));
+      Set_Signal_Type_Flag (Sub_Type, True);
+      return Sub_Type;
+   end Range_To_Subtype_Indication;
+
+   -- Return TRUE iff FUNC is a resolution function for ATYPE.
+   function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean
+   is
+      Decl: Iir;
+      Decl_Type : Iir;
+      Ret_Type : Iir;
+   begin
+      -- LRM93 2.4
+      --  A resolution function must be a [pure] function;
+      if Get_Kind (Func) not in Iir_Kinds_Function_Declaration then
+         return False;
+      end if;
+      Decl := Get_Interface_Declaration_Chain (Func);
+      -- LRM93 2.4
+      --  moreover, it must have a single input parameter of class constant
+      if Decl = Null_Iir or else Get_Chain (Decl) /= Null_Iir then
+         return False;
+      end if;
+      if Get_Kind (Decl) /= Iir_Kind_Interface_Constant_Declaration then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  that is a one-dimensional, unconstrained array
+      Decl_Type := Get_Type (Decl);
+      if Get_Kind (Decl_Type) /= Iir_Kind_Array_Type_Definition then
+         return False;
+      end if;
+      if not Is_One_Dimensional_Array_Type (Decl_Type) then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  whose element type is that of the resolved signal.
+      --  The type of the return value of the function must also be that of
+      --  the signal.
+      Ret_Type := Get_Return_Type (Func);
+      if Get_Base_Type (Get_Element_Subtype (Decl_Type))
+        /= Get_Base_Type (Ret_Type)
+      then
+         return False;
+      end if;
+      if Atype /= Null_Iir
+        and then Get_Base_Type (Ret_Type) /= Get_Base_Type (Atype)
+      then
+         return False;
+      end if;
+      -- LRM93 2.4
+      --  A resolution function must be a [pure] function;
+      if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then
+         if Atype /= Null_Iir then
+            Error_Msg_Sem
+              ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+         end if;
+         return False;
+      end if;
+      return True;
+   end Is_A_Resolution_Function;
+
+   --  Note: this sets resolved_flag.
+   procedure Sem_Resolution_Function (Name : Iir; Atype : Iir)
+   is
+      Func : Iir;
+      Res: Iir;
+      El : Iir;
+      List : Iir_List;
+      Has_Error : Boolean;
+      Name1 : Iir;
+   begin
+      Sem_Name (Name);
+
+      Func := Get_Named_Entity (Name);
+      if Func = Error_Mark then
+         return;
+      end if;
+
+      Res := Null_Iir;
+
+      if Is_Overload_List (Func) then
+         List := Get_Overload_List (Func);
+         Has_Error := False;
+         for I in Natural loop
+            El := Get_Nth_Element (List, I);
+            exit when El = Null_Iir;
+            if Is_A_Resolution_Function (El, Atype) then
+               if Res /= Null_Iir then
+                  if not Has_Error then
+                     Has_Error := True;
+                     Error_Msg_Sem
+                       ("can't resolve overload for resolution function",
+                        Atype);
+                     Error_Msg_Sem ("candidate functions are:", Atype);
+                     Error_Msg_Sem (" " & Disp_Subprg (Func), Func);
+                  end if;
+                  Error_Msg_Sem (" " & Disp_Subprg (El), El);
+               else
+                  Res := El;
+               end if;
+            end if;
+         end loop;
+         Free_Overload_List (Func);
+         if Has_Error then
+            return;
+         end if;
+         Set_Named_Entity (Name, Res);
+      else
+         if Is_A_Resolution_Function (Func, Atype) then
+            Res := Func;
+         end if;
+      end if;
+
+      if Res = Null_Iir then
+         Error_Msg_Sem ("no matching resolution function for "
+                        & Disp_Node (Name), Atype);
+      else
+         Name1 := Finish_Sem_Name (Name);
+         Mark_Subprogram_Used (Res);
+         Set_Resolved_Flag (Atype, True);
+         Set_Resolution_Indication (Atype, Name1);
+      end if;
+   end Sem_Resolution_Function;
+
+   --  Analyze the constraint DEF + RESOLUTION for type TYPE_MARK.  The
+   --  result is always a subtype definition.
+   function Sem_Subtype_Constraint
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
+     return Iir;
+
+   --  DEF is an incomplete subtype_indication or array_constraint,
+   --  TYPE_MARK is the base type of the subtype_indication.
+   function Sem_Array_Constraint
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
+     return Iir
+   is
+      El_Type : constant Iir := Get_Element_Subtype (Type_Mark);
+      Res : Iir;
+      Type_Index, Subtype_Index: Iir;
+      Base_Type : Iir;
+      El_Def : Iir;
+      Staticness : Iir_Staticness;
+      Error_Seen : Boolean;
+      Type_Index_List : Iir_List;
+      Subtype_Index_List : Iir_List;
+      Resolv_Func : Iir := Null_Iir;
+      Resolv_El : Iir := Null_Iir;
+      Resolv_Ind : Iir;
+   begin
+      if Resolution /= Null_Iir then
+         --  A resolution indication is present.
+         case Get_Kind (Resolution) is
+            when Iir_Kinds_Denoting_Name =>
+               Resolv_Func := Resolution;
+            when Iir_Kind_Array_Element_Resolution =>
+               Resolv_El := Get_Resolution_Indication (Resolution);
+            when Iir_Kind_Record_Resolution =>
+               Error_Msg_Sem
+                 ("record resolution not allowed for array subtype",
+                  Resolution);
+            when others =>
+               Error_Kind ("sem_array_constraint(resolution)", Resolution);
+         end case;
+      end if;
+
+      if Def = Null_Iir then
+         --  There is no element_constraint.
+         pragma Assert (Resolution /= Null_Iir);
+         Res := Copy_Subtype_Indication (Type_Mark);
+      else
+         case Get_Kind (Def) is
+            when Iir_Kind_Subtype_Definition =>
+               -- This is the case of "subtype new_array is [func] old_array".
+               -- def must be a constrained array.
+               if Get_Range_Constraint (Def) /= Null_Iir then
+                  Error_Msg_Sem
+                    ("cannot use a range constraint for array types", Def);
+                  return Copy_Subtype_Indication (Type_Mark);
+               end if;
+
+               --  LRM08 6.3 Subtype declarations
+               --
+               --  If the subtype indication does not include a constraint, the
+               --  subtype is the same as that denoted by the type mark.
+               if Resolution = Null_Iir then
+                  --  FIXME: is it reachable ?
+                  Free_Name (Def);
+                  return Type_Mark;
+               end if;
+
+               Res := Copy_Subtype_Indication (Type_Mark);
+               Location_Copy (Res, Def);
+               Free_Name (Def);
+
+               --  No element constraint.
+               El_Def := Null_Iir;
+
+            when Iir_Kind_Array_Subtype_Definition =>
+               -- Case of a constraint for an array.
+               -- Check each index constraint against array type.
+
+               Base_Type := Get_Base_Type (Type_Mark);
+               Set_Base_Type (Def, Base_Type);
+               El_Def := Get_Element_Subtype (Def);
+
+               Staticness := Get_Type_Staticness (El_Type);
+               Error_Seen := False;
+               Type_Index_List :=
+                 Get_Index_Subtype_Definition_List (Base_Type);
+               Subtype_Index_List := Get_Index_Constraint_List (Def);
+
+               --  LRM08 5.3.2.2
+               --  If an array constraint of the first form (including an index
+               --  constraint) applies to a type or subtype, then the type or
+               --  subtype shall be an unconstrained or partially constrained
+               --  array type with no index constraint applying to the index
+               --  subtypes, or an access type whose designated type is such
+               --  a type.
+               if Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition
+                 and then Get_Index_Constraint_Flag (Type_Mark)
+               then
+                  Error_Msg_Sem ("constrained array cannot be re-constrained",
+                                 Def);
+               end if;
+               if Subtype_Index_List = Null_Iir_List then
+                  --  Array is not constrained.
+                  Set_Index_Constraint_Flag (Def, False);
+                  Set_Index_Subtype_List (Def, Type_Index_List);
+               else
+                  for I in Natural loop
+                     Type_Index := Get_Nth_Element (Type_Index_List, I);
+                     Subtype_Index := Get_Nth_Element (Subtype_Index_List, I);
+                     exit when Type_Index = Null_Iir
+                       and Subtype_Index = Null_Iir;
+
+                     if Type_Index = Null_Iir then
+                        Error_Msg_Sem
+                          ("subtype has more indexes than "
+                             & Disp_Node (Type_Mark)
+                             & " defined at " & Disp_Location (Type_Mark),
+                           Subtype_Index);
+                        --  Forget extra indexes.
+                        Set_Nbr_Elements (Subtype_Index_List, I);
+                        exit;
+                     end if;
+                     if Subtype_Index = Null_Iir then
+                        if not Error_Seen then
+                           Error_Msg_Sem
+                             ("subtype has less indexes than "
+                                & Disp_Node (Type_Mark)
+                                & " defined at "
+                                & Disp_Location (Type_Mark), Def);
+                           Error_Seen := True;
+                        end if;
+                     else
+                        Subtype_Index := Sem_Discrete_Range_Expression
+                          (Subtype_Index, Get_Index_Type (Type_Index), True);
+                        if Subtype_Index /= Null_Iir then
+                           Subtype_Index :=
+                             Range_To_Subtype_Indication (Subtype_Index);
+                           Staticness := Min
+                             (Staticness,
+                              Get_Type_Staticness
+                                (Get_Type_Of_Subtype_Indication
+                                   (Subtype_Index)));
+                        end if;
+                     end if;
+                     if Subtype_Index = Null_Iir then
+                        --  Create a fake subtype from type_index.
+                        --  FIXME: It is too fake.
+                        Subtype_Index := Type_Index;
+                        Staticness := None;
+                     end if;
+                     if Error_Seen then
+                        Append_Element (Subtype_Index_List, Subtype_Index);
+                     else
+                        Replace_Nth_Element
+                          (Subtype_Index_List, I, Subtype_Index);
+                     end if;
+                  end loop;
+                  Set_Index_Subtype_List (Def, Subtype_Index_List);
+                  Set_Index_Constraint_Flag (Def, True);
+               end if;
+               Set_Type_Staticness (Def, Staticness);
+               Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark));
+               Res := Def;
+
+            when others =>
+               --  LRM93 3.2.1.1 / LRM08 5.3.2.2
+               --  Index Constraints and Discrete Ranges
+               --
+               --  If an index constraint appears after a type mark [...]
+               --  The type mark must denote either an unconstrained array
+               --  type, or an access type whose designated type is such
+               --  an array type.
+               Error_Msg_Sem
+                 ("only unconstrained array type may be contrained "
+                    &"by index", Def);
+               Error_Msg_Sem
+                 (" (type mark is " & Disp_Node (Type_Mark) & ")",
+                  Type_Mark);
+               return Type_Mark;
+         end case;
+      end if;
+
+      --  Element subtype.
+      if Resolv_El /= Null_Iir or else El_Def /= Null_Iir then
+         El_Def := Sem_Subtype_Constraint (El_Def, El_Type, Resolv_El);
+      end if;
+      if El_Def = Null_Iir then
+         El_Def := Get_Element_Subtype (Type_Mark);
+      end if;
+      Set_Element_Subtype (Res, El_Def);
+
+      Set_Constraint_State (Res, Get_Array_Constraint (Res));
+
+      if Resolv_Func /= Null_Iir then
+         Sem_Resolution_Function (Resolv_Func, Res);
+      elsif Resolv_El /= Null_Iir then
+         Set_Resolution_Indication (Res, Resolution);
+         --  FIXME: may a resolution indication for a record be incomplete ?
+         Set_Resolved_Flag (Res, Get_Resolved_Flag (El_Def));
+      elsif Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition then
+         Resolv_Ind := Get_Resolution_Indication (Type_Mark);
+         if Resolv_Ind /= Null_Iir then
+            case Get_Kind (Resolv_Ind) is
+               when Iir_Kinds_Denoting_Name =>
+                  Error_Kind ("sem_array_constraint(resolution)", Resolv_Ind);
+               when Iir_Kind_Array_Element_Resolution =>
+                  --  Already applied to the element.
+                  Resolv_Ind := Null_Iir;
+               when others =>
+                  Error_Kind ("sem_array_constraint(resolution2)", Resolv_Ind);
+            end case;
+            Set_Resolution_Indication (Res, Resolv_Ind);
+         end if;
+         Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark));
+      end if;
+
+      return Res;
+   end Sem_Array_Constraint;
+
+   function Reparse_As_Record_Element_Constraint (Name : Iir) return Iir
+   is
+      Prefix : Iir;
+      Parent : Iir;
+      El : Iir;
+   begin
+      if Get_Kind (Name) /= Iir_Kind_Parenthesis_Name then
+         Error_Msg_Sem ("record element constraint expected", Name);
+         return Null_Iir;
+      else
+         Prefix := Get_Prefix (Name);
+         Parent := Name;
+         while Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name loop
+            Parent := Prefix;
+            Prefix := Get_Prefix (Prefix);
+         end loop;
+         if Get_Kind (Prefix) /= Iir_Kind_Simple_Name then
+            Error_Msg_Sem ("record element name must be a simple name",
+                           Prefix);
+            return Null_Iir;
+         else
+            El := Create_Iir (Iir_Kind_Record_Element_Constraint);
+            Location_Copy (El, Prefix);
+            Set_Identifier (El, Get_Identifier (Prefix));
+            Set_Type (El, Name);
+            Set_Prefix (Parent, Null_Iir);
+            Free_Name (Prefix);
+            return El;
+         end if;
+      end if;
+   end Reparse_As_Record_Element_Constraint;
+
+   function Reparse_As_Record_Constraint (Def : Iir) return Iir
+   is
+      Res : Iir;
+      Chain : Iir;
+      El_List : Iir_List;
+      El : Iir;
+   begin
+      if Get_Prefix (Def) /= Null_Iir then
+         raise Internal_Error;
+      end if;
+      Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+      Location_Copy (Res, Def);
+      El_List := Create_Iir_List;
+      Set_Elements_Declaration_List (Res, El_List);
+      Chain := Get_Association_Chain (Def);
+      while Chain /= Null_Iir loop
+         if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression
+           or else Get_Formal (Chain) /= Null_Iir
+         then
+            Error_Msg_Sem ("badly formed record constraint", Chain);
+         else
+            El := Reparse_As_Record_Element_Constraint (Get_Actual (Chain));
+            if El /= Null_Iir then
+               Append_Element (El_List, El);
+            end if;
+         end if;
+         Chain := Get_Chain (Chain);
+      end loop;
+      return Res;
+   end Reparse_As_Record_Constraint;
+
+   function Reparse_As_Array_Constraint (Def : Iir; Def_Type : Iir) return Iir
+   is
+      Parent : Iir;
+      Name : Iir;
+      Prefix : Iir;
+      Res : Iir;
+      Chain : Iir;
+      El_List : Iir_List;
+      Def_El_Type : Iir;
+   begin
+      Name := Def;
+      Prefix := Get_Prefix (Name);
+      Parent := Null_Iir;
+      while Prefix /= Null_Iir
+        and then Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name
+      loop
+         Parent := Name;
+         Name := Prefix;
+         Prefix := Get_Prefix (Name);
+      end loop;
+      --  Detach prefix.
+      if Parent /= Null_Iir then
+         Set_Prefix (Parent, Null_Iir);
+      end if;
+      Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      Location_Copy (Res, Name);
+      Chain := Get_Association_Chain (Name);
+      if Get_Kind (Chain) = Iir_Kind_Association_Element_Open then
+         if Get_Chain (Chain) /= Null_Iir then
+            Error_Msg_Sem ("'open' must be alone", Chain);
+         end if;
+      else
+         El_List := Create_Iir_List;
+         Set_Index_Constraint_List (Res, El_List);
+         while Chain /= Null_Iir loop
+            if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression
+              or else Get_Formal (Chain) /= Null_Iir
+            then
+               Error_Msg_Sem ("bad form of array constraint", Chain);
+            else
+               Append_Element (El_List, Get_Actual (Chain));
+            end if;
+            Chain := Get_Chain (Chain);
+         end loop;
+      end if;
+
+      Def_El_Type := Get_Element_Subtype (Def_Type);
+      if Parent /= Null_Iir then
+         case Get_Kind (Def_El_Type) is
+            when Iir_Kinds_Array_Type_Definition =>
+               Set_Element_Subtype_Indication
+                 (Res, Reparse_As_Array_Constraint (Def, Def_El_Type));
+            when others =>
+               Error_Kind ("reparse_as_array_constraint", Def_El_Type);
+         end case;
+      end if;
+      return Res;
+   end Reparse_As_Array_Constraint;
+
+   function Sem_Record_Constraint
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
+     return Iir
+   is
+      Res : Iir;
+      El_List, Tm_El_List : Iir_List;
+      El : Iir;
+      Tm_El : Iir;
+      Tm_El_Type : Iir;
+      El_Type : Iir;
+      Res_List : Iir_List;
+
+      Index_List : Iir_List;
+      Index_El : Iir;
+   begin
+      Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+      Location_Copy (Res, Def);
+      Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+      Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark));
+      if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then
+         Set_Resolution_Indication
+           (Res, Get_Resolution_Indication (Type_Mark));
+      end if;
+
+      case Get_Kind (Def) is
+         when Iir_Kind_Subtype_Definition =>
+            Free_Name (Def);
+            Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+            Set_Constraint_State (Res, Get_Constraint_State (Type_Mark));
+            El_List := Null_Iir_List;
+
+         when Iir_Kind_Array_Subtype_Definition =>
+            --  Record constraints are parsed as array constraints.
+            if Get_Kind (Def) /= Iir_Kind_Array_Subtype_Definition then
+               raise Internal_Error;
+            end if;
+            Index_List := Get_Index_Constraint_List (Def);
+            El_List := Create_Iir_List;
+            Set_Elements_Declaration_List (Res, El_List);
+            for I in Natural loop
+               Index_El := Get_Nth_Element (Index_List, I);
+               exit when Index_El = Null_Iir;
+               El := Reparse_As_Record_Element_Constraint (Index_El);
+               if El /= Null_Iir then
+                  Append_Element (El_List, El);
+               end if;
+            end loop;
+
+         when Iir_Kind_Record_Subtype_Definition =>
+            El_List := Get_Elements_Declaration_List (Def);
+            Set_Elements_Declaration_List (Res, El_List);
+
+         when others =>
+            Error_Kind ("sem_record_constraint", Def);
+      end case;
+
+      Res_List := Null_Iir_List;
+      if Resolution /= Null_Iir then
+         case Get_Kind (Resolution) is
+            when Iir_Kinds_Denoting_Name =>
+               null;
+            when Iir_Kind_Record_Subtype_Definition =>
+               Res_List := Get_Elements_Declaration_List (Resolution);
+            when Iir_Kind_Array_Subtype_Definition =>
+               Error_Msg_Sem
+                 ("resolution indication must be an array element resolution",
+                  Resolution);
+            when others =>
+               Error_Kind ("sem_record_constraint(resolution)", Resolution);
+         end case;
+      end if;
+
+      Tm_El_List := Get_Elements_Declaration_List (Type_Mark);
+      if El_List /= Null_Iir_List or Res_List /= Null_Iir_List then
+         declare
+            Nbr_Els : constant Natural := Get_Nbr_Elements (Tm_El_List);
+            Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir);
+            Res_Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir);
+            Pos : Natural;
+            Constraint : Iir_Constraint;
+         begin
+            --  Fill ELS.
+            if El_List /= Null_Iir_List then
+               for I in Natural loop
+                  El := Get_Nth_Element (El_List, I);
+                  exit when El = Null_Iir;
+                  Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El));
+                  if Tm_El = Null_Iir then
+                     Error_Msg_Sem (Disp_Node (Type_Mark)
+                                      & "has no " & Disp_Node (El), El);
+                  else
+                     Set_Element_Declaration (El, Tm_El);
+                     Pos := Natural (Get_Element_Position (Tm_El));
+                     if Els (Pos) /= Null_Iir then
+                        Error_Msg_Sem
+                          (Disp_Node (El) & " was already constrained", El);
+                        Error_Msg_Sem
+                          (" (location of previous constrained)", Els (Pos));
+                     else
+                        Els (Pos) := El;
+                        Set_Parent (El, Res);
+                     end if;
+                     El_Type := Get_Type (El);
+                     Tm_El_Type := Get_Type (Tm_El);
+                     if Get_Kind (El_Type) = Iir_Kind_Parenthesis_Name then
+                        case Get_Kind (Tm_El_Type) is
+                           when Iir_Kinds_Array_Type_Definition =>
+                              El_Type := Reparse_As_Array_Constraint
+                                (El_Type, Tm_El_Type);
+                           when Iir_Kind_Record_Type_Definition
+                             | Iir_Kind_Record_Subtype_Definition =>
+                              El_Type := Reparse_As_Record_Constraint
+                                (El_Type);
+                           when others =>
+                              Error_Msg_Sem
+                                ("only composite types may be constrained",
+                                 El_Type);
+                        end case;
+                     end if;
+                     Set_Type (El, El_Type);
+                  end if;
+               end loop;
+               Destroy_Iir_List (El_List);
+            end if;
+
+            --  Fill Res_Els.
+            if Res_List /= Null_Iir_List then
+               for I in Natural loop
+                  El := Get_Nth_Element (Res_List, I);
+                  exit when El = Null_Iir;
+                  Tm_El := Find_Name_In_List (Tm_El_List, Get_Identifier (El));
+                  if Tm_El = Null_Iir then
+                     Error_Msg_Sem (Disp_Node (Type_Mark)
+                                      & "has no " & Disp_Node (El), El);
+                  else
+                     Pos := Natural (Get_Element_Position (Tm_El));
+                     if Res_Els (Pos) /= Null_Iir then
+                        Error_Msg_Sem
+                          (Disp_Node (El) & " was already resolved", El);
+                        Error_Msg_Sem
+                          (" (location of previous constrained)", Els (Pos));
+                     else
+                        Res_Els (Pos) := Get_Element_Declaration (El);
+                     end if;
+                  end if;
+                  --Free_Iir (El);
+               end loop;
+               Destroy_Iir_List (Res_List);
+            end if;
+
+            --  Build elements list.
+            El_List := Create_Iir_List;
+            Set_Elements_Declaration_List (Res, El_List);
+            Constraint := Fully_Constrained;
+            for I in Els'Range loop
+               Tm_El := Get_Nth_Element (Tm_El_List, I);
+               if Els (I) = Null_Iir and Res_Els (I) = Null_Iir then
+                  El := Tm_El;
+               else
+                  if Els (I) = Null_Iir then
+                     El := Create_Iir (Iir_Kind_Record_Element_Constraint);
+                     Location_Copy (El, Tm_El);
+                     Set_Element_Declaration (El, Tm_El);
+                     Set_Element_Position (El, Get_Element_Position (Tm_El));
+                     El_Type := Null_Iir;
+                  else
+                     El := Els (I);
+                     El_Type := Get_Type (El);
+                  end if;
+                  El_Type := Sem_Subtype_Constraint (El_Type,
+                                                     Get_Type (Tm_El),
+                                                     Res_Els (I));
+                  Set_Type (El, El_Type);
+               end if;
+               Append_Element (El_List, El);
+               Constraint := Update_Record_Constraint
+                 (Constraint, Get_Type (El));
+            end loop;
+            Set_Constraint_State (Res, Constraint);
+         end;
+      else
+         Set_Elements_Declaration_List (Res, Tm_El_List);
+         Set_Constraint_State (Res, Get_Constraint_State (Type_Mark));
+      end if;
+
+      Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+
+      if Resolution /= Null_Iir
+        and then Get_Kind (Resolution) in Iir_Kinds_Denoting_Name
+      then
+         Sem_Resolution_Function (Resolution, Res);
+      end if;
+
+      return Res;
+   end Sem_Record_Constraint;
+
+   --  Return a scalar subtype definition (even in case of error).
+   function Sem_Range_Constraint
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
+     return Iir
+   is
+      Res : Iir;
+      A_Range : Iir;
+      Tolerance : Iir;
+   begin
+      if Def = Null_Iir then
+         Res := Copy_Subtype_Indication (Type_Mark);
+      elsif Get_Kind (Def) /= Iir_Kind_Subtype_Definition then
+         --  FIXME: find the correct sentence from LRM
+         --  GHDL: subtype_definition may also be used just to add
+         --    a resolution function.
+         Error_Msg_Sem ("only scalar types may be constrained by range", Def);
+         Error_Msg_Sem (" (type mark is " & Disp_Node (Type_Mark) & ")",
+                        Type_Mark);
+         Res := Copy_Subtype_Indication (Type_Mark);
+      else
+         Tolerance := Get_Tolerance (Def);
+
+         if Get_Range_Constraint (Def) = Null_Iir
+           and then Resolution = Null_Iir
+           and then Tolerance = Null_Iir
+         then
+            --  This defines an alias, and must have been handled just
+            --  before the case statment.
+            raise Internal_Error;
+         end if;
+
+         -- There are limits.  Create a new subtype.
+         if Get_Kind (Type_Mark) = Iir_Kind_Enumeration_Type_Definition then
+            Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+         else
+            Res := Create_Iir (Get_Kind (Type_Mark));
+         end if;
+         Location_Copy (Res, Def);
+         Set_Base_Type (Res, Get_Base_Type (Type_Mark));
+         Set_Resolution_Indication (Res, Get_Resolution_Indication (Def));
+         A_Range := Get_Range_Constraint (Def);
+         if A_Range = Null_Iir then
+            A_Range := Get_Range_Constraint (Type_Mark);
+         else
+            A_Range := Sem_Range_Expression (A_Range, Type_Mark, True);
+            if A_Range = Null_Iir then
+               --  Avoid error propagation.
+               A_Range := Get_Range_Constraint (Type_Mark);
+            end if;
+         end if;
+         Set_Range_Constraint (Res, A_Range);
+         Set_Type_Staticness (Res, Get_Expr_Staticness (A_Range));
+         Free_Name (Def);
+         Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark));
+         if Tolerance /= Null_Iir then
+            --  LRM93 4.2 Subtype declarations
+            --  It is an error in this case the subtype is not a nature
+            --  type
+            --
+            --  FIXME: should be moved into sem_subtype_indication
+            if Get_Kind (Res) /= Iir_Kind_Floating_Subtype_Definition then
+               Error_Msg_Sem ("tolerance allowed only for floating subtype",
+                              Tolerance);
+            else
+               --  LRM93 4.2 Subtype declarations
+               --  If the subtype indication includes a tolerance aspect, then
+               --  the string expression must be a static expression
+               Tolerance := Sem_Expression (Tolerance, String_Type_Definition);
+               if Tolerance /= Null_Iir
+                 and then Get_Expr_Staticness (Tolerance) /= Locally
+               then
+                  Error_Msg_Sem ("tolerance must be a static string",
+                                 Tolerance);
+               end if;
+               Set_Tolerance (Res, Tolerance);
+            end if;
+         end if;
+      end if;
+
+      if Resolution /= Null_Iir then
+         --  LRM08 6.3  Subtype declarations.
+         if Get_Kind (Resolution) not in Iir_Kinds_Denoting_Name then
+            Error_Msg_Sem ("resolution indication must be a function name",
+                           Resolution);
+         else
+            Sem_Resolution_Function (Resolution, Res);
+         end if;
+      end if;
+      return Res;
+   end Sem_Range_Constraint;
+
+   function Sem_Subtype_Constraint
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
+     return Iir is
+   begin
+      case Get_Kind (Type_Mark) is
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            return Sem_Array_Constraint (Def, Type_Mark, Resolution);
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition=>
+            return Sem_Range_Constraint (Def, Type_Mark, Resolution);
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            return Sem_Record_Constraint (Def, Type_Mark, Resolution);
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            --  LRM93 4.2
+            --  A subtype indication denoting an access type [or a file type]
+            --  may not contain a resolution function.
+            if Resolution /= Null_Iir then
+               Error_Msg_Sem
+                 ("resolution function not allowed for an access type", Def);
+            end if;
+
+            case Get_Kind (Def) is
+               when Iir_Kind_Subtype_Definition =>
+                  Free_Name (Def);
+                  return Copy_Subtype_Indication (Type_Mark);
+               when Iir_Kind_Array_Subtype_Definition =>
+                  --  LRM93 3.3
+                  --  The only form of constraint that is allowed after a name
+                  --  of an access type in a subtype indication is an index
+                  --  constraint.
+                  declare
+                     Sub_Type : Iir;
+                     Base_Type : Iir;
+                     Res : Iir;
+                  begin
+                     Base_Type := Get_Designated_Type (Type_Mark);
+                     Sub_Type := Sem_Array_Constraint
+                       (Def, Base_Type, Null_Iir);
+                     Res := Create_Iir (Iir_Kind_Access_Subtype_Definition);
+                     Location_Copy (Res, Def);
+                     Set_Base_Type (Res, Type_Mark);
+                     Set_Designated_Subtype_Indication (Res, Sub_Type);
+                     Set_Signal_Type_Flag (Res, False);
+                     return Res;
+                  end;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Kind_File_Type_Definition =>
+            --  LRM08 6.3 Subtype declarations
+            --  A subtype indication denoting a subtype of [...] a file
+            --  type [...] shall not contain a constraint.
+            if Get_Kind (Def) /= Iir_Kind_Subtype_Definition
+              or else Get_Range_Constraint (Def) /= Null_Iir
+            then
+               Error_Msg_Sem ("file types can't be constrained", Def);
+               return Type_Mark;
+            end if;
+
+            --  LRM93 4.2
+            --  A subtype indication denoting [an access type or] a file type
+            --  may not contain a resolution function.
+            if Resolution /= Null_Iir then
+               Error_Msg_Sem
+                 ("resolution function not allowed for file types", Def);
+               return Type_Mark;
+            end if;
+            Free_Name (Def);
+            return Type_Mark;
+
+         when Iir_Kind_Protected_Type_Declaration =>
+            --  LRM08 6.3 Subtype declarations
+            --  A subtype indication denoting a subtype of [...] a protected
+            --  type [...] shall not contain a constraint.
+            if Get_Kind (Def) /= Iir_Kind_Subtype_Definition
+              or else Get_Range_Constraint (Def) /= Null_Iir
+            then
+               Error_Msg_Sem ("protected types can't be constrained", Def);
+               return Type_Mark;
+            end if;
+
+            --  LRM08 6.3 Subtype declarations
+            --  A subtype indication denoting [...] a protected type shall
+            --  not contain a resolution function.
+            if Resolution /= Null_Iir then
+               Error_Msg_Sem
+                 ("resolution function not allowed for file types", Def);
+               return Type_Mark;
+            end if;
+            Free_Name (Def);
+            return Type_Mark;
+
+         when others =>
+            Error_Kind ("sem_subtype_constraint", Type_Mark);
+            return Type_Mark;
+      end case;
+   end Sem_Subtype_Constraint;
+
+   function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False)
+                                   return Iir
+   is
+      Type_Mark_Name : Iir;
+      Type_Mark: Iir;
+      Res : Iir;
+   begin
+      --  LRM08 6.3 Subtype declarations
+      --
+      --  If the subtype indication does not include a constraint, the subtype
+      --  is the same as that denoted by the type mark.
+      if Get_Kind (Def) in Iir_Kinds_Denoting_Name then
+         Type_Mark := Sem_Type_Mark (Def, Incomplete);
+         return Type_Mark;
+      end if;
+
+      --  Semantize the type mark.
+      Type_Mark_Name := Get_Subtype_Type_Mark (Def);
+      Type_Mark_Name := Sem_Type_Mark (Type_Mark_Name);
+      Set_Subtype_Type_Mark (Def, Type_Mark_Name);
+      Type_Mark := Get_Type (Type_Mark_Name);
+      --  FIXME: incomplete type ?
+      if Get_Kind (Type_Mark) = Iir_Kind_Error then
+         --  FIXME: handle inversion such as "subtype BASETYPE RESOLV", which
+         --  should emit "resolution function must precede type name".
+
+         --  Discard the subtype definition and only keep the type mark.
+         return Type_Mark_Name;
+      end if;
+
+      Res := Sem_Subtype_Constraint
+        (Def, Type_Mark, Get_Resolution_Indication (Def));
+      Set_Subtype_Type_Mark (Res, Type_Mark_Name);
+      return Res;
+   end Sem_Subtype_Indication;
+
+   function Copy_Subtype_Indication (Def : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            Res := Create_Iir (Get_Kind (Def));
+            Set_Range_Constraint (Res, Get_Range_Constraint (Def));
+            Set_Resolution_Indication
+              (Res, Get_Resolution_Indication (Def));
+         when Iir_Kind_Enumeration_Type_Definition =>
+            Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+            Set_Range_Constraint (Res, Get_Range_Constraint (Def));
+
+         when Iir_Kind_Access_Subtype_Definition
+           | Iir_Kind_Access_Type_Definition =>
+            Res := Create_Iir (Iir_Kind_Access_Subtype_Definition);
+            Set_Designated_Type (Res, Get_Designated_Type (Def));
+
+         when Iir_Kind_Array_Type_Definition =>
+            Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+            Set_Type_Staticness (Res, Get_Type_Staticness (Def));
+            Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+            Set_Index_Constraint_List (Res, Null_Iir_List);
+            Set_Index_Subtype_List
+              (Res, Get_Index_Subtype_Definition_List (Def));
+            Set_Element_Subtype (Res, Get_Element_Subtype (Def));
+            Set_Index_Constraint_Flag (Res, False);
+            Set_Constraint_State (Res, Get_Constraint_State (Def));
+         when Iir_Kind_Array_Subtype_Definition =>
+            Res := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+            Set_Resolution_Indication (Res, Get_Resolution_Indication (Def));
+            Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+            Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def));
+            Set_Element_Subtype (Res, Get_Element_Subtype (Def));
+            Set_Index_Constraint_Flag
+              (Res, Get_Index_Constraint_Flag (Def));
+            Set_Constraint_State (Res, Get_Constraint_State (Def));
+
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            Res := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+            Set_Type_Staticness (Res, Get_Type_Staticness (Def));
+            if Get_Kind (Def) = Iir_Kind_Record_Subtype_Definition then
+               Set_Resolution_Indication
+                 (Res, Get_Resolution_Indication (Def));
+            end if;
+            Set_Resolved_Flag (Res, Get_Resolved_Flag (Def));
+            Set_Constraint_State (Res, Get_Constraint_State (Def));
+            Set_Elements_Declaration_List
+              (Res, Get_Elements_Declaration_List (Def));
+         when others =>
+            --  FIXME: todo (protected type ?)
+            Error_Kind ("copy_subtype_indication", Def);
+      end case;
+      Location_Copy (Res, Def);
+      Set_Base_Type (Res, Get_Base_Type (Def));
+      Set_Type_Staticness (Res, Get_Type_Staticness (Def));
+      Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Def));
+      return Res;
+   end Copy_Subtype_Indication;
+
+   function Sem_Subnature_Indication (Def: Iir) return Iir
+   is
+      Nature_Mark: Iir;
+      Res : Iir;
+   begin
+      -- LRM 4.8 Nature declatation
+      --
+      -- If the subnature indication does not include a constraint, the
+      -- subnature is the same as that denoted by the type mark.
+      case Get_Kind (Def) is
+         when Iir_Kind_Scalar_Nature_Definition =>
+            --  Used for reference declared by a nature
+            return Def;
+         when Iir_Kinds_Denoting_Name =>
+            Nature_Mark := Sem_Denoting_Name (Def);
+            Res := Get_Named_Entity (Nature_Mark);
+            if Get_Kind (Res) /= Iir_Kind_Scalar_Nature_Definition then
+               Error_Class_Match (Nature_Mark, "nature");
+               raise Program_Error; --  TODO
+            else
+               return Nature_Mark;
+            end if;
+         when others =>
+            raise Program_Error; --  TODO
+      end case;
+   end Sem_Subnature_Indication;
+
+end Sem_Types;
diff --git a/src/sem_types.ads b/src/sem_types.ads
new file mode 100644
index 000000000..8eb7de108
--- /dev/null
+++ b/src/sem_types.ads
@@ -0,0 +1,57 @@
+--  Semantic analysis.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Sem_Types is
+   --  Semantization of types (LRM93 3 / LRM08 5)
+
+   --  Semantize subtype indication DEF.
+   --  If INCOMPLETE is TRUE, then DEF may designate an incomplete type
+   --  definition.  Return either a name (denoting a type) or an anonymous
+   --  subtype definition.
+   function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False)
+     return Iir;
+
+   procedure Sem_Protected_Type_Body (Bod : Iir);
+
+   function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir;
+
+   --  If A_RANGE is a range (range expression or range attribute), convert it
+   --  to a subtype definition.  Otherwise return A_RANGE.
+   --  The result is a subtype indication: either a type name or a subtype
+   --  definition.
+   function Range_To_Subtype_Indication (A_Range: Iir) return Iir;
+
+   --  ATYPE is used to declare a signal.
+   --  Set (recursively) the Has_Signal_Flag on ATYPE and all types used by
+   --   ATYPE (basetype, elements...)
+   --  If ATYPE can have signal (eg: access or file type), then this procedure
+   --   returns silently.
+   procedure Set_Type_Has_Signal (Atype : Iir);
+
+   --  Return TRUE iff FUNC is a resolution function.
+   --  If ATYPE is not NULL_IIR, type must match.
+   function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean;
+
+   --  Return a subtype definition copy of DEF.
+   --  This is used when an alias of DEF is required (eg: subtype a is b).
+   function Copy_Subtype_Indication (Def : Iir) return Iir;
+
+   --  Although a nature is not a type, it is patterned like a type.
+   function Sem_Subnature_Indication (Def: Iir) return Iir;
+end Sem_Types;
diff --git a/src/simulate/annotations.adb b/src/simulate/annotations.adb
new file mode 100644
index 000000000..d07a99818
--- /dev/null
+++ b/src/simulate/annotations.adb
@@ -0,0 +1,1236 @@
+--  Annotations for interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with GNAT.Table;
+with Ada.Text_IO;
+with Std_Package;
+with Errorout; use Errorout;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Annotations is
+   -- Current scope level.
+   Current_Scope_Level: Scope_Level_Type := Scope_Level_Global;
+
+   procedure Annotate_Declaration_List
+     (Block_Info: Sim_Info_Acc; Decl_Chain: Iir);
+   procedure Annotate_Sequential_Statement_Chain
+     (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir);
+   procedure Annotate_Concurrent_Statements_List
+     (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir);
+   procedure Annotate_Block_Configuration
+     (Block : Iir_Block_Configuration);
+   procedure Annotate_Subprogram_Interfaces_Type
+     (Block_Info : Sim_Info_Acc; Subprg: Iir);
+   procedure Annotate_Subprogram_Specification
+     (Block_Info : Sim_Info_Acc; Subprg: Iir);
+
+   procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir);
+
+   --  Annotate type definition DEF only if it is anonymous.
+   procedure Annotate_Anonymous_Type_Definition
+     (Block_Info: Sim_Info_Acc; Def: Iir);
+
+   -- Be sure the node contains no informations.
+   procedure Assert_No_Info (Node: in Iir) is
+   begin
+      if Get_Info (Node) /= null then
+         raise Internal_Error;
+      end if;
+   end Assert_No_Info;
+
+   procedure Increment_Current_Scope_Level is
+   begin
+      if Current_Scope_Level < Scope_Level_Global then
+         --  For a subprogram in a package
+         Current_Scope_Level := Scope_Level_Global + 1;
+      else
+         Current_Scope_Level := Current_Scope_Level + 1;
+      end if;
+   end Increment_Current_Scope_Level;
+
+   -- Add an annotation to object OBJ.
+   procedure Create_Object_Info
+     (Block_Info : Sim_Info_Acc;
+      Obj : Iir;
+      Obj_Kind : Sim_Info_Kind := Kind_Object)
+   is
+      Info : Sim_Info_Acc;
+   begin
+      Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1;
+      case Obj_Kind is
+         when Kind_Object =>
+            Info := new Sim_Info_Type'(Kind => Kind_Object,
+                                       Scope_Level => Current_Scope_Level,
+                                       Slot => Block_Info.Nbr_Objects);
+         when Kind_File =>
+            Info := new Sim_Info_Type'(Kind => Kind_File,
+                                       Scope_Level => Current_Scope_Level,
+                                       Slot => Block_Info.Nbr_Objects);
+         when Kind_Signal =>
+            Info := new Sim_Info_Type'(Kind => Kind_Signal,
+                                       Scope_Level => Current_Scope_Level,
+                                       Slot => Block_Info.Nbr_Objects);
+            --  Reserve one more slot for default value.
+            Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1;
+         when Kind_Terminal =>
+            Info := new Sim_Info_Type'(Kind => Kind_Terminal,
+                                       Scope_Level => Current_Scope_Level,
+                                       Slot => Block_Info.Nbr_Objects);
+         when Kind_Quantity =>
+            Info := new Sim_Info_Type'(Kind => Kind_Quantity,
+                                       Scope_Level => Current_Scope_Level,
+                                       Slot => Block_Info.Nbr_Objects);
+         when others =>
+            raise Internal_Error;
+      end case;
+      Set_Info (Obj, Info);
+   end Create_Object_Info;
+
+   -- Add an annotation to SIGNAL.
+   procedure Add_Signal_Info (Block_Info: Sim_Info_Acc; Signal: Iir) is
+   begin
+      Create_Object_Info (Block_Info, Signal, Kind_Signal);
+   end Add_Signal_Info;
+
+   procedure Add_Terminal_Info (Block_Info: Sim_Info_Acc; Terminal : Iir) is
+   begin
+      Create_Object_Info (Block_Info, Terminal, Kind_Terminal);
+   end Add_Terminal_Info;
+
+   procedure Add_Quantity_Info (Block_Info: Sim_Info_Acc; Quantity : Iir) is
+   begin
+      Create_Object_Info (Block_Info, Quantity, Kind_Quantity);
+   end Add_Quantity_Info;
+
+   -- If EXPR has not a literal value, create one.
+   -- This is necessary for subtype bounds.
+   procedure Annotate_Range_Expression
+     (Block_Info: Sim_Info_Acc; Expr: Iir_Range_Expression)
+   is
+   begin
+      if Get_Info (Expr) /= null then
+         return;
+      end if;
+      Assert_No_Info (Expr);
+--       if Expr = null or else Get_Info (Expr) /= null then
+--          return;
+--       end if;
+      Create_Object_Info (Block_Info, Expr);
+   end Annotate_Range_Expression;
+
+   --  Annotate type definition DEF only if it is anonymous.
+   procedure Annotate_Anonymous_Type_Definition
+     (Block_Info: Sim_Info_Acc; Def: Iir)
+   is
+   begin
+      if Is_Anonymous_Type_Definition (Def) then
+         Annotate_Type_Definition (Block_Info, Def);
+      end if;
+   end Annotate_Anonymous_Type_Definition;
+
+   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 (Iir_Value_Scalars) of Character := "bEIF";
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kinds_Scalar_Type_Definition =>
+            Res (Off) :=
+              Scalar_Map (Get_Info (Get_Base_Type (Def)).Scalar_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 Annotate_Protected_Type_Declaration (Block_Info : Sim_Info_Acc;
+                                                  Prot: Iir)
+   is
+      Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level;
+      Decl : Iir;
+   begin
+      --  First the interfaces type (they are elaborated in their context).
+      Decl := Get_Declaration_Chain (Prot);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Annotate_Subprogram_Interfaces_Type (Block_Info, Decl);
+            when Iir_Kind_Use_Clause =>
+               null;
+            when others =>
+               --  FIXME: attribute
+               Error_Kind ("annotate_protected_type_declaration", Decl);
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      --  Then the interfaces object.  Increment the scope to reserve a scope
+      --  for the protected object.
+      Increment_Current_Scope_Level;
+
+      Decl := Get_Declaration_Chain (Prot);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               Annotate_Subprogram_Specification (Block_Info, Decl);
+            when Iir_Kind_Use_Clause =>
+               null;
+            when others =>
+               Error_Kind ("annotate_protected_type_declaration", Decl);
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+
+      Current_Scope_Level := Prev_Scope_Level;
+   end Annotate_Protected_Type_Declaration;
+
+   procedure Annotate_Protected_Type_Body (Block_Info : Sim_Info_Acc;
+                                           Prot: Iir)
+   is
+      pragma Unreferenced (Block_Info);
+      Prot_Info: Sim_Info_Acc;
+      Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level;
+   begin
+      Increment_Current_Scope_Level;
+
+      Assert_No_Info (Prot);
+
+      Prot_Info :=
+        new Sim_Info_Type'(Kind => Kind_Frame,
+                           Inst_Slot => 0,
+                           Frame_Scope_Level => Current_Scope_Level,
+                           Nbr_Objects => 0,
+                           Nbr_Instances => 0);
+      Set_Info (Prot, Prot_Info);
+
+      Annotate_Declaration_List
+        (Prot_Info, Get_Declaration_Chain (Prot));
+
+      Current_Scope_Level := Prev_Scope_Level;
+   end Annotate_Protected_Type_Body;
+
+   procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir)
+   is
+      El: Iir;
+   begin
+      -- Happen only with universal types.
+      if Def = Null_Iir then
+         return;
+      end if;
+
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            if Def = Std_Package.Boolean_Type_Definition
+              or else Def = Std_Package.Bit_Type_Definition
+            then
+               Set_Info (Def,
+                         new Sim_Info_Type'(Kind => Kind_Scalar_Type,
+                                            Scalar_Mode => Iir_Value_B1));
+            else
+               Set_Info (Def,
+                         new Sim_Info_Type'(Kind => Kind_Scalar_Type,
+                                            Scalar_Mode => Iir_Value_E32));
+            end if;
+            Annotate_Range_Expression (Block_Info, Get_Range_Constraint (Def));
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            El := Get_Range_Constraint (Def);
+            if El /= Null_Iir then
+               case Get_Kind (El) is
+                  when Iir_Kind_Range_Expression =>
+                     Annotate_Range_Expression (Block_Info, El);
+                     --  A physical subtype may be defined by an integer range.
+                     if Get_Kind (Def) = Iir_Kind_Physical_Subtype_Definition
+                     then
+                        null;
+                        --  FIXME
+                        --  Convert_Int_To_Phys (Get_Info (El).Value);
+                     end if;
+                  when Iir_Kind_Range_Array_Attribute
+                    | Iir_Kind_Reverse_Range_Array_Attribute =>
+                     null;
+                  when others =>
+                     Error_Kind ("annotate_type_definition (rc)", El);
+               end case;
+            end if;
+            Annotate_Anonymous_Type_Definition
+              (Block_Info, Get_Base_Type (Def));
+
+         when Iir_Kind_Integer_Type_Definition =>
+            Set_Info (Def,
+                      new Sim_Info_Type'(Kind => Kind_Scalar_Type,
+                                         Scalar_Mode => Iir_Value_I64));
+
+         when Iir_Kind_Floating_Type_Definition =>
+            Set_Info (Def,
+                      new Sim_Info_Type'(Kind => Kind_Scalar_Type,
+                                         Scalar_Mode => Iir_Value_F64));
+
+         when Iir_Kind_Physical_Type_Definition =>
+            Set_Info (Def,
+                      new Sim_Info_Type'(Kind => Kind_Scalar_Type,
+                                         Scalar_Mode => Iir_Value_I64));
+
+         when Iir_Kind_Array_Type_Definition =>
+            El := Get_Element_Subtype (Def);
+            Annotate_Anonymous_Type_Definition (Block_Info, El);
+
+         when Iir_Kind_Array_Subtype_Definition =>
+            declare
+               List : constant Iir_List := Get_Index_Subtype_List (Def);
+            begin
+               for I in Natural loop
+                  El := Get_Index_Type (List, I);
+                  exit when El = Null_Iir;
+                  Annotate_Anonymous_Type_Definition (Block_Info, El);
+               end loop;
+            end;
+
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               List : constant Iir_List := Get_Elements_Declaration_List (Def);
+            begin
+               for I in Natural loop
+                  El := Get_Nth_Element (List, I);
+                  exit when El = Null_Iir;
+                  Annotate_Anonymous_Type_Definition
+                    (Block_Info, Get_Type (El));
+               end loop;
+            end;
+
+         when Iir_Kind_Record_Subtype_Definition =>
+            null;
+
+         when Iir_Kind_Access_Type_Definition =>
+            Annotate_Anonymous_Type_Definition
+              (Block_Info, Get_Designated_Type (Def));
+
+         when Iir_Kind_Access_Subtype_Definition =>
+            null;
+
+         when Iir_Kind_File_Type_Definition =>
+            declare
+               Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def));
+               Res : String_Acc;
+            begin
+               if Get_Text_File_Flag (Def)
+                 or else
+                 Get_Kind (Type_Name) in Iir_Kinds_Scalar_Type_Definition
+               then
+                  Res := null;
+               else
+                  declare
+                     Sig : String
+                       (1 .. Get_File_Signature_Length (Type_Name) + 2);
+                     Off : Natural := Sig'First;
+                  begin
+                     Get_File_Signature (Type_Name, Sig, Off);
+                     Sig (Off + 0) := '.';
+                     Sig (Off + 1) := ASCII.NUL;
+                     Res := new String'(Sig);
+                  end;
+               end if;
+               Set_Info (Def,
+                         new Sim_Info_Type'(Kind => Kind_File_Type,
+                                            File_Signature => Res));
+            end;
+
+         when Iir_Kind_Protected_Type_Declaration =>
+            Annotate_Protected_Type_Declaration (Block_Info, Def);
+
+         when Iir_Kind_Incomplete_Type_Definition =>
+            null;
+
+         when others =>
+            Error_Kind ("annotate_type_definition", Def);
+      end case;
+   end Annotate_Type_Definition;
+
+   procedure Annotate_Interface_List_Subtype
+     (Block_Info: Sim_Info_Acc; Decl_Chain: Iir)
+   is
+      El: Iir;
+   begin
+      El := Decl_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Signal_Interface_Declaration =>
+               Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El));
+            when Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration =>
+               Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El));
+            when others =>
+               Error_Kind ("annotate_interface_list", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Annotate_Interface_List_Subtype;
+
+   procedure Annotate_Create_Interface_List
+     (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean)
+   is
+      Decl : Iir;
+      N : Object_Slot_Type;
+   begin
+      Decl := Decl_Chain;
+      while Decl /= Null_Iir loop
+         if With_Types then
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+         end if;
+         Assert_No_Info (Decl);
+         case Get_Kind (Decl) is
+            when Iir_Kind_Signal_Interface_Declaration =>
+               Add_Signal_Info (Block_Info, Decl);
+            when Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration =>
+               Create_Object_Info (Block_Info, Decl);
+            when others =>
+               Error_Kind ("annotate_create_interface_list", Decl);
+         end case;
+         N := Block_Info.Nbr_Objects;
+         --  Annotation of the default value must not create objects.
+         --  FIXME: Is it true ???
+         if Block_Info.Nbr_Objects /= N then
+            raise Internal_Error;
+         end if;
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Annotate_Create_Interface_List;
+
+   procedure Annotate_Subprogram_Interfaces_Type
+     (Block_Info : Sim_Info_Acc; Subprg: Iir)
+   is
+      Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg);
+   begin
+      --  See LRM93 12.3.1.1 (Subprogram declarations and bodies).  The type
+      --  of the interfaces are elaborated in the outer context.
+      Annotate_Interface_List_Subtype (Block_Info, Interfaces);
+
+      if Get_Kind (Subprg) in Iir_Kinds_Function_Declaration then
+         --  FIXME: can this create a new annotation ?
+         Annotate_Anonymous_Type_Definition
+           (Block_Info, Get_Return_Type (Subprg));
+      end if;
+   end Annotate_Subprogram_Interfaces_Type;
+
+   procedure Annotate_Subprogram_Specification
+     (Block_Info : Sim_Info_Acc; Subprg: Iir)
+   is
+      pragma Unreferenced (Block_Info);
+      Subprg_Info: Sim_Info_Acc;
+      Interfaces : constant Iir := Get_Interface_Declaration_Chain (Subprg);
+      Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level;
+   begin
+      Increment_Current_Scope_Level;
+
+      Assert_No_Info (Subprg);
+
+      Subprg_Info :=
+        new Sim_Info_Type'(Kind => Kind_Frame,
+                           Inst_Slot => 0,
+                           Frame_Scope_Level => Current_Scope_Level,
+                           Nbr_Objects => 0,
+                           Nbr_Instances => 0);
+      Set_Info (Subprg, Subprg_Info);
+
+      Annotate_Create_Interface_List (Subprg_Info, Interfaces, False);
+
+      Current_Scope_Level := Prev_Scope_Level;
+   end Annotate_Subprogram_Specification;
+
+   procedure Annotate_Subprogram_Body
+     (Block_Info : Sim_Info_Acc; Subprg: Iir)
+   is
+      pragma Unreferenced (Block_Info);
+      Spec : constant Iir := Get_Subprogram_Specification (Subprg);
+      Subprg_Info : constant Sim_Info_Acc := Get_Info (Spec);
+      Prev_Scope_Level : constant Scope_Level_Type := Current_Scope_Level;
+   begin
+      --  Do not annotate body of foreign subprograms.
+      if Get_Foreign_Flag (Spec) then
+         return;
+      end if;
+
+      Current_Scope_Level := Subprg_Info.Frame_Scope_Level;
+
+      Annotate_Declaration_List
+        (Subprg_Info, Get_Declaration_Chain (Subprg));
+
+      Annotate_Sequential_Statement_Chain
+        (Subprg_Info, Get_Sequential_Statement_Chain (Subprg));
+
+      Current_Scope_Level := Prev_Scope_Level;
+   end Annotate_Subprogram_Body;
+
+   procedure Annotate_Component_Declaration
+     (Comp: Iir_Component_Declaration)
+   is
+      Info: Sim_Info_Acc;
+      Prev_Scope_Level : Scope_Level_Type;
+   begin
+      Prev_Scope_Level := Current_Scope_Level;
+      Current_Scope_Level := Scope_Level_Component;
+
+      Assert_No_Info (Comp);
+
+      Info := new Sim_Info_Type'(Kind => Kind_Frame,
+                                 Inst_Slot => Invalid_Instance_Slot,
+                                 Frame_Scope_Level => Current_Scope_Level,
+                                 Nbr_Objects => 0,
+                                 Nbr_Instances => 1); --  For the instance.
+      Set_Info (Comp, Info);
+
+      Annotate_Create_Interface_List (Info, Get_Generic_Chain (Comp), True);
+      Annotate_Create_Interface_List (Info, Get_Port_Chain (Comp), True);
+
+      Current_Scope_Level := Prev_Scope_Level;
+   end Annotate_Component_Declaration;
+
+   procedure Annotate_Declaration (Block_Info: Sim_Info_Acc; Decl: Iir) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Signal_Declaration =>
+            Assert_No_Info (Decl);
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+            Add_Signal_Info (Block_Info, Decl);
+
+         when Iir_Kind_Variable_Declaration
+           | Iir_Kind_Iterator_Declaration =>
+            Assert_No_Info (Decl);
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+            Create_Object_Info (Block_Info, Decl);
+
+         when Iir_Kind_Constant_Declaration =>
+            if Get_Deferred_Declaration (Decl) = Null_Iir
+              or else Get_Deferred_Declaration_Flag (Decl)
+            then
+               --  Create the slot only if the constant is not a full constant
+               --  declaration.
+               Assert_No_Info (Decl);
+               Annotate_Anonymous_Type_Definition
+                 (Block_Info, Get_Type (Decl));
+               Create_Object_Info (Block_Info, Decl);
+            else
+               Set_Info (Decl, Get_Info (Get_Deferred_Declaration (Decl)));
+            end if;
+
+         when Iir_Kind_File_Declaration =>
+            Assert_No_Info (Decl);
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+            Create_Object_Info (Block_Info, Decl, Kind_File);
+
+         when Iir_Kind_Terminal_Declaration =>
+            Assert_No_Info (Decl);
+            Add_Terminal_Info (Block_Info, Decl);
+         when Iir_Kinds_Branch_Quantity_Declaration =>
+            Assert_No_Info (Decl);
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+            Add_Quantity_Info (Block_Info, Decl);
+
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration =>
+            Annotate_Type_Definition (Block_Info, Get_Type_Definition (Decl));
+         when Iir_Kind_Subtype_Declaration =>
+            Annotate_Type_Definition (Block_Info, Get_Type (Decl));
+
+         when Iir_Kind_Protected_Type_Body =>
+            Annotate_Protected_Type_Body (Block_Info, Decl);
+
+         when Iir_Kind_Component_Declaration =>
+            Annotate_Component_Declaration (Decl);
+
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            if not Is_Second_Subprogram_Specification (Decl) then
+               Annotate_Subprogram_Interfaces_Type (Block_Info, Decl);
+               Annotate_Subprogram_Specification (Block_Info, Decl);
+            end if;
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            Annotate_Subprogram_Body (Block_Info, Decl);
+
+         when Iir_Kind_Object_Alias_Declaration =>
+            Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
+            Create_Object_Info (Block_Info, Decl);
+
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+
+         when Iir_Kind_Attribute_Declaration =>
+            null;
+         when Iir_Kind_Attribute_Specification =>
+            declare
+               Value : Iir_Attribute_Value;
+            begin
+               Value := Get_Attribute_Value_Spec_Chain (Decl);
+               while Value /= Null_Iir loop
+                  Create_Object_Info (Block_Info, Value);
+                  Value := Get_Spec_Chain (Value);
+               end loop;
+            end;
+         when Iir_Kind_Disconnection_Specification =>
+            null;
+
+         when Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when Iir_Kind_Group_Template_Declaration =>
+            null;
+         when Iir_Kind_Group_Declaration =>
+            null;
+         when Iir_Kind_Use_Clause =>
+            null;
+
+         when Iir_Kind_Configuration_Specification =>
+            null;
+
+--           when Iir_Kind_Implicit_Signal_Declaration =>
+--              declare
+--                 Nsig : Iir;
+--              begin
+--                 Nsig := Decl;
+--                 loop
+--                    Nsig := Get_Implicit_Signal_Chain (Nsig);
+--                    exit when Nsig = Null_Iir;
+--                    Add_Signal_Info (Block_Info, Nsig);
+--                 end loop;
+--              end;
+
+         when Iir_Kind_Implicit_Function_Declaration =>
+            null;
+
+         when Iir_Kind_Nature_Declaration =>
+            null;
+
+         when others =>
+            Error_Kind ("annotate_declaration", Decl);
+      end case;
+   end Annotate_Declaration;
+
+   procedure Annotate_Declaration_List
+     (Block_Info: Sim_Info_Acc; Decl_Chain: Iir)
+   is
+      El: Iir;
+   begin
+      El := Decl_Chain;
+      while El /= Null_Iir loop
+         Annotate_Declaration (Block_Info, El);
+         El := Get_Chain (El);
+      end loop;
+   end Annotate_Declaration_List;
+
+   procedure Annotate_Sequential_Statement_Chain
+     (Block_Info: Sim_Info_Acc; Stmt_Chain: Iir)
+   is
+      El: Iir;
+      Max_Nbr_Objects : Object_Slot_Type;
+      Current_Nbr_Objects : Object_Slot_Type;
+
+      procedure Save_Nbr_Objects is
+      begin
+         --  Objects used by loop statements can be reused later by
+         --  other (ie following) loop statements.
+         --  Furthermore, this allow to correctly check elaboration
+         --  order.
+         Max_Nbr_Objects := Object_Slot_Type'Max
+           (Block_Info.Nbr_Objects, Max_Nbr_Objects);
+         Block_Info.Nbr_Objects := Current_Nbr_Objects;
+      end Save_Nbr_Objects;
+   begin
+      Current_Nbr_Objects := Block_Info.Nbr_Objects;
+      Max_Nbr_Objects := Current_Nbr_Objects;
+
+      El := Stmt_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Null_Statement =>
+               null;
+            when Iir_Kind_Assertion_Statement
+              | Iir_Kind_Report_Statement =>
+               null;
+            when Iir_Kind_Return_Statement =>
+               null;
+            when Iir_Kind_Signal_Assignment_Statement
+              | Iir_Kind_Variable_Assignment_Statement =>
+               null;
+            when Iir_Kind_Procedure_Call_Statement =>
+               null;
+            when Iir_Kind_Exit_Statement
+              | Iir_Kind_Next_Statement =>
+               null;
+            when Iir_Kind_Wait_Statement =>
+               null;
+
+            when Iir_Kind_If_Statement =>
+               declare
+                  Clause: Iir := El;
+               begin
+                  loop
+                     Annotate_Sequential_Statement_Chain
+                       (Block_Info, Get_Sequential_Statement_Chain (Clause));
+                     Clause := Get_Else_Clause (Clause);
+                     exit when Clause = Null_Iir;
+                     Save_Nbr_Objects;
+                  end loop;
+               end;
+
+            when Iir_Kind_Case_Statement =>
+               declare
+                  Assoc: Iir;
+               begin
+                  Assoc := Get_Case_Statement_Alternative_Chain (El);
+                  loop
+                     Annotate_Sequential_Statement_Chain
+                       (Block_Info, Get_Associated_Chain (Assoc));
+                     Assoc := Get_Chain (Assoc);
+                     exit when Assoc = Null_Iir;
+                     Save_Nbr_Objects;
+                  end loop;
+               end;
+
+            when Iir_Kind_For_Loop_Statement =>
+               Annotate_Declaration
+                 (Block_Info, Get_Parameter_Specification (El));
+               Annotate_Sequential_Statement_Chain
+                 (Block_Info, Get_Sequential_Statement_Chain (El));
+
+            when Iir_Kind_While_Loop_Statement =>
+               Annotate_Sequential_Statement_Chain
+                 (Block_Info, Get_Sequential_Statement_Chain (El));
+
+            when others =>
+               Error_Kind ("annotate_sequential_statement_chain", El);
+         end case;
+
+         Save_Nbr_Objects;
+
+         El := Get_Chain (El);
+      end loop;
+      Block_Info.Nbr_Objects := Max_Nbr_Objects;
+   end Annotate_Sequential_Statement_Chain;
+
+   procedure Annotate_Block_Statement
+     (Block_Info : Sim_Info_Acc; Block : Iir_Block_Statement)
+   is
+      Info : Sim_Info_Acc;
+      Header : Iir_Block_Header;
+      Guard : Iir;
+   begin
+      Assert_No_Info (Block);
+
+      Increment_Current_Scope_Level;
+
+      Info := new Sim_Info_Type'(Kind => Kind_Block,
+                                 Inst_Slot => Block_Info.Nbr_Instances,
+                                 Frame_Scope_Level => Current_Scope_Level,
+                                 Nbr_Objects => 0,
+                                 Nbr_Instances => 0);
+      Set_Info (Block, Info);
+
+      Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1;
+
+      Guard := Get_Guard_Decl (Block);
+      if Guard /= Null_Iir then
+         Add_Signal_Info (Info, Guard);
+      end if;
+      Header := Get_Block_Header (Block);
+      if Header /= Null_Iir then
+         Annotate_Create_Interface_List
+           (Info, Get_Generic_Chain (Header), True);
+         Annotate_Create_Interface_List
+           (Info, Get_Port_Chain (Header), True);
+      end if;
+      Annotate_Declaration_List (Info, Get_Declaration_Chain (Block));
+      Annotate_Concurrent_Statements_List
+        (Info, Get_Concurrent_Statement_Chain (Block));
+
+      Current_Scope_Level := Current_Scope_Level - 1;
+   end Annotate_Block_Statement;
+
+   procedure Annotate_Generate_Statement
+     (Block_Info : Sim_Info_Acc; Stmt : Iir)
+   is
+      Info : Sim_Info_Acc;
+      Scheme : constant Iir := Get_Generation_Scheme (Stmt);
+      Is_Iterative : constant Boolean :=
+        Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration;
+   begin
+      Assert_No_Info (Stmt);
+
+      Increment_Current_Scope_Level;
+
+      Info := new Sim_Info_Type'(Kind => Kind_Block,
+                                 Inst_Slot => Block_Info.Nbr_Instances,
+                                 Frame_Scope_Level => Current_Scope_Level,
+                                 Nbr_Objects => 0,
+                                 Nbr_Instances => 0);
+      Set_Info (Stmt, Info);
+
+      Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1;
+
+      if Is_Iterative then
+         Annotate_Declaration (Info, Scheme);
+      end if;
+      Annotate_Declaration_List (Info, Get_Declaration_Chain (Stmt));
+      Annotate_Concurrent_Statements_List
+        (Info, Get_Concurrent_Statement_Chain (Stmt));
+
+      Current_Scope_Level := Current_Scope_Level - 1;
+   end Annotate_Generate_Statement;
+
+   procedure Annotate_Component_Instantiation_Statement
+     (Block_Info : Sim_Info_Acc; Stmt : Iir)
+   is
+      Info: Sim_Info_Acc;
+   begin
+      --  Add a slot just to put the instance.
+      Assert_No_Info (Stmt);
+      Info := new Sim_Info_Type'(Kind => Kind_Block,
+                                 Inst_Slot => Block_Info.Nbr_Instances,
+                                 Frame_Scope_Level => Current_Scope_Level + 1,
+                                 Nbr_Objects => 0,
+                                 Nbr_Instances => 1);
+      Set_Info (Stmt, Info);
+      Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1;
+   end Annotate_Component_Instantiation_Statement;
+
+   procedure Annotate_Process_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir)
+   is
+      pragma Unreferenced (Block_Info);
+      Info: Sim_Info_Acc;
+   begin
+      Increment_Current_Scope_Level;
+
+      --  Add a slot just to put the instance.
+      Assert_No_Info (Stmt);
+
+      Info := new Sim_Info_Type'(Kind => Kind_Process,
+                                 Inst_Slot => Invalid_Instance_Slot,
+                                 Frame_Scope_Level => Current_Scope_Level,
+                                 Nbr_Objects => 0,
+                                 Nbr_Instances => 0);
+      Set_Info (Stmt, Info);
+
+      Annotate_Declaration_List
+        (Info, Get_Declaration_Chain (Stmt));
+      Annotate_Sequential_Statement_Chain
+        (Info, Get_Sequential_Statement_Chain (Stmt));
+
+      Current_Scope_Level := Current_Scope_Level - 1;
+   end Annotate_Process_Statement;
+
+   procedure Annotate_Concurrent_Statements_List
+     (Block_Info: Sim_Info_Acc; Stmt_Chain : Iir)
+   is
+      El: Iir;
+   begin
+      El := Stmt_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Process_Statement =>
+               Annotate_Process_Statement (Block_Info, El);
+
+            when Iir_Kind_Component_Instantiation_Statement =>
+               Annotate_Component_Instantiation_Statement (Block_Info, El);
+
+            when Iir_Kind_Block_Statement =>
+               Annotate_Block_Statement (Block_Info, El);
+
+            when Iir_Kind_Generate_Statement =>
+               Annotate_Generate_Statement (Block_Info, El);
+
+            when Iir_Kind_Simple_Simultaneous_Statement =>
+               null;
+
+            when others =>
+               Error_Kind ("annotate_concurrent_statements_list", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Annotate_Concurrent_Statements_List;
+
+   procedure Annotate_Entity (Decl: Iir_Entity_Declaration) is
+      Entity_Info: Sim_Info_Acc;
+   begin
+      Assert_No_Info (Decl);
+
+      Current_Scope_Level := Scope_Level_Entity;
+
+      Entity_Info :=
+        new Sim_Info_Type'(Kind => Kind_Block,
+                           Inst_Slot => Invalid_Instance_Slot,
+                           Frame_Scope_Level => Current_Scope_Level,
+                           Nbr_Objects => 0,
+                           Nbr_Instances => 0);
+      Set_Info (Decl, Entity_Info);
+
+      -- generic list.
+      Annotate_Create_Interface_List
+        (Entity_Info, Get_Generic_Chain (Decl), True);
+
+      -- Port list.
+      Annotate_Create_Interface_List
+        (Entity_Info, Get_Port_Chain (Decl), True);
+
+      -- declarations
+      Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl));
+
+      -- processes.
+      Annotate_Concurrent_Statements_List
+        (Entity_Info, Get_Concurrent_Statement_Chain (Decl));
+   end Annotate_Entity;
+
+   procedure Annotate_Architecture (Decl: Iir_Architecture_Body)
+   is
+      Entity_Info: Sim_Info_Acc;
+      Arch_Info: Sim_Info_Acc;
+   begin
+      Assert_No_Info (Decl);
+
+      Current_Scope_Level := Scope_Level_Entity;
+
+      Entity_Info := Get_Info (Get_Entity (Decl));
+
+      Arch_Info := new Sim_Info_Type'
+        (Kind => Kind_Block,
+         Inst_Slot => 0, --  Slot for a component
+         Frame_Scope_Level => Current_Scope_Level,
+         Nbr_Objects => Entity_Info.Nbr_Objects,
+         Nbr_Instances => Entity_Info.Nbr_Instances); --  Should be 0.
+      Set_Info (Decl, Arch_Info);
+
+      --  FIXME: annotate the default configuration for the arch ?
+
+      -- declarations
+      Annotate_Declaration_List (Arch_Info, Get_Declaration_Chain (Decl));
+
+      -- processes.
+      Annotate_Concurrent_Statements_List
+        (Arch_Info, Get_Concurrent_Statement_Chain (Decl));
+   end Annotate_Architecture;
+
+   procedure Annotate_Package (Decl: Iir_Package_Declaration) is
+      Package_Info: Sim_Info_Acc;
+   begin
+      Assert_No_Info (Decl);
+
+      Nbr_Packages := Nbr_Packages + 1;
+      Current_Scope_Level := Scope_Level_Type (-Nbr_Packages);
+
+      Package_Info := new Sim_Info_Type'
+        (Kind => Kind_Block,
+         Inst_Slot => Instance_Slot_Type (Nbr_Packages),
+         Frame_Scope_Level => Current_Scope_Level,
+         Nbr_Objects => 0,
+         Nbr_Instances => 0);
+
+      Set_Info (Decl, Package_Info);
+
+      -- declarations
+      Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl));
+
+      Current_Scope_Level := Scope_Level_Global;
+   end Annotate_Package;
+
+   procedure Annotate_Package_Body (Decl: Iir)
+   is
+      Package_Info: Sim_Info_Acc;
+   begin
+      Assert_No_Info (Decl);
+
+      -- Set info field of package body declaration.
+      Package_Info := Get_Info (Get_Package (Decl));
+      Set_Info (Decl, Package_Info);
+
+      Current_Scope_Level := Package_Info.Frame_Scope_Level;
+
+      -- declarations
+      Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl));
+   end Annotate_Package_Body;
+
+   procedure Annotate_Component_Configuration
+     (Conf : Iir_Component_Configuration)
+   is
+      Block : constant Iir := Get_Block_Configuration (Conf);
+   begin
+      Annotate_Block_Configuration (Block);
+   end Annotate_Component_Configuration;
+
+   procedure Annotate_Block_Configuration (Block : Iir_Block_Configuration)
+   is
+      El : Iir;
+   begin
+      if Block = Null_Iir then
+         return;
+      end if;
+      Assert_No_Info (Block);
+
+      --  Declaration are use_clause only.
+      El := Get_Configuration_Item_Chain (Block);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Block_Configuration =>
+               Annotate_Block_Configuration (El);
+            when Iir_Kind_Component_Configuration =>
+               Annotate_Component_Configuration (El);
+            when others =>
+               Error_Kind ("annotate_block_configuration", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Annotate_Block_Configuration;
+
+   procedure Annotate_Configuration_Declaration
+     (Decl : Iir_Configuration_Declaration)
+   is
+      Config_Info: Sim_Info_Acc;
+   begin
+      Assert_No_Info (Decl);
+
+      Config_Info := new Sim_Info_Type'
+        (Kind => Kind_Block,
+         Inst_Slot => Invalid_Instance_Slot,
+         Frame_Scope_Level => Scope_Level_Global,
+         Nbr_Objects => 0,
+         Nbr_Instances => 0);
+
+      Current_Scope_Level := Scope_Level_Global;
+
+      Annotate_Declaration_List (Config_Info, Get_Declaration_Chain (Decl));
+      Annotate_Block_Configuration (Get_Block_Configuration (Decl));
+   end Annotate_Configuration_Declaration;
+
+   package Info_Node is new GNAT.Table
+     (Table_Component_Type => Sim_Info_Acc,
+      Table_Index_Type => Iir,
+      Table_Low_Bound => 2,
+      Table_Initial => 1024,
+      Table_Increment => 100);
+
+   procedure Annotate_Expand_Table
+   is
+      El: Iir;
+   begin
+      Info_Node.Increment_Last;
+      El := Info_Node.Last;
+      Info_Node.Set_Last (Get_Last_Node);
+      for I in El .. Info_Node.Last loop
+         Info_Node.Table (I) := null;
+      end loop;
+   end Annotate_Expand_Table;
+
+   -- Decorate the tree in order to be usable with the internal simulator.
+   procedure Annotate (Tree: Iir_Design_Unit)
+   is
+      El: Iir;
+   begin
+      --  Expand info table.
+      Annotate_Expand_Table;
+
+      El := Get_Library_Unit (Tree);
+      if Trace_Annotation then
+         Ada.Text_IO.Put_Line ("annotating " & Disp_Node (El));
+      end if;
+      case Get_Kind (El) is
+         when Iir_Kind_Entity_Declaration =>
+            Annotate_Entity (El);
+         when Iir_Kind_Architecture_Body =>
+            Annotate_Architecture (El);
+         when Iir_Kind_Package_Declaration =>
+            Annotate_Package (El);
+            declare
+               use Std_Package;
+            begin
+               if El = Standard_Package then
+                  --  These types are not in std.standard!
+                  Annotate_Type_Definition
+                    (Get_Info (El), Convertible_Integer_Type_Definition);
+                  Annotate_Type_Definition
+                    (Get_Info (El), Convertible_Real_Type_Definition);
+               end if;
+            end;
+         when Iir_Kind_Package_Body =>
+            Annotate_Package_Body (El);
+         when Iir_Kind_Configuration_Declaration =>
+            Annotate_Configuration_Declaration (El);
+         when others =>
+            Error_Kind ("annotate2", El);
+      end case;
+   end Annotate;
+
+   -- Disp annotations for an iir node.
+   procedure Disp_Vhdl_Info (Node: Iir) is
+      use Ada.Text_IO;
+      Indent: Count;
+      Info: Sim_Info_Acc;
+   begin
+      Info := Get_Info (Node);
+      Indent := Col;
+      case Info.Kind is
+         when Kind_Block =>
+            Put_Line
+              ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects));
+
+         when Kind_Frame | Kind_Process  =>
+            Put_Line ("-- scope level:" &
+                      Scope_Level_Type'Image (Info.Frame_Scope_Level));
+            Set_Col (Indent);
+            Put_Line
+              ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects));
+
+         when Kind_Object | Kind_Signal | Kind_File
+           | Kind_Terminal | Kind_Quantity =>
+            Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot)
+                      & ", scope:"
+                      & Scope_Level_Type'Image (Info.Scope_Level));
+         when Kind_Scalar_Type
+           | Kind_File_Type =>
+            null;
+         when Kind_Range =>
+            Put ("${");
+            Put (Object_Slot_Type'Image (Info.Slot));
+            Put ("}");
+      end case;
+   end Disp_Vhdl_Info;
+
+   procedure Disp_Info (Info : Sim_Info_Acc)
+   is
+      use Ada.Text_IO;
+      Indent: Count;
+   begin
+      Indent := Col + 2;
+      Set_Col (Indent);
+      if Info = null then
+         Put_Line ("*null*");
+         return;
+      end if;
+      case Info.Kind is
+         when Kind_Block | Kind_Frame | Kind_Process =>
+            Put_Line ("scope level:" &
+                      Scope_Level_Type'Image (Info.Frame_Scope_Level));
+            Set_Col (Indent);
+            Put_Line ("inst_slot:"
+                        & Instance_Slot_Type'Image (Info.Inst_Slot));
+            Set_Col (Indent);
+            Put_Line ("nbr objects:"
+                        & Object_Slot_Type'Image (Info.Nbr_Objects));
+            Set_Col (Indent);
+            Put_Line ("nbr instance:"
+                      & Instance_Slot_Type'Image (Info.Nbr_Instances));
+         when Kind_Object | Kind_Signal | Kind_File
+           | Kind_Terminal | Kind_Quantity =>
+            Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot)
+                      & ", scope:"
+                      & Scope_Level_Type'Image (Info.Scope_Level));
+         when Kind_Range =>
+            Put_Line ("range slot:" & Object_Slot_Type'Image (Info.Slot));
+         when Kind_Scalar_Type =>
+            Put_Line ("scalar type: "
+                        & Iir_Value_Kind'Image (Info.Scalar_Mode));
+         when Kind_File_Type =>
+            Put ("file type: ");
+            if Info.File_Signature = null then
+               Put ("(no sig)");
+            else
+               Put (Info.File_Signature.all);
+            end if;
+            New_Line;
+      end case;
+   end Disp_Info;
+
+   procedure Disp_Tree_Info (Node: Iir) is
+   begin
+      Disp_Info (Get_Info (Node));
+   end Disp_Tree_Info;
+
+   procedure Set_Info (Target: Iir; Info: Sim_Info_Acc) is
+   begin
+      Info_Node.Table (Target) := Info;
+   end Set_Info;
+
+   function Get_Info (Target: Iir) return Sim_Info_Acc is
+   begin
+      return Info_Node.Table (Target);
+   end Get_Info;
+end Annotations;
diff --git a/src/simulate/annotations.ads b/src/simulate/annotations.ads
new file mode 100644
index 000000000..e9b48d005
--- /dev/null
+++ b/src/simulate/annotations.ads
@@ -0,0 +1,120 @@
+--  Annotations for interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Iirs; use Iirs;
+with Iir_Values; use Iir_Values;
+with Types; use Types;
+
+package Annotations is
+   Trace_Annotation : Boolean := False;
+
+   -- Decorate the tree in order to be usable with the internal simulator.
+   procedure Annotate (Tree: Iir_Design_Unit);
+
+   -- Disp annotations for an iir node.
+   procedure Disp_Vhdl_Info (Node: Iir);
+   procedure Disp_Tree_Info (Node: Iir);
+
+   -- Annotations are used to collect informations for elaboration and to
+   -- locate iir_value_literal for signals, variables or constants.
+
+   -- Scope corresponding to an object.
+   -- Scope_level_global is for objects that can be instancied only one
+   -- time, ie shared signals or constants declared in a package.
+   --
+   -- Scope_Level_Process is for objects declared in an entity, architecture,
+   -- process, bloc (but not generated bloc).  These are static objects, that
+   -- can be instancied several times.
+   --
+   -- Scope_Level_First_Function and above are for dynamic objects declared
+   -- in a subprogram.  The level is also the nest level.
+   --
+   --  Scope_Level_Component is set to a maximum, since there is at
+   --  most one scope after it (the next one is an entity).
+   type Scope_Level_Type is new Integer;
+   Scope_Level_Global: constant Scope_Level_Type := 0;
+   Scope_Level_Entity: constant Scope_Level_Type := 1;
+   Scope_Level_Component : constant Scope_Level_Type :=
+     Scope_Level_Type'Last - 1;
+
+   type Instance_Slot_Type is new Integer;
+   Invalid_Instance_Slot : constant Instance_Slot_Type := -1;
+
+   type Object_Slot_Type is new Integer;
+
+   -- The annotation depends on the kind of the node.
+   type Sim_Info_Kind is
+     (Kind_Block, Kind_Process, Kind_Frame,
+      Kind_Scalar_Type, Kind_File_Type,
+      Kind_Object, Kind_Signal, Kind_Range,
+      Kind_File,
+      Kind_Terminal, Kind_Quantity);
+
+   type Sim_Info_Type (Kind: Sim_Info_Kind);
+   type Sim_Info_Acc is access all Sim_Info_Type;
+
+   -- Annotation for an iir node in order to be able to simulate it.
+   type Sim_Info_Type (Kind: Sim_Info_Kind) is record
+      case Kind is
+         when Kind_Block
+           | Kind_Frame
+           | Kind_Process =>
+            --  Slot number.
+            Inst_Slot : Instance_Slot_Type;
+
+            -- scope level for this frame.
+            Frame_Scope_Level: Scope_Level_Type;
+
+            -- Number of objects/signals.
+            Nbr_Objects : Object_Slot_Type;
+
+            --  Number of children (blocks, generate, instantiation).
+            Nbr_Instances : Instance_Slot_Type;
+
+         when Kind_Object
+           | Kind_Signal
+           | Kind_Range
+           | Kind_File
+           | Kind_Terminal
+           | Kind_Quantity =>
+            -- block considered (hierarchy).
+            Scope_Level: Scope_Level_Type;
+
+            -- Variable index.
+            Slot: Object_Slot_Type;
+
+         when Kind_Scalar_Type =>
+            Scalar_Mode : Iir_Value_Kind;
+
+         when Kind_File_Type =>
+            File_Signature : String_Acc;
+      end case;
+   end record;
+
+   Nbr_Packages : Iir_Index32 := 0;
+
+   -- Get/Set annotation fied from/to an iir.
+   procedure Set_Info (Target: Iir; Info: Sim_Info_Acc);
+   pragma Inline (Set_Info);
+   function Get_Info (Target: Iir) return Sim_Info_Acc;
+   pragma Inline (Get_Info);
+
+   --  Expand the annotation table.  This is automatically done by Annotate,
+   --  to be used only by debugger.
+   procedure Annotate_Expand_Table;
+end Annotations;
diff --git a/src/simulate/areapools.adb b/src/simulate/areapools.adb
new file mode 100644
index 000000000..341b14240
--- /dev/null
+++ b/src/simulate/areapools.adb
@@ -0,0 +1,147 @@
+--  Area based memory manager
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Deallocation;
+
+package body Areapools is
+   procedure Deallocate is new Ada.Unchecked_Deallocation
+     (Chunk_Type, Chunk_Acc);
+
+   Free_Chunks : Chunk_Acc;
+
+   function Get_Chunk return Chunk_Acc is
+      Res : Chunk_Acc;
+   begin
+      if Free_Chunks /= null then
+         Res := Free_Chunks;
+         Free_Chunks := Res.Prev;
+         return Res;
+      else
+         return new Chunk_Type (Default_Chunk_Size - 1);
+      end if;
+   end Get_Chunk;
+
+   procedure Free_Chunk (Chunk : Chunk_Acc) is
+   begin
+      Chunk.Prev := Free_Chunks;
+      Free_Chunks := Chunk;
+   end Free_Chunk;
+
+   procedure Allocate (Pool : in out Areapool;
+                       Res : out Address;
+                       Size : Size_Type;
+                       Align : Size_Type)
+   is
+      Align_M1 : constant Size_Type := Align - 1;
+
+      function Do_Align (X : Size_Type) return Size_Type is
+      begin
+         return (X + Align_M1) and not Align_M1;
+      end Do_Align;
+
+      Chunk : Chunk_Acc;
+   begin
+      --  Need to allocate a new chunk if there is no current chunk, or not
+      --  enough room in the current chunk.
+      if Pool.Last = null
+        or else Do_Align (Pool.Next_Use) + Size > Pool.Last.Last
+      then
+         if Size > Default_Chunk_Size then
+            Chunk := new Chunk_Type (Size - 1);
+         else
+            Chunk := Get_Chunk;
+         end if;
+         Chunk.Prev := Pool.Last;
+         Pool.Next_Use := 0;
+         if Pool.First = null then
+            Pool.First := Chunk;
+         end if;
+         Pool.Last := Chunk;
+      else
+         Chunk := Pool.Last;
+         Pool.Next_Use := Do_Align (Pool.Next_Use);
+      end if;
+      Res := Chunk.Data (Pool.Next_Use)'Address;
+      Pool.Next_Use := Pool.Next_Use + Size;
+   end Allocate;
+
+   procedure Mark (M : out Mark_Type; Pool : Areapool) is
+   begin
+      M := (Last => Pool.Last, Next_Use => Pool.Next_Use);
+   end Mark;
+
+   procedure Release (M : Mark_Type; Pool : in out Areapool)
+   is
+      Chunk : Chunk_Acc;
+      Prev : Chunk_Acc;
+   begin
+      Chunk := Pool.Last;
+      while Chunk /= M.Last loop
+         if Erase_When_Released then
+            Chunk.Data := (others => 16#DE#);
+         end if;
+
+         Prev := Chunk.Prev;
+         if Chunk.Last = Default_Chunk_Size - 1 then
+            Free_Chunk (Chunk);
+         else
+            Deallocate (Chunk);
+         end if;
+         Chunk := Prev;
+      end loop;
+
+      if Erase_When_Released
+        and then M.Last /= null
+      then
+         declare
+            Last : Size_Type;
+         begin
+            if Pool.Last = M.Last then
+               Last := Pool.Next_Use - 1;
+            else
+               Last := Chunk.Data'Last;
+            end if;
+            Chunk.Data (M.Next_Use .. Last) := (others => 16#DE#);
+         end;
+      end if;
+
+      Pool.Last := M.Last;
+      Pool.Next_Use := M.Next_Use;
+   end Release;
+
+   function Is_Empty (Pool : Areapool) return Boolean is
+   begin
+      return Pool.Last = null;
+   end Is_Empty;
+
+   function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T)
+                               return System.Address
+   is
+      Res : Address;
+   begin
+      Allocate (Pool.all, Res, T'Size / Storage_Unit, T'Alignment);
+      declare
+         Addr1 : constant Address := Res;
+         Init : T := Val;
+         for Init'Address use Addr1;
+      begin
+         null;
+      end;
+      return Res;
+   end Alloc_On_Pool_Addr;
+end Areapools;
diff --git a/src/simulate/areapools.ads b/src/simulate/areapools.ads
new file mode 100644
index 000000000..186f29707
--- /dev/null
+++ b/src/simulate/areapools.ads
@@ -0,0 +1,87 @@
+--  Area based memory manager
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with System; use System;
+with System.Storage_Elements; use System.Storage_Elements;
+
+package Areapools is
+   type Areapool is limited private;
+   type Mark_Type is private;
+
+   type Areapool_Acc is access all Areapool;
+
+   --  Modular type for the size.  We don't use Storage_Offset in order to
+   --  make alignment computation efficient (knowing that alignment is a
+   --  power of two).
+   type Size_Type is mod System.Memory_Size;
+
+   --  Allocate SIZE bytes (aligned on ALIGN bytes) in memory pool POOL and
+   --  return the address in RES.
+   procedure Allocate (Pool : in out Areapool;
+                       Res : out Address;
+                       Size : Size_Type;
+                       Align : Size_Type);
+
+   --  Return TRUE iff no memory is allocated in POOL.
+   function Is_Empty (Pool : Areapool) return Boolean;
+
+   --  Higher level abstraction for Allocate.
+   generic
+      type T is private;
+   function Alloc_On_Pool_Addr (Pool : Areapool_Acc; Val : T)
+                               return System.Address;
+
+   --  Get a mark of POOL.
+   procedure Mark (M : out Mark_Type;
+                   Pool : Areapool);
+
+   --  Release memory allocated in POOL after mark M.
+   procedure Release (M : Mark_Type;
+                      Pool : in out Areapool);
+
+   Empty_Marker : constant Mark_Type;
+private
+   --  Minimal size of allocation.
+   Default_Chunk_Size : constant Size_Type := 16 * 1024;
+
+   type Chunk_Type;
+   type Chunk_Acc is access all Chunk_Type;
+
+   type Data_Array is array (Size_Type range <>) of Storage_Element;
+   for Data_Array'Alignment use Standard'Maximum_Alignment;
+
+   type Chunk_Type (Last : Size_Type) is record
+      Prev : Chunk_Acc;
+      Data : Data_Array (0 .. Last);
+   end record;
+   for Chunk_Type'Alignment use Standard'Maximum_Alignment;
+
+   type Areapool is limited record
+      First, Last : Chunk_Acc := null;
+      Next_Use : Size_Type;
+   end record;
+
+   type Mark_Type is record
+      Last : Chunk_Acc := null;
+      Next_Use : Size_Type;
+   end record;
+
+   Empty_Marker : constant Mark_Type := (Last => null, Next_Use => 0);
+
+   Erase_When_Released : constant Boolean := True;
+end Areapools;
diff --git a/src/simulate/debugger.adb b/src/simulate/debugger.adb
new file mode 100644
index 000000000..5a43533d6
--- /dev/null
+++ b/src/simulate/debugger.adb
@@ -0,0 +1,1845 @@
+--  Debugger for interpreter
+--  Copyright (C) 2014 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 GHDL; 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.Text_IO; use Ada.Text_IO;
+with GNAT.Table;
+with Types; use Types;
+with Iir_Values; use Iir_Values;
+with Name_Table;
+with Files_Map;
+with Parse;
+with Scanner;
+with Tokens;
+with Sem_Expr;
+with Sem_Scopes;
+with Std_Names;
+with Libraries;
+with Std_Package;
+with Annotations; use Annotations;
+with Iirs_Utils; use Iirs_Utils;
+with Errorout; use Errorout;
+with Disp_Vhdl;
+with Execution; use Execution;
+with Simulation; use Simulation;
+with Iirs_Walk; use Iirs_Walk;
+with Areapools; use Areapools;
+with Grt.Disp;
+with Grt.Readline;
+with Grt.Errors;
+with Grt.Disp_Signals;
+
+package body Debugger is
+   --  This exception can be raised by a debugger command to directly return
+   --  to the prompt.
+   Command_Error : exception;
+
+   Dbg_Top_Frame : Block_Instance_Acc;
+   Dbg_Cur_Frame : Block_Instance_Acc;
+
+   procedure Set_Cur_Frame (Frame : Block_Instance_Acc) is
+   begin
+      Dbg_Cur_Frame := Frame;
+   end Set_Cur_Frame;
+
+   procedure Set_Top_Frame (Frame : Block_Instance_Acc) is
+   begin
+      Dbg_Top_Frame := Frame;
+      Set_Cur_Frame (Frame);
+   end Set_Top_Frame;
+
+   type Breakpoint_Entry is record
+      Stmt : Iir;
+   end record;
+
+   package Breakpoints is new GNAT.Table
+     (Table_Index_Type => Natural,
+      Table_Component_Type => Breakpoint_Entry,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   --  Current execution state, or reason to stop execution (set by the
+   --  last debugger command).
+   type Exec_State_Type is
+     (--  Execution should continue until a breakpoint is reached or assertion
+      --  failure.
+      Exec_Run,
+
+      --  Execution will stop at the next statement.
+      Exec_Single_Step,
+
+      --  Execution will stop at the next statement in the same frame.
+      Exec_Next);
+
+   Exec_State : Exec_State_Type := Exec_Run;
+
+   Exec_Instance : Block_Instance_Acc;
+
+   -- Disp a message during execution.
+   procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is
+   begin
+      Disp_Iir_Location (Loc);
+      Put (Standard_Error, ' ');
+      Put_Line (Standard_Error, Msg);
+      Grt.Errors.Fatal_Error;
+   end Error_Msg_Exec;
+
+   procedure Warning_Msg_Exec (Msg: String; Loc: Iir) is
+   begin
+      Disp_Iir_Location (Loc);
+      Put (Standard_Error, "warning: ");
+      Put_Line (Standard_Error, Msg);
+   end Warning_Msg_Exec;
+
+   -- Disp a message for a constraint error.
+   procedure Error_Msg_Constraint (Expr: in Iir) is
+   begin
+      if Expr /= Null_Iir then
+         Disp_Iir_Location (Expr);
+      end if;
+      Put (Standard_Error, "constraint violation");
+      if Expr /= Null_Iir then
+         case Get_Kind (Expr) is
+            when Iir_Kind_Addition_Operator =>
+               Put_Line (Standard_Error, " in the ""+"" operation");
+            when Iir_Kind_Substraction_Operator =>
+               Put_Line (Standard_Error, " in the ""-"" operation");
+            when Iir_Kind_Integer_Literal =>
+               Put_Line (Standard_Error, ", literal out of range");
+            when Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_Signal_Declaration =>
+               Put_Line (Standard_Error, " for " & Disp_Node (Expr));
+            when others =>
+               New_Line (Standard_Error);
+         end case;
+      end if;
+      Grt.Errors.Fatal_Error;
+   end Error_Msg_Constraint;
+
+   function Get_Instance_Local_Name (Instance : Block_Instance_Acc;
+                                     Short : Boolean := False)
+                                    return String
+   is
+      Name : constant Iir := Instance.Label;
+   begin
+      if Name = Null_Iir then
+         return "<anon>";
+      end if;
+
+      case Get_Kind (Name) is
+         when Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement
+           | Iir_Kind_Component_Instantiation_Statement
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kinds_Process_Statement =>
+            return Image_Identifier (Name);
+         when Iir_Kind_Iterator_Declaration =>
+            return Image_Identifier (Get_Parent (Name)) & '('
+              & Execute_Image_Attribute
+              (Instance.Objects (Get_Info (Name).Slot), Get_Type (Name))
+              & ')';
+         when Iir_Kind_Architecture_Body =>
+            if Short then
+               return Image_Identifier (Get_Entity (Name));
+            else
+               return Image_Identifier (Get_Entity (Name))
+                 & '(' & Image_Identifier (Name) & ')';
+            end if;
+         when others =>
+            Error_Kind ("disp_instance_local_name", Name);
+      end case;
+   end Get_Instance_Local_Name;
+
+   -- Disp the name of an instance, without newline.
+   procedure Disp_Instance_Name (Instance: Block_Instance_Acc;
+                                 Short : Boolean := False) is
+   begin
+      if Instance.Parent /= null then
+         Disp_Instance_Name (Instance.Parent);
+         Put ('.');
+      end if;
+      Put (Get_Instance_Local_Name (Instance, Short));
+   end Disp_Instance_Name;
+
+   function Get_Instance_Name (Instance: Block_Instance_Acc) return String
+   is
+      function Parent_Name return String is
+      begin
+         if Instance.Parent /= null then
+            return Get_Instance_Name (Instance.Parent) & '.';
+         else
+            return "";
+         end if;
+      end Parent_Name;
+   begin
+      return Parent_Name & Get_Instance_Local_Name (Instance);
+   end Get_Instance_Name;
+
+   procedure Disp_Instances_Tree_Name (Inst : Block_Instance_Acc) is
+   begin
+      if Inst = null then
+         Put ("*null*");
+         New_Line;
+         return;
+      end if;
+      Put (Get_Instance_Local_Name (Inst));
+
+      Put (" ");
+      case Get_Kind (Inst.Label) is
+         when Iir_Kind_Block_Statement =>
+            Put ("[block]");
+         when Iir_Kind_Generate_Statement =>
+            Put ("[generate]");
+         when Iir_Kind_Iterator_Declaration =>
+            Put ("[iterator]");
+         when Iir_Kind_Component_Instantiation_Statement =>
+            Put ("[component]");
+         when Iir_Kinds_Process_Statement =>
+            Put ("[process]");
+         when Iir_Kind_Architecture_Body =>
+            Put ("[entity]");
+         when others =>
+            Error_Kind ("disp_instances_tree1", Inst.Label);
+      end case;
+      New_Line;
+   end Disp_Instances_Tree_Name;
+
+   procedure Disp_Instances_Tree1 (Inst : Block_Instance_Acc; Pfx : String)
+   is
+      Child : Block_Instance_Acc;
+   begin
+      Child := Inst.Children;
+      if Child = null then
+         return;
+      end if;
+
+      loop
+         if Child.Brother /= null then
+            Put (Pfx & "+-");
+            Disp_Instances_Tree_Name (Child);
+
+            Disp_Instances_Tree1 (Child, Pfx & "| ");
+            Child := Child.Brother;
+         else
+            Put (Pfx & "`-");
+            Disp_Instances_Tree_Name (Child);
+
+            Disp_Instances_Tree1 (Child, Pfx & "  ");
+            exit;
+         end if;
+      end loop;
+   end Disp_Instances_Tree1;
+
+   procedure Disp_Instances_Tree is
+   begin
+      Disp_Instances_Tree_Name (Top_Instance);
+      Disp_Instances_Tree1 (Top_Instance, "");
+   end Disp_Instances_Tree;
+
+   --  Disp a block instance, in a human readable way.
+   --  Used to debug.
+   procedure Disp_Block_Instance (Instance: Block_Instance_Acc) is
+   begin
+      Put_Line ("scope level:"
+                  & Scope_Level_Type'Image (Instance.Scope_Level));
+      Put_Line ("Objects:");
+      for I in Instance.Objects'Range loop
+         Put (Object_Slot_Type'Image (I) & ": ");
+         Disp_Value_Tab (Instance.Objects (I), 3);
+         New_Line;
+      end loop;
+   end Disp_Block_Instance;
+
+   procedure Disp_Signal (Value : Iir_Value_Literal_Acc; A_Type : Iir);
+
+   procedure Disp_Signal_Array (Value : Iir_Value_Literal_Acc;
+                                A_Type : Iir;
+                                Dim : Natural)
+   is
+   begin
+      if Dim = Get_Nbr_Elements (Get_Index_Subtype_List (A_Type)) then
+         Put ("(");
+         for I in Value.Val_Array.V'Range loop
+            if I /= 1 then
+               Put (", ");
+            end if;
+            Disp_Signal (Value.Val_Array.V (I), Get_Element_Subtype (A_Type));
+         end loop;
+         Put (")");
+      else
+         Put ("(");
+         Disp_Signal_Array (Value, A_Type, Dim + 1);
+         Put (")");
+      end if;
+   end Disp_Signal_Array;
+
+   procedure Disp_Signal_Record (Value : Iir_Value_Literal_Acc; A_Type : Iir)
+   is
+      El : Iir_Element_Declaration;
+      List : Iir_List;
+   begin
+      List := Get_Elements_Declaration_List (Get_Base_Type (A_Type));
+      Put ("(");
+      for I in Value.Val_Record.V'Range loop
+         El := Get_Nth_Element (List, Natural (I - 1));
+         if I /= 1 then
+            Put (", ");
+         end if;
+         Put (Name_Table.Image (Get_Identifier (El)));
+         Put (" => ");
+         Disp_Signal (Value.Val_Record.V (I), Get_Type (El));
+      end loop;
+      Put (")");
+   end Disp_Signal_Record;
+
+   procedure Disp_Signal (Value : Iir_Value_Literal_Acc; A_Type : Iir) is
+   begin
+      if Value = null then
+         Put ("!NULL!");
+         return;
+      end if;
+      case Value.Kind is
+         when Iir_Value_I64
+           | Iir_Value_F64
+           | Iir_Value_E32
+           | Iir_Value_B1
+           | Iir_Value_Access =>
+            Disp_Iir_Value (Value, A_Type);
+         when Iir_Value_Array =>
+            Disp_Signal_Array (Value, A_Type, 1);
+         when Iir_Value_Record =>
+            Disp_Signal_Record (Value, A_Type);
+         when Iir_Value_Range =>
+            -- FIXME.
+            raise Internal_Error;
+         when Iir_Value_Signal =>
+            Grt.Disp_Signals.Disp_A_Signal (Value.Sig);
+         when Iir_Value_File
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Disp_Signal;
+
+   procedure Disp_Instance_Signal (Instance: Block_Instance_Acc; Decl : Iir)
+   is
+      Info : constant Sim_Info_Acc := Get_Info (Decl);
+   begin
+      Put ("  ");
+      Put (Name_Table.Image (Get_Identifier (Decl)));
+      Put (" = ");
+      Disp_Signal (Instance.Objects (Info.Slot), Get_Type (Decl));
+   end Disp_Instance_Signal;
+
+   procedure Disp_Instance_Signals_Of_Chain (Instance: Block_Instance_Acc;
+                                             Chain : Iir)
+   is
+      El : Iir;
+   begin
+      El := Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Signal_Declaration
+              | Iir_Kind_Signal_Interface_Declaration =>
+               Disp_Instance_Signal (Instance, El);
+            when others =>
+               null;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Instance_Signals_Of_Chain;
+
+   procedure Disp_Instance_Signals (Instance: Block_Instance_Acc)
+   is
+      Blk : constant Iir := Instance.Label;
+      Child: Block_Instance_Acc;
+   begin
+      case Get_Kind (Blk) is
+         when Iir_Kind_Architecture_Body =>
+            declare
+               Ent : constant Iir := Get_Entity (Blk);
+            begin
+               Disp_Instance_Name (Instance);
+               Put_Line (" [architecture]:");
+
+               Disp_Instance_Signals_Of_Chain
+                 (Instance, Get_Port_Chain (Ent));
+               Disp_Instance_Signals_Of_Chain
+                 (Instance, Get_Declaration_Chain (Ent));
+            end;
+         when Iir_Kind_Block_Statement =>
+            Disp_Instance_Name (Instance);
+            Put_Line (" [block]:");
+
+            --  FIXME: ports.
+            Disp_Instance_Signals_Of_Chain
+              (Instance, Get_Declaration_Chain (Blk));
+         when Iir_Kind_Generate_Statement =>
+            Disp_Instance_Name (Instance);
+            Put_Line (" [generate]:");
+
+            Disp_Instance_Signals_Of_Chain
+              (Instance, Get_Declaration_Chain (Blk));
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when Iir_Kinds_Process_Statement =>
+            null;
+         when Iir_Kind_Iterator_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("disp_instance_signals", Instance.Label);
+      end case;
+
+      Child := Instance.Children;
+      while Child /= null loop
+         Disp_Instance_Signals (Child);
+         Child := Child.Brother;
+      end loop;
+   end Disp_Instance_Signals;
+
+   --  Disp all signals name and values.
+   procedure Disp_Signals_Value is
+   begin
+      if Disp_Time_Before_Values then
+         Grt.Disp.Disp_Now;
+      end if;
+      Disp_Instance_Signals (Top_Instance);
+   end Disp_Signals_Value;
+
+   procedure Disp_Objects_Value is
+   begin
+      null;
+--       -- Disp the results.
+--       for I in 0 .. Variables.Last loop
+--          Put (Get_String (Variables.Table (I).Name.all));
+--          Put (" = ");
+--          Put (Get_Str_Value
+--               (Get_Literal (variables.Table (I).Value.all),
+--                Get_Type (variables.Table (I).Value.all)));
+--          if I = variables.Last then
+--             Put_Line (";");
+--          else
+--             Put (", ");
+--          end if;
+--       end loop;
+   end Disp_Objects_Value;
+
+   procedure Disp_Label (Process : Iir)
+   is
+      Label : Name_Id;
+   begin
+         Label := Get_Label (Process);
+         if Label = Null_Identifier then
+            Put ("<unlabeled>");
+         else
+            Put (Name_Table.Image (Label));
+         end if;
+   end Disp_Label;
+
+   procedure Disp_Declaration_Objects
+     (Instance : Block_Instance_Acc; Decl_Chain : Iir)
+   is
+      El : Iir;
+   begin
+      El := Decl_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Constant_Declaration
+              | Iir_Kind_Variable_Declaration
+              | Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration
+              | Iir_Kind_Object_Alias_Declaration =>
+               Put (Disp_Node (El));
+               Put (" = ");
+               Disp_Value_Tab (Instance.Objects (Get_Info (El).Slot), 3);
+            when Iir_Kind_Signal_Interface_Declaration =>
+               declare
+                  Sig : Iir_Value_Literal_Acc;
+               begin
+                  Sig := Instance.Objects (Get_Info (El).Slot);
+                  Put (Disp_Node (El));
+                  Put (" = ");
+                  Disp_Signal (Sig, Get_Type (El));
+                  New_Line;
+               end;
+            when Iir_Kind_Type_Declaration
+              | Iir_Kind_Anonymous_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               --  FIXME: disp ranges
+               null;
+            when Iir_Kind_Implicit_Function_Declaration =>
+               null;
+            when others =>
+               Error_Kind ("disp_declaration_objects", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Declaration_Objects;
+
+   procedure Disp_Objects (Instance : Block_Instance_Acc)
+   is
+      Decl : constant Iir := Instance.Label;
+   begin
+      Disp_Instance_Name (Instance);
+      New_Line;
+      case Get_Kind (Decl) is
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            Disp_Declaration_Objects
+              (Instance, Get_Interface_Declaration_Chain (Decl));
+            Disp_Declaration_Objects
+              (Instance,
+               Get_Declaration_Chain (Get_Subprogram_Body (Decl)));
+         when Iir_Kind_Architecture_Body =>
+            declare
+               Entity : constant Iir_Entity_Declaration := Get_Entity (Decl);
+            begin
+               Disp_Declaration_Objects
+                 (Instance, Get_Generic_Chain (Entity));
+               Disp_Declaration_Objects
+                 (Instance, Get_Port_Chain (Entity));
+               Disp_Declaration_Objects
+                 (Instance, Get_Declaration_Chain (Entity));
+               Disp_Declaration_Objects
+                 (Instance, Get_Declaration_Chain (Decl));
+               --  FIXME: processes.
+            end;
+         when Iir_Kind_Component_Instantiation_Statement =>
+            null;
+         when others =>
+            Error_Kind ("disp_objects", Decl);
+      end case;
+   end Disp_Objects;
+   pragma Unreferenced (Disp_Objects);
+
+   procedure Disp_Process_Stats
+   is
+      Proc : Iir;
+      Stmt : Iir;
+      Nbr_User_Sensitized_Processes : Natural := 0;
+      Nbr_User_If_Sensitized_Processes : Natural := 0;
+      Nbr_Conc_Sensitized_Processes : Natural := 0;
+      Nbr_User_Non_Sensitized_Processes : Natural := 0;
+      Nbr_Conc_Non_Sensitized_Processes : Natural := 0;
+   begin
+      for I in Processes_Table.First .. Processes_Table.Last loop
+         Proc := Processes_Table.Table (I).Label;
+         case Get_Kind (Proc) is
+            when Iir_Kind_Sensitized_Process_Statement =>
+               if Get_Process_Origin (Proc) = Null_Iir then
+                  Stmt := Get_Sequential_Statement_Chain (Proc);
+                  if Stmt /= Null_Iir
+                    and then Get_Kind (Stmt) = Iir_Kind_If_Statement
+                    and then Get_Chain (Stmt) = Null_Iir
+                  then
+                     Nbr_User_If_Sensitized_Processes :=
+                       Nbr_User_If_Sensitized_Processes + 1;
+                  else
+                     Nbr_User_Sensitized_Processes :=
+                       Nbr_User_Sensitized_Processes + 1;
+                  end if;
+               else
+                  Nbr_Conc_Sensitized_Processes :=
+                    Nbr_Conc_Sensitized_Processes + 1;
+               end if;
+            when Iir_Kind_Process_Statement =>
+               if Get_Process_Origin (Proc) = Null_Iir then
+                  Nbr_User_Non_Sensitized_Processes :=
+                    Nbr_User_Non_Sensitized_Processes + 1;
+               else
+                  Nbr_Conc_Non_Sensitized_Processes :=
+                    Nbr_Conc_Non_Sensitized_Processes + 1;
+               end if;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end loop;
+
+      Put (Natural'Image (Nbr_User_If_Sensitized_Processes));
+      Put_Line (" user sensitized processes with only a if stmt");
+      Put (Natural'Image (Nbr_User_Sensitized_Processes));
+      Put_Line (" user sensitized processes (others)");
+      Put (Natural'Image (Nbr_User_Non_Sensitized_Processes));
+      Put_Line (" user non sensitized processes");
+      Put (Natural'Image (Nbr_Conc_Sensitized_Processes));
+      Put_Line (" sensitized concurrent statements");
+      Put (Natural'Image (Nbr_Conc_Non_Sensitized_Processes));
+      Put_Line (" non sensitized concurrent statements");
+      Put (Process_Index_Type'Image (Processes_Table.Last));
+      Put_Line (" processes (total)");
+   end Disp_Process_Stats;
+
+   procedure Disp_Signals_Stats
+   is
+      type Counters_Type is array (Signal_Type_Kind) of Natural;
+      Counters : Counters_Type := (others => 0);
+      Nbr_Signal_Elements : Natural := 0;
+   begin
+      for I in Signals_Table.First .. Signals_Table.Last loop
+         declare
+            Ent : Signal_Entry renames Signals_Table.Table (I);
+         begin
+            if Ent.Kind = User_Signal then
+               Nbr_Signal_Elements := Nbr_Signal_Elements +
+                 Get_Nbr_Of_Scalars (Signals_Table.Table (I).Sig);
+            end if;
+            Counters (Ent.Kind) := Counters (Ent.Kind) + 1;
+         end;
+      end loop;
+      Put (Integer'Image (Counters (User_Signal)));
+      Put_Line (" declared user signals or ports");
+      Put (Integer'Image (Nbr_Signal_Elements));
+      Put_Line (" user signals sub-elements");
+      Put (Integer'Image (Counters (Implicit_Quiet)));
+      Put_Line (" 'quiet implicit signals");
+      Put (Integer'Image (Counters (Implicit_Stable)));
+      Put_Line (" 'stable implicit signals");
+      Put (Integer'Image (Counters (Implicit_Delayed)));
+      Put_Line (" 'delayed implicit signals");
+      Put (Integer'Image (Counters (Implicit_Transaction)));
+      Put_Line (" 'transaction implicit signals");
+      Put (Integer'Image (Counters (Guard_Signal)));
+      Put_Line (" guard signals");
+   end Disp_Signals_Stats;
+
+   procedure Disp_Design_Stats is
+   begin
+      Disp_Process_Stats;
+
+      New_Line;
+
+      Disp_Signals_Stats;
+
+      New_Line;
+
+      Put (Integer'Image (Connect_Table.Last));
+      Put_Line (" connections");
+   end Disp_Design_Stats;
+
+   procedure Disp_Design_Non_Sensitized
+   is
+      Instance : Block_Instance_Acc;
+      Proc : Iir;
+   begin
+      for I in Processes_Table.First .. Processes_Table.Last loop
+         Instance := Processes_Table.Table (I);
+         Proc := Processes_Table.Table (I).Label;
+         if Get_Kind (Proc) = Iir_Kind_Process_Statement then
+            Disp_Instance_Name (Instance);
+            New_Line;
+            Put_Line ("   at " & Disp_Location (Proc));
+         end if;
+      end loop;
+   end Disp_Design_Non_Sensitized;
+
+   procedure Disp_Design_Connections is
+   begin
+      for I in Connect_Table.First .. Connect_Table.Last loop
+         declare
+            Conn : Connect_Entry renames Connect_Table.Table (I);
+         begin
+            Disp_Iir_Location (Conn.Assoc);
+            New_Line;
+         end;
+      end loop;
+   end Disp_Design_Connections;
+
+   function Walk_Files (Cb : Walk_Cb) return Walk_Status
+   is
+      Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain;
+      File : Iir_Design_File;
+   begin
+      while Lib /= Null_Iir loop
+         File := Get_Design_File_Chain (Lib);
+         while File /= Null_Iir loop
+            case Cb.all (File) is
+               when Walk_Continue =>
+                  null;
+               when Walk_Up =>
+                  exit;
+               when Walk_Abort =>
+                  return Walk_Abort;
+            end case;
+            File := Get_Chain (File);
+         end loop;
+         Lib := Get_Chain (Lib);
+      end loop;
+      return Walk_Continue;
+   end Walk_Files;
+
+   Walk_Units_Cb : Walk_Cb;
+
+   function Cb_Walk_Units (Design_File : Iir) return Walk_Status
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (Design_File);
+      while Unit /= Null_Iir loop
+         case Walk_Units_Cb.all (Get_Library_Unit (Unit)) is
+            when Walk_Continue =>
+               null;
+            when Walk_Abort =>
+               return Walk_Abort;
+            when Walk_Up =>
+               exit;
+         end case;
+         Unit := Get_Chain (Unit);
+      end loop;
+      return Walk_Continue;
+   end Cb_Walk_Units;
+
+   function Walk_Units (Cb : Walk_Cb) return Walk_Status is
+   begin
+      Walk_Units_Cb := Cb;
+      return Walk_Files (Cb_Walk_Units'Access);
+   end Walk_Units;
+
+   Walk_Declarations_Cb : Walk_Cb;
+
+   function Cb_Walk_Declarations (Unit : Iir) return Walk_Status
+   is
+      function Walk_Decl_Chain (Chain : Iir) return Walk_Status
+      is
+         Decl : Iir;
+      begin
+         Decl := Chain;
+         while Decl /= Null_Iir loop
+            case Walk_Declarations_Cb.all (Decl) is
+               when Walk_Abort =>
+                  return Walk_Abort;
+               when Walk_Up =>
+                  return Walk_Continue;
+               when Walk_Continue =>
+                  null;
+            end case;
+            Decl := Get_Chain (Decl);
+         end loop;
+         return Walk_Continue;
+      end Walk_Decl_Chain;
+
+      function Walk_Conc_Chain (Chain : Iir) return Walk_Status
+      is
+         Stmt : Iir := Chain;
+      begin
+         while Stmt /= Null_Iir loop
+            case Get_Kind (Stmt) is
+               when Iir_Kind_Process_Statement =>
+                  if Walk_Decl_Chain (Get_Declaration_Chain (Stmt))
+                    = Walk_Abort
+                  then
+                     return Walk_Abort;
+                  end if;
+               when others =>
+                  Error_Kind ("walk_conc_chain", Stmt);
+            end case;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+         return Walk_Continue;
+      end Walk_Conc_Chain;
+   begin
+      case Get_Kind (Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            if Walk_Decl_Chain (Get_Generic_Chain (Unit)) = Walk_Abort
+              or else Walk_Decl_Chain (Get_Port_Chain (Unit)) = Walk_Abort
+              or else (Walk_Decl_Chain
+                         (Get_Declaration_Chain (Unit)) = Walk_Abort)
+              or else (Walk_Conc_Chain
+                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Architecture_Body =>
+            if (Walk_Decl_Chain
+                  (Get_Declaration_Chain (Unit)) = Walk_Abort)
+              or else (Walk_Conc_Chain
+                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body =>
+            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Configuration_Declaration =>
+            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
+            then
+               return Walk_Abort;
+            end if;
+            --  FIXME: block configuration ?
+         when others =>
+            Error_Kind ("Cb_Walk_Declarations", Unit);
+      end case;
+      return Walk_Continue;
+   end Cb_Walk_Declarations;
+
+   function Walk_Declarations (Cb : Walk_Cb) return Walk_Status is
+   begin
+      Walk_Declarations_Cb := Cb;
+      return Walk_Units (Cb_Walk_Declarations'Access);
+   end Walk_Declarations;
+
+   function Is_Blank (C : Character) return Boolean is
+   begin
+      return C = ' ' or else C = ASCII.HT;
+   end Is_Blank;
+
+   function Skip_Blanks (S : String) return Positive
+   is
+      P : Positive := S'First;
+   begin
+      while P <= S'Last and then Is_Blank (S (P)) loop
+         P := P + 1;
+      end loop;
+      return P;
+   end Skip_Blanks;
+
+   --  Return the position of the last character of the word (the last
+   --  non-blank character).
+   function Get_Word (S : String) return Positive
+   is
+      P : Positive := S'First;
+   begin
+      while P <= S'Last and then not Is_Blank (S (P)) loop
+         P := P + 1;
+      end loop;
+      return P - 1;
+   end Get_Word;
+
+   procedure Disp_A_Frame (Instance: Block_Instance_Acc) is
+   begin
+      Put (Disp_Node (Instance.Label));
+      if Instance.Stmt /= Null_Iir then
+         Put (" at ");
+         Put (Get_Location_Str (Get_Location (Instance.Stmt)));
+      end if;
+      New_Line;
+   end Disp_A_Frame;
+
+   type Menu_Kind is (Menu_Command, Menu_Submenu);
+   type Menu_Entry (Kind : Menu_Kind);
+   type Menu_Entry_Acc is access all Menu_Entry;
+
+   type Cst_String_Acc is access constant String;
+
+   type Menu_Procedure is access procedure (Line : String);
+
+   type Menu_Entry (Kind : Menu_Kind) is record
+      Name : Cst_String_Acc;
+      Next : Menu_Entry_Acc;
+
+      case Kind is
+         when Menu_Command =>
+            Proc : Menu_Procedure;
+         when Menu_Submenu =>
+            First, Last : Menu_Entry_Acc := null;
+      end case;
+   end record;
+
+   --  Check there is a current process.
+   procedure Check_Current_Process is
+   begin
+      if Current_Process = null then
+         Put_Line ("no current process");
+         raise Command_Error;
+      end if;
+   end Check_Current_Process;
+
+   --  The status of the debugger.  This status can be modified by a command
+   --  as a side effect to resume or quit the debugger.
+   type Command_Status_Type is (Status_Default, Status_Quit);
+   Command_Status : Command_Status_Type;
+
+   procedure Help_Proc (Line : String);
+
+   procedure Disp_Process_Loc (Proc : Process_State_Type) is
+   begin
+      Disp_Instance_Name (Proc.Top_Instance);
+      Put (" (" & Get_Location_Str (Get_Location (Proc.Proc)) & ")");
+      New_Line;
+   end Disp_Process_Loc;
+
+   --  Disp the list of processes (and its state)
+   procedure Ps_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Process : Iir;
+   begin
+      if Processes_State = null then
+         Put_Line ("no processes");
+         return;
+      end if;
+
+      for I in Processes_State'Range loop
+         Put (Process_Index_Type'Image (I) & ": ");
+         Process := Processes_State (I).Proc;
+         if Process /= Null_Iir then
+            Disp_Process_Loc (Processes_State (I));
+            Disp_A_Frame (Processes_State (I).Instance);
+         else
+            Put_Line ("not yet elaborated");
+         end if;
+      end loop;
+   end Ps_Proc;
+
+   procedure Up_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+   begin
+      Check_Current_Process;
+      if Dbg_Cur_Frame.Parent = null then
+         Put_Line ("top of frames reached");
+      else
+         Set_Cur_Frame (Dbg_Cur_Frame.Parent);
+      end if;
+   end Up_Proc;
+
+   procedure Down_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+      Inst : Block_Instance_Acc;
+   begin
+      Check_Current_Process;
+      if Dbg_Cur_Frame = Dbg_Top_Frame then
+         Put_Line ("bottom of frames reached");
+      else
+         Inst := Dbg_Top_Frame;
+         while Inst.Parent /= Dbg_Cur_Frame loop
+            Inst := Inst.Parent;
+         end loop;
+         Set_Cur_Frame (Inst);
+      end if;
+   end Down_Proc;
+
+   procedure Set_Breakpoint (Stmt : Iir) is
+   begin
+      Put_Line
+        ("set breakpoint at: " & Get_Location_Str (Get_Location (Stmt)));
+      Breakpoints.Append (Breakpoint_Entry'(Stmt => Stmt));
+      Flag_Need_Debug := True;
+   end Set_Breakpoint;
+
+   procedure Next_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+   begin
+      Exec_State := Exec_Next;
+      Exec_Instance := Dbg_Top_Frame;
+      Flag_Need_Debug := True;
+      Command_Status := Status_Quit;
+   end Next_Proc;
+
+   procedure Step_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+   begin
+      Exec_State := Exec_Single_Step;
+      Flag_Need_Debug := True;
+      Command_Status := Status_Quit;
+   end Step_Proc;
+
+   Break_Id : Name_Id;
+
+   function Cb_Set_Break (El : Iir) return Walk_Status is
+   begin
+      case Get_Kind (El) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            if Get_Identifier (El) = Break_Id then
+               Set_Breakpoint
+                 (Get_Sequential_Statement_Chain (Get_Subprogram_Body (El)));
+            end if;
+         when others =>
+            null;
+      end case;
+      return Walk_Continue;
+   end Cb_Set_Break;
+
+   procedure Break_Proc (Line : String)
+   is
+      Status : Walk_Status;
+      P : Natural;
+   begin
+      P := Skip_Blanks (Line);
+      Break_Id := Name_Table.Get_Identifier (Line (P .. Line'Last));
+      Status := Walk_Declarations (Cb_Set_Break'Access);
+      pragma Assert (Status = Walk_Continue);
+   end Break_Proc;
+
+   procedure Where_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Frame : Block_Instance_Acc;
+   begin
+      Check_Current_Process;
+      Frame := Dbg_Top_Frame;
+      while Frame /= null loop
+         if Frame = Dbg_Cur_Frame then
+            Put ("* ");
+         else
+            Put ("  ");
+         end if;
+         Disp_A_Frame (Frame);
+         Frame := Frame.Parent;
+      end loop;
+   end Where_Proc;
+
+   procedure Info_Tree_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+   begin
+      if Top_Instance = null then
+         Put_Line ("design not yet fully elaborated");
+      else
+         Disp_Instances_Tree;
+      end if;
+   end Info_Tree_Proc;
+
+   procedure Info_Params_Proc (Line : String)
+   is
+      pragma Unreferenced (Line);
+      Decl : Iir;
+      Params : Iir;
+   begin
+      Check_Current_Process;
+      Decl := Dbg_Cur_Frame.Label;
+      if Decl = Null_Iir
+        or else Get_Kind (Decl) not in Iir_Kinds_Subprogram_Declaration
+      then
+         Put_Line ("current frame is not a subprogram");
+         return;
+      end if;
+      Params := Get_Interface_Declaration_Chain (Decl);
+      Disp_Declaration_Objects (Dbg_Cur_Frame, Params);
+   end Info_Params_Proc;
+
+   procedure Info_Proc_Proc (Line : String) is
+      pragma Unreferenced (Line);
+   begin
+      Check_Current_Process;
+      Disp_Process_Loc (Current_Process.all);
+   end Info_Proc_Proc;
+
+   function Cb_Disp_Subprograms (El : Iir) return Walk_Status is
+   begin
+      case Get_Kind (El) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            Put_Line (Name_Table.Image (Get_Identifier (El)));
+         when others =>
+            null;
+      end case;
+      return Walk_Continue;
+   end Cb_Disp_Subprograms;
+
+   procedure Info_Subprograms_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Status : Walk_Status;
+   begin
+      Status := Walk_Declarations (Cb_Disp_Subprograms'Access);
+      pragma Assert (Status = Walk_Continue);
+   end Info_Subprograms_Proc;
+
+   function Cb_Disp_Units (El : Iir) return Walk_Status is
+   begin
+      case Get_Kind (El) is
+         when Iir_Kind_Package_Declaration =>
+            Put ("package ");
+            Put_Line (Name_Table.Image (Get_Identifier (El)));
+         when Iir_Kind_Entity_Declaration =>
+            Put ("entity ");
+            Put_Line (Name_Table.Image (Get_Identifier (El)));
+         when Iir_Kind_Architecture_Body =>
+            Put ("architecture ");
+            Put (Name_Table.Image (Get_Identifier (El)));
+            Put (" of ");
+            Put_Line (Name_Table.Image (Get_Identifier (Get_Entity (El))));
+         when Iir_Kind_Configuration_Declaration =>
+            Put ("configuration ");
+            Put_Line (Name_Table.Image (Get_Identifier (El)));
+         when Iir_Kind_Package_Body =>
+            null;
+         when others =>
+            Error_Kind ("cb_disp_units", El);
+      end case;
+      return Walk_Continue;
+   end Cb_Disp_Units;
+
+   procedure Info_Units_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Status : Walk_Status;
+   begin
+      Status := Walk_Units (Cb_Disp_Units'Access);
+      pragma Assert (Status = Walk_Continue);
+   end Info_Units_Proc;
+
+   function Cb_Disp_File (El : Iir) return Walk_Status is
+   begin
+      Put_Line (Name_Table.Image (Get_Design_File_Filename (El)));
+      return Walk_Continue;
+   end Cb_Disp_File;
+
+   procedure Info_Stats_Proc (Line : String) is
+      P : Natural := Line'First;
+      E : Natural;
+   begin
+      P := Skip_Blanks (Line (P .. Line'Last));
+      if P > Line'Last then
+         --  No parameters.
+         Disp_Design_Stats;
+         return;
+      end if;
+
+      E := Get_Word (Line (P .. Line'Last));
+      if Line (P .. E) = "global" then
+         Disp_Design_Stats;
+      elsif Line (P .. E) = "non-sensitized" then
+         Disp_Design_Non_Sensitized;
+         null;
+      elsif Line (P .. E) = "connections" then
+         Disp_Design_Connections;
+         --  TODO: nbr of conversions
+      else
+         Put_Line ("options are: global, non-sensitized, connections");
+         --  TODO: signals: nbr of scalars, nbr of non-user...
+      end if;
+   end Info_Stats_Proc;
+
+   procedure Info_Files_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Status : Walk_Status;
+   begin
+      Status := Walk_Files (Cb_Disp_File'Access);
+      pragma Assert (Status = Walk_Continue);
+   end Info_Files_Proc;
+
+   procedure Info_Libraries_Proc (Line : String) is
+      pragma Unreferenced (Line);
+      Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain;
+   begin
+      while Lib /= Null_Iir loop
+         Put_Line (Name_Table.Image (Get_Identifier (Lib)));
+         Lib := Get_Chain (Lib);
+      end loop;
+   end Info_Libraries_Proc;
+
+   procedure Disp_Declared_Signals_Chain
+     (Chain : Iir; Instance : Block_Instance_Acc)
+   is
+      pragma Unreferenced (Instance);
+      Decl : Iir;
+   begin
+      Decl := Chain;
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_Signal_Declaration =>
+               Put_Line (" " & Name_Table.Image (Get_Identifier (Decl)));
+            when others =>
+               null;
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Disp_Declared_Signals_Chain;
+
+   procedure Disp_Declared_Signals (Decl : Iir; Instance : Block_Instance_Acc)
+   is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            Disp_Declared_Signals (Get_Parent (Decl), Instance);
+         when Iir_Kind_Architecture_Body =>
+            Disp_Declared_Signals (Get_Entity (Decl), Instance);
+         when Iir_Kind_Entity_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("disp_declared_signals", Decl);
+      end case;
+
+      case Get_Kind (Decl) is
+         when Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Process_Statement =>
+            --  No signal declaration in a process (FIXME: implicit signals)
+            null;
+         when Iir_Kind_Architecture_Body =>
+            Put_Line ("Signals of architecture "
+                        & Name_Table.Image (Get_Identifier (Decl)) & ':');
+            Disp_Declared_Signals_Chain
+              (Get_Declaration_Chain (Decl), Instance);
+         when Iir_Kind_Entity_Declaration =>
+            Put_Line ("Ports of entity "
+                        & Name_Table.Image (Get_Identifier (Decl)) & ':');
+            Disp_Declared_Signals_Chain
+              (Get_Port_Chain (Decl), Instance);
+         when others =>
+            Error_Kind ("disp_declared_signals (2)", Decl);
+      end case;
+   end Disp_Declared_Signals;
+
+   procedure Info_Signals_Proc (Line : String) is
+      pragma Unreferenced (Line);
+   begin
+      Check_Current_Process;
+      Disp_Declared_Signals
+        (Current_Process.Proc, Current_Process.Top_Instance);
+   end Info_Signals_Proc;
+
+   type Handle_Scope_Type is access procedure (N : Iir);
+
+   procedure Foreach_Scopes (N : Iir; Handler : Handle_Scope_Type) is
+   begin
+      case Get_Kind (N) is
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement =>
+            Foreach_Scopes (Get_Parent (N), Handler);
+            Handler.all (N);
+         when Iir_Kind_Architecture_Body =>
+            Foreach_Scopes (Get_Entity (N), Handler);
+            Handler.all (N);
+
+         when Iir_Kind_Entity_Declaration =>
+            --  Top of scopes.
+            null;
+
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            Foreach_Scopes (Get_Parent (N), Handler);
+            Handler.all (N);
+         when Iir_Kind_Package_Body =>
+            Handler.all (N);
+
+         when Iir_Kind_Variable_Assignment_Statement
+           | Iir_Kind_Signal_Assignment_Statement
+           | Iir_Kind_Null_Statement
+           | Iir_Kind_Assertion_Statement
+           | Iir_Kind_Report_Statement
+           | Iir_Kind_Wait_Statement
+           | Iir_Kind_Return_Statement
+           | Iir_Kind_Next_Statement
+           | Iir_Kind_Exit_Statement
+           | Iir_Kind_Procedure_Call_Statement
+           | Iir_Kind_If_Statement
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Case_Statement =>
+            Foreach_Scopes (Get_Parent (N), Handler);
+
+         when Iir_Kind_For_Loop_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            Foreach_Scopes (Get_Parent (N), Handler);
+            Handler.all (N);
+
+         when others =>
+            Error_Kind ("foreach_scopes", N);
+      end case;
+   end Foreach_Scopes;
+
+   procedure Add_Decls_For (N : Iir)
+   is
+      use Sem_Scopes;
+   begin
+      case Get_Kind (N) is
+         when Iir_Kind_Entity_Declaration =>
+            declare
+               Unit : constant Iir := Get_Design_Unit (N);
+            begin
+               Add_Context_Clauses (Unit);
+               --  Add_Name (Unit, Get_Identifier (N), False);
+               Add_Entity_Declarations (N);
+            end;
+         when Iir_Kind_Architecture_Body =>
+            Open_Declarative_Region;
+            Add_Context_Clauses (Get_Design_Unit (N));
+            Add_Declarations (Get_Declaration_Chain (N), False);
+            Add_Declarations_Of_Concurrent_Statement (N);
+         when Iir_Kind_Package_Body =>
+            declare
+               Package_Decl : constant Iir := Get_Package (N);
+               Package_Unit : constant Iir := Get_Design_Unit (Package_Decl);
+            begin
+               Add_Name (Package_Unit);
+               Add_Context_Clauses (Package_Unit);
+               Open_Declarative_Region;
+               Add_Declarations (Get_Declaration_Chain (Package_Decl), False);
+               Add_Declarations (Get_Declaration_Chain (N), False);
+            end;
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            declare
+               Spec : constant Iir := Get_Subprogram_Specification (N);
+            begin
+               Open_Declarative_Region;
+               Add_Declarations
+                 (Get_Interface_Declaration_Chain (Spec), False);
+               Add_Declarations
+                 (Get_Declaration_Chain (N), False);
+            end;
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement =>
+            Open_Declarative_Region;
+            Add_Declarations (Get_Declaration_Chain (N), False);
+         when Iir_Kind_For_Loop_Statement =>
+            Open_Declarative_Region;
+            Add_Name (Get_Parameter_Specification (N));
+         when Iir_Kind_Block_Statement =>
+            Open_Declarative_Region;
+            Add_Declarations (Get_Declaration_Chain (N), False);
+            Add_Declarations_Of_Concurrent_Statement (N);
+         when Iir_Kind_Generate_Statement =>
+            Open_Declarative_Region;
+            Add_Declarations (Get_Declaration_Chain (N), False);
+            Add_Declarations_Of_Concurrent_Statement (N);
+         when others =>
+            Error_Kind ("enter_scope(2)", N);
+      end case;
+   end Add_Decls_For;
+
+   procedure Enter_Scope (Node : Iir)
+   is
+      use Sem_Scopes;
+   begin
+      Push_Interpretations;
+      Open_Declarative_Region;
+
+      --  Add STD
+      Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False);
+      Use_All_Names (Std_Package.Standard_Package);
+
+      Foreach_Scopes (Node, Add_Decls_For'Access);
+   end Enter_Scope;
+
+   procedure Del_Decls_For (N : Iir)
+   is
+      use Sem_Scopes;
+   begin
+      case Get_Kind (N) is
+         when Iir_Kind_Entity_Declaration =>
+            null;
+         when Iir_Kind_Architecture_Body =>
+            Close_Declarative_Region;
+         when Iir_Kind_Process_Statement
+           | Iir_Kind_Sensitized_Process_Statement
+           | Iir_Kind_Package_Body
+           | Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body
+           | Iir_Kind_For_Loop_Statement
+           | Iir_Kind_Block_Statement
+           | Iir_Kind_Generate_Statement =>
+            Close_Declarative_Region;
+         when others =>
+            Error_Kind ("Decl_Decls_For", N);
+      end case;
+   end Del_Decls_For;
+
+   procedure Leave_Scope (Node : Iir)
+   is
+      use Sem_Scopes;
+   begin
+      Foreach_Scopes (Node, Del_Decls_For'Access);
+
+      Close_Declarative_Region;
+      Pop_Interpretations;
+   end Leave_Scope;
+
+   Buffer_Index : Natural := 1;
+
+   procedure Print_Proc (Line : String)
+   is
+      use Tokens;
+      Index_Str : String := Natural'Image (Buffer_Index);
+      File : Source_File_Entry;
+      Expr : Iir;
+      Res : Iir_Value_Literal_Acc;
+      P : Natural;
+      Opt_Value : Boolean := False;
+      Marker : Mark_Type;
+   begin
+      --  Decode options: /v
+      P := Line'First;
+      loop
+         P := Skip_Blanks (Line (P .. Line'Last));
+         if P + 2 < Line'Last and then Line (P .. P + 1) = "/v" then
+            Opt_Value := True;
+            P := P + 2;
+         else
+            exit;
+         end if;
+      end loop;
+
+      Buffer_Index := Buffer_Index + 1;
+      Index_Str (Index_Str'First) := '*';
+      File := Files_Map.Create_Source_File_From_String
+        (Name_Table.Get_Identifier ("*debug" & Index_Str & '*'),
+         Line (P .. Line'Last));
+      Scanner.Set_File (File);
+      Scanner.Scan;
+      Expr := Parse.Parse_Expression;
+      if Scanner.Current_Token /= Tok_Eof then
+         Put_Line ("garbage at end of expression ignored");
+      end if;
+      Scanner.Close_File;
+      if Nbr_Errors /= 0 then
+         Put_Line ("error while parsing expression, evaluation aborted");
+         Nbr_Errors := 0;
+         return;
+      end if;
+
+      Enter_Scope (Dbg_Cur_Frame.Stmt);
+      Expr := Sem_Expr.Sem_Expression_Universal (Expr);
+      Leave_Scope (Dbg_Cur_Frame.Stmt);
+
+      if Expr = Null_Iir
+        or else Nbr_Errors /= 0
+      then
+         Put_Line ("error while analyzing expression, evaluation aborted");
+         Nbr_Errors := 0;
+         return;
+      end if;
+
+      Disp_Vhdl.Disp_Expression (Expr);
+      New_Line;
+
+      Annotate_Expand_Table;
+
+      Mark (Marker, Expr_Pool);
+
+      Res := Execute_Expression (Dbg_Cur_Frame, Expr);
+      if Opt_Value then
+         Disp_Value (Res);
+      else
+         Disp_Iir_Value (Res, Get_Type (Expr));
+      end if;
+      New_Line;
+
+      --  Free value
+      Release (Marker, Expr_Pool);
+   end Print_Proc;
+
+   procedure Quit_Proc (Line : String) is
+      pragma Unreferenced (Line);
+   begin
+      Command_Status := Status_Quit;
+      raise Debugger_Quit;
+   end Quit_Proc;
+
+   procedure Cont_Proc (Line : String) is
+      pragma Unreferenced (Line);
+   begin
+      Command_Status := Status_Quit;
+
+      --  Set Flag_Need_Debug only if there is at least one enabled breakpoint.
+      Flag_Need_Debug := False;
+      for I in Breakpoints.First .. Breakpoints.Last loop
+         Flag_Need_Debug := True;
+         exit;
+      end loop;
+   end Cont_Proc;
+
+   Menu_Info_Stats : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("stats"),
+      Next => null,
+      Proc => Info_Stats_Proc'Access);
+
+   Menu_Info_Tree : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("tree"),
+      Next => Menu_Info_Stats'Access,
+      Proc => Info_Tree_Proc'Access);
+
+   Menu_Info_Params : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("param*eters"),
+      Next => Menu_Info_Tree'Access,
+      Proc => Info_Params_Proc'Access);
+
+   Menu_Info_Subprograms : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("subp*rograms"),
+      Next => Menu_Info_Params'Access,
+      Proc => Info_Subprograms_Proc'Access);
+
+   Menu_Info_Units : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("units"),
+      Next => Menu_Info_Subprograms'Access,
+      Proc => Info_Units_Proc'Access);
+
+   Menu_Info_Files : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("files"),
+      Next => Menu_Info_Units'Access,
+      Proc => Info_Files_Proc'Access);
+
+   Menu_Info_Libraries : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("lib*raries"),
+      Next => Menu_Info_Files'Access,
+      Proc => Info_Libraries_Proc'Access);
+
+   Menu_Info_Signals : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("sig*nals"),
+      Next => Menu_Info_Libraries'Access,
+      Proc => Info_Signals_Proc'Access);
+
+   Menu_Info_Proc : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("proc*esses"),
+      Next => Menu_Info_Signals'Access,
+      Proc => Info_Proc_Proc'Access);
+
+   Menu_Down : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("down"),
+      Next => null,
+      Proc => Down_Proc'Access);
+
+   Menu_Up : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("up"),
+      Next => Menu_Down'Access,
+      Proc => Up_Proc'Access);
+
+   Menu_Next : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("n*ext"),
+      Next => Menu_Up'Access,
+      Proc => Next_Proc'Access);
+
+   Menu_Step : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("s*tep"),
+      Next => Menu_Next'Access,
+      Proc => Step_Proc'Access);
+
+   Menu_Break : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("b*reak"),
+      Next => Menu_Step'Access,
+      Proc => Break_Proc'Access);
+
+   Menu_Where : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("where"),
+      Next => Menu_Break'Access,
+      Proc => Where_Proc'Access);
+
+   Menu_Ps : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("ps"),
+      Next => Menu_Where'Access,
+      Proc => Ps_Proc'Access);
+
+   Menu_Info : aliased Menu_Entry :=
+     (Kind => Menu_Submenu,
+      Name => new String'("i*nfo"),
+      Next => Menu_Ps'Access,
+      First | Last => Menu_Info_Proc'Access);
+
+   Menu_Print : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("pr*int"),
+      Next => Menu_Info'Access,
+      Proc => Print_Proc'Access);
+
+   Menu_Cont : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("c*ont"),
+      Next => Menu_Print'Access,
+      Proc => Cont_Proc'Access);
+
+   Menu_Quit : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("q*uit"),
+      Next => Menu_Cont'Access,
+      Proc => Quit_Proc'Access);
+
+   Menu_Help1 : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("help"),
+      Next => Menu_Quit'Access,
+      Proc => Help_Proc'Access);
+
+   Menu_Help2 : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("?"),
+      Next => Menu_Help1'Access,
+      Proc => Help_Proc'Access);
+
+   Menu_Top : aliased Menu_Entry :=
+     (Kind => Menu_Submenu,
+      Name => null,
+      Next => null,
+      First | Last => Menu_Help2'Access);
+
+   function Find_Menu (Menu : Menu_Entry_Acc; Cmd : String)
+                      return Menu_Entry_Acc
+   is
+      function Is_Cmd (Cmd_Name : String; Str : String) return Boolean
+      is
+         -- Number of characters that were compared.
+         P : Natural;
+      begin
+         P := 0;
+         --  Prefix (before the '*').
+         loop
+            if P = Cmd_Name'Length then
+               --  Full match.
+               return P = Str'Length;
+            end if;
+            exit when Cmd_Name (Cmd_Name'First + P) = '*';
+            if P = Str'Length then
+               --  Command is too short
+               return False;
+            end if;
+            if Cmd_Name (Cmd_Name'First + P) /= Str (Str'First + P) then
+               return False;
+            end if;
+            P := P + 1;
+         end loop;
+         --  Suffix (after the '*')
+         loop
+            if P = Str'Length then
+               return True;
+            end if;
+            if P + 1 = Cmd_Name'Length then
+               --  String is too long
+               return False;
+            end if;
+            if Cmd_Name (Cmd_Name'First + P + 1) /= Str (Str'First + P) then
+               return False;
+            end if;
+            P := P + 1;
+         end loop;
+      end Is_Cmd;
+      Ent : Menu_Entry_Acc;
+   begin
+      Ent := Menu.First;
+      while Ent /= null loop
+         if Is_Cmd (Ent.Name.all, Cmd) then
+            return Ent;
+         end if;
+         Ent := Ent.Next;
+      end loop;
+      return null;
+   end Find_Menu;
+
+   procedure Parse_Command (Line : String;
+                            P : in out Natural;
+                            Menu : out Menu_Entry_Acc)
+   is
+      E : Natural;
+   begin
+      P := Skip_Blanks (Line (P .. Line'Last));
+      if P > Line'Last then
+         return;
+      end if;
+      E := Get_Word (Line (P .. Line'Last));
+      Menu := Find_Menu (Menu, Line (P .. E));
+      if Menu = null then
+         Put_Line ("command '" & Line (P .. E) & "' not found");
+      end if;
+      P := E + 1;
+   end Parse_Command;
+
+   procedure Help_Proc (Line : String) is
+      P : Natural;
+      Root : Menu_Entry_Acc := Menu_Top'access;
+   begin
+      Put_Line ("This is the help command");
+      P := Line'First;
+      while P < Line'Last loop
+         Parse_Command (Line, P, Root);
+         if Root = null then
+            return;
+         elsif Root.Kind /= Menu_Submenu then
+            Put_Line ("Menu entry " & Root.Name.all & " is not a submenu");
+            return;
+         end if;
+      end loop;
+
+      Root := Root.First;
+      while Root /= null loop
+         Put (Root.Name.all);
+         if Root.Kind = Menu_Submenu then
+            Put (" (menu)");
+         end if;
+         New_Line;
+         Root := Root.Next;
+      end loop;
+   end Help_Proc;
+
+   procedure Disp_Source_Line (Loc : Location_Type)
+   is
+      use Files_Map;
+
+      File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Line : Natural;
+      Offset : Natural;
+      Buf : File_Buffer_Acc;
+      Next_Line_Pos : Source_Ptr;
+   begin
+      Location_To_Coord (Loc, File, Line_Pos, Line, Offset);
+      Buf := Get_File_Source (File);
+      Next_Line_Pos := Line_To_Position (File, Line + 1);
+      Put (String (Buf (Line_Pos .. Next_Line_Pos - 1)));
+   end Disp_Source_Line;
+
+   function Breakpoint_Hit return Natural
+   is
+      Stmt : constant Iir := Current_Process.Instance.Stmt;
+   begin
+      for I in Breakpoints.First .. Breakpoints.Last loop
+         if Stmt = Breakpoints.Table (I).Stmt then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Breakpoint_Hit;
+
+   Prompt_Debug : constant String := "debug> " & ASCII.NUL;
+   Prompt_Crash : constant String := "crash> " & ASCII.NUL;
+   Prompt_Init  : constant String := "init> " & ASCII.NUL;
+   Prompt_Elab  : constant String := "elab> " & ASCII.NUL;
+
+   procedure Debug (Reason: Debug_Reason) is
+      use Grt.Readline;
+      Raw_Line : Char_Ptr;
+      Prompt : System.Address;
+   begin
+      --  Unless interractive, do not use the debugger.
+      if Reason /= Reason_Internal_Debug then
+         if not Flag_Interractive then
+            return;
+         end if;
+      end if;
+
+      Prompt := Prompt_Debug'Address;
+
+      case Reason is
+         when Reason_Start =>
+            Set_Top_Frame (null);
+            Prompt := Prompt_Init'Address;
+         when Reason_Elab =>
+            Set_Top_Frame (null);
+            Prompt := Prompt_Elab'Address;
+         when Reason_Internal_Debug =>
+            if Current_Process = null then
+               Set_Top_Frame (null);
+            else
+               Set_Top_Frame (Current_Process.Instance);
+            end if;
+         when Reason_Break =>
+            case Exec_State is
+               when Exec_Run =>
+                  if Breakpoint_Hit /= 0 then
+                     Put_Line ("breakpoint hit");
+                  else
+                     return;
+                  end if;
+               when Exec_Single_Step =>
+                  --  Default state.
+                  Exec_State := Exec_Run;
+               when Exec_Next =>
+                  if Current_Process.Instance /= Exec_Instance then
+                     return;
+                  end if;
+                  --  Default state.
+                  Exec_State := Exec_Run;
+            end case;
+            Set_Top_Frame (Current_Process.Instance);
+            declare
+               Stmt : constant Iir := Dbg_Cur_Frame.Stmt;
+            begin
+               Put ("stopped at: ");
+               Disp_Iir_Location (Stmt);
+               New_Line;
+               Disp_Source_Line (Get_Location (Stmt));
+            end;
+         when Reason_Assert =>
+            Set_Top_Frame (Current_Process.Instance);
+            Prompt := Prompt_Crash'Address;
+            Put_Line ("assertion failure, enterring in debugger");
+         when Reason_Error =>
+            Set_Top_Frame (Current_Process.Instance);
+            Prompt := Prompt_Crash'Address;
+            Put_Line ("error occurred, enterring in debugger");
+      end case;
+
+      Command_Status := Status_Default;
+
+      loop
+         loop
+            Raw_Line := Readline (Prompt);
+            --  Skip empty lines
+            exit when Raw_Line /= null and then Raw_Line (1) /= ASCII.NUL;
+         end loop;
+         declare
+            Line_Last : constant Natural := Strlen (Raw_Line);
+            Line : String renames Raw_Line (1 .. Line_Last);
+            P, E : Positive;
+            Cmd : Menu_Entry_Acc := Menu_Top'Access;
+         begin
+            --  Find command
+            P := 1;
+            loop
+               E := P;
+               Parse_Command (Line, E, Cmd);
+               exit when Cmd = null;
+               case Cmd.Kind is
+                  when Menu_Submenu =>
+                     if E > Line_Last then
+                        Put_Line ("missing command for submenu "
+                                    & Line (P .. E - 1));
+                        Cmd := null;
+                        exit;
+                     end if;
+                     P := E;
+                  when Menu_Command =>
+                     exit;
+               end case;
+            end loop;
+
+            if Cmd /= null then
+               Cmd.Proc.all (Line (E .. Line_Last));
+
+               case Command_Status is
+                  when Status_Default =>
+                     null;
+                  when Status_Quit =>
+                     exit;
+               end case;
+            end if;
+         exception
+            when Command_Error =>
+               null;
+         end;
+      end loop;
+      --  Put ("resuming");
+   end Debug;
+
+   procedure Debug_Error is
+   begin
+      Debug (Reason_Error);
+   end Debug_Error;
+end Debugger;
diff --git a/src/simulate/debugger.ads b/src/simulate/debugger.ads
new file mode 100644
index 000000000..5e8c7ac67
--- /dev/null
+++ b/src/simulate/debugger.ads
@@ -0,0 +1,90 @@
+--  Debugger for interpreter
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Elaboration; use Elaboration;
+with Iirs; use Iirs;
+
+package Debugger is
+   Flag_Need_Debug : Boolean := False;
+
+   -- Disp a message for a constraint error.
+   -- And raise the exception execution_constraint_error.
+   procedure Error_Msg_Constraint (Expr: Iir);
+   pragma No_Return (Error_Msg_Constraint);
+
+   -- Disp a message during execution.
+   procedure Error_Msg_Exec (Msg: String; Loc: Iir);
+   pragma No_Return (Error_Msg_Exec);
+
+   procedure Warning_Msg_Exec (Msg: String; Loc: Iir);
+
+   --  Disp a block instance, in a human readable way.
+   --  Used to debug.
+   procedure Disp_Block_Instance (Instance: Block_Instance_Acc);
+
+   -- Disp the instance tree.
+   procedure Disp_Instances_Tree;
+
+   --  Disp the name of an instance, without newline.  The name of
+   --  architectures is displayed unless Short is True.
+   procedure Disp_Instance_Name (Instance: Block_Instance_Acc;
+                                 Short : Boolean := False);
+
+   -- Disp the resulting processes of elaboration.
+   -- procedure Disp_Processes;
+
+   --  Disp the label of PROCESS, or <unlabeled> if PROCESS has no label.
+   procedure Disp_Label (Process : Iir);
+
+   --  Disp all signals name and values.
+   procedure Disp_Signals_Value;
+
+   procedure Disp_Objects_Value;
+
+   --  Disp stats about the design (number of process, number of signals...)
+   procedure Disp_Design_Stats;
+
+   --  The reason why the debugger is invoked.
+   type Debug_Reason is
+     (--  Called from an external debugger while debugging ghdl.
+      Reason_Internal_Debug,
+
+      --  Interractive session, elaboration not done
+      Reason_Start,
+
+      --  At end of elaboration, for an interractive session
+      Reason_Elab,
+
+      --  Before execution of a statement.
+      Reason_Break,
+
+      --  Assertion failure
+      Reason_Assert,
+
+      --  Non recoverable error occurred (such as index error, overflow...)
+      Reason_Error
+     );
+
+   Debugger_Quit : exception;
+
+   --  Interractive debugger.
+   procedure Debug (Reason: Debug_Reason);
+
+   --  Call the debugger in case of error.
+   procedure Debug_Error;
+end Debugger;
diff --git a/src/simulate/elaboration.adb b/src/simulate/elaboration.adb
new file mode 100644
index 000000000..dd405ec18
--- /dev/null
+++ b/src/simulate/elaboration.adb
@@ -0,0 +1,2582 @@
+--  Elaboration
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Text_IO;
+with Types; use Types;
+with Errorout; use Errorout;
+with Execution; use Execution;
+with Simulation; use Simulation;
+with Iirs_Utils; use Iirs_Utils;
+with Libraries;
+with Name_Table;
+with File_Operation;
+with Debugger; use Debugger;
+with Iir_Chains; use Iir_Chains;
+with Sem_Names;
+with Grt.Types; use Grt.Types;
+with Simulation.AMS; use Simulation.AMS;
+with Areapools; use Areapools;
+with Grt.Errors;
+
+package body Elaboration is
+
+   procedure Elaborate_Dependence (Design_Unit: Iir_Design_Unit);
+
+   procedure Elaborate_Statement_Part
+     (Instance : Block_Instance_Acc; Stmt_Chain: Iir);
+   procedure Elaborate_Type_Definition
+     (Instance : Block_Instance_Acc; Def : Iir);
+   procedure Elaborate_Nature_Definition
+     (Instance : Block_Instance_Acc; Def : Iir);
+
+   function Elaborate_Default_Value
+     (Instance : Block_Instance_Acc; Decl : Iir)
+     return Iir_Value_Literal_Acc;
+
+   --  CONF is the block_configuration for components of ARCH.
+   function Elaborate_Architecture (Arch : Iir_Architecture_Body;
+                                    Conf : Iir_Block_Configuration;
+                                    Parent_Instance : Block_Instance_Acc;
+                                    Stmt : Iir;
+                                    Generic_Map : Iir;
+                                    Port_Map : Iir)
+     return Block_Instance_Acc;
+
+   -- Create a new signal, using DEFAULT as initial value.
+   -- Set its number.
+   procedure Elaborate_Signal (Block: Block_Instance_Acc;
+                               Signal: Iir;
+                               Default : Iir_Value_Literal_Acc)
+   is
+      function Create_Signal (Lit: Iir_Value_Literal_Acc)
+                             return Iir_Value_Literal_Acc
+      is
+         Res : Iir_Value_Literal_Acc;
+      begin
+         case Lit.Kind is
+            when Iir_Value_Array =>
+               Res := Create_Array_Value (Lit.Val_Array.Len,
+                                          Lit.Bounds.Nbr_Dims);
+               Res.Bounds.D := Lit.Bounds.D;
+               Res := Unshare_Bounds (Res, Global_Pool'Access);
+
+               for I in Lit.Val_Array.V'Range loop
+                  Res.Val_Array.V (I) := Create_Signal (Lit.Val_Array.V (I));
+               end loop;
+            when Iir_Value_Record =>
+               Res := Create_Record_Value
+                 (Lit.Val_Record.Len, Instance_Pool);
+               for I in Lit.Val_Record.V'Range loop
+                  Res.Val_Record.V (I) := Create_Signal (Lit.Val_Record.V (I));
+               end loop;
+
+            when Iir_Value_I64
+              | Iir_Value_F64
+              | Iir_Value_B1
+              | Iir_Value_E32 =>
+               Res := Create_Signal_Value (null);
+
+            when Iir_Value_Signal
+              | Iir_Value_Range
+              | Iir_Value_File
+              | Iir_Value_Access
+              | Iir_Value_Protected
+              | Iir_Value_Quantity
+              | Iir_Value_Terminal =>
+               raise Internal_Error;
+         end case;
+         return Res;
+      end Create_Signal;
+
+      Sig : Iir_Value_Literal_Acc;
+      Def : Iir_Value_Literal_Acc;
+      Slot : constant Object_Slot_Type := Get_Info (Signal).Slot;
+   begin
+      Sig := Create_Signal (Default);
+      Def := Unshare (Default, Global_Pool'Access);
+      Block.Objects (Slot) := Sig;
+      Block.Objects (Slot + 1) := Def;
+
+      Signals_Table.Append ((Kind => User_Signal,
+                             Decl => Signal,
+                             Sig => Sig,
+                             Instance => Block,
+                             Init => Def));
+   end Elaborate_Signal;
+
+   function Execute_Time_Attribute (Instance : Block_Instance_Acc; Attr : Iir)
+                                   return Ghdl_I64
+   is
+      Param : constant Iir := Get_Parameter (Attr);
+      Res : Ghdl_I64;
+      Val : Iir_Value_Literal_Acc;
+   begin
+      if Param = Null_Iir then
+         Res := 0;
+      else
+         Val := Execute_Expression (Instance, Param);
+         Res := Val.I64;
+      end if;
+      return Res;
+   end Execute_Time_Attribute;
+
+   procedure Elaborate_Implicit_Signal
+     (Instance: Block_Instance_Acc; Signal: Iir; Kind : Signal_Type_Kind)
+   is
+      Info : constant Sim_Info_Acc := Get_Info (Signal);
+      Prefix : Iir_Value_Literal_Acc;
+      T : Ghdl_I64;
+      Sig : Iir_Value_Literal_Acc;
+      Init : Iir_Value_Literal_Acc;
+   begin
+      if Kind = Implicit_Transaction then
+         T := 0;
+         Init := Create_B1_Value (False);
+      else
+         T := Execute_Time_Attribute (Instance, Signal);
+         Init := Create_B1_Value (False);
+      end if;
+      Sig := Create_Signal_Value (null);
+      Instance.Objects (Info.Slot) := Sig;
+      Instance.Objects (Info.Slot + 1) := Unshare (Init, Global_Pool'Access);
+
+      Prefix := Execute_Name (Instance, Get_Prefix (Signal), True);
+      Prefix := Unshare_Bounds (Prefix, Global_Pool'Access);
+      case Kind is
+         when Implicit_Stable =>
+            Signals_Table.Append ((Kind => Implicit_Stable,
+                                   Decl => Signal,
+                                   Sig => Sig,
+                                   Instance => Instance,
+                                   Time => T,
+                                   Prefix => Prefix));
+         when Implicit_Quiet =>
+            Signals_Table.Append ((Kind => Implicit_Quiet,
+                                   Decl => Signal,
+                                   Sig => Sig,
+                                   Instance => Instance,
+                                   Time => T,
+                                   Prefix => Prefix));
+         when Implicit_Transaction =>
+            Signals_Table.Append ((Kind => Implicit_Transaction,
+                                   Decl => Signal,
+                                   Sig => Sig,
+                                   Instance => Instance,
+                                   Time => 0,
+                                   Prefix => Prefix));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Elaborate_Implicit_Signal;
+
+   function Create_Delayed_Signal (Pfx : Iir_Value_Literal_Acc)
+                                  return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      case Pfx.Kind is
+         when Iir_Value_Array =>
+            Res := Create_Array_Value (Pfx.Val_Array.Len,
+                                       Pfx.Bounds.Nbr_Dims,
+                                       Global_Pool'Access);
+            Res.Bounds.D := Pfx.Bounds.D;
+
+            for I in Pfx.Val_Array.V'Range loop
+               Res.Val_Array.V (I) := Create_Delayed_Signal
+                 (Pfx.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            Res := Create_Record_Value (Pfx.Val_Record.Len,
+                                        Global_Pool'Access);
+            for I in Pfx.Val_Record.V'Range loop
+               Res.Val_Record.V (I) := Create_Delayed_Signal
+                 (Pfx.Val_Record.V (I));
+            end loop;
+         when Iir_Value_Signal =>
+            Res := Create_Signal_Value (null);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Create_Delayed_Signal;
+
+   procedure Elaborate_Delayed_Signal
+     (Instance: Block_Instance_Acc; Signal: Iir)
+   is
+      Info : constant Sim_Info_Acc := Get_Info (Signal);
+      Prefix : Iir_Value_Literal_Acc;
+      Sig : Iir_Value_Literal_Acc;
+      Init : Iir_Value_Literal_Acc;
+      T : Ghdl_I64;
+   begin
+      Prefix := Execute_Name (Instance, Get_Prefix (Signal), True);
+      Prefix := Unshare_Bounds (Prefix, Global_Pool'Access);
+
+      T := Execute_Time_Attribute (Instance, Signal);
+
+      Sig := Create_Delayed_Signal (Prefix);
+      Instance.Objects (Info.Slot) := Sig;
+
+      Init := Execute_Signal_Init_Value (Instance, Get_Prefix (Signal));
+      Init := Unshare_Bounds (Init, Global_Pool'Access);
+      Instance.Objects (Info.Slot + 1) := Init;
+
+      Signals_Table.Append ((Kind => Implicit_Delayed,
+                             Decl => Signal,
+                             Sig => Sig,
+                             Instance => Instance,
+                             Time => T,
+                             Prefix => Prefix));
+   end Elaborate_Delayed_Signal;
+
+   procedure Elaborate_Package (Decl: Iir)
+   is
+      Package_Info : constant Sim_Info_Acc := Get_Info (Decl);
+      Instance : Block_Instance_Acc;
+   begin
+      Instance := new Block_Instance_Type'
+        (Max_Objs => Package_Info.Nbr_Objects,
+         Scope_Level => Package_Info.Frame_Scope_Level,
+         Up_Block => null,
+         Label => Decl,
+         Stmt => Null_Iir,
+         Parent => null,
+         Children => null,
+         Brother => null,
+         Marker => Empty_Marker,
+         Objects => (others => null),
+         Elab_Objects => 0,
+         In_Wait_Flag => False,
+         Actuals_Ref => null,
+         Result => null);
+
+      Package_Instances (Package_Info.Inst_Slot) := Instance;
+
+      if Trace_Elaboration then
+         Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl));
+      end if;
+
+      -- Elaborate objects declarations.
+      Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl));
+   end Elaborate_Package;
+
+   procedure Elaborate_Package_Body (Decl: Iir)
+   is
+      Package_Info : constant Sim_Info_Acc := Get_Info (Decl);
+      Instance : Block_Instance_Acc;
+   begin
+      Instance := Package_Instances
+        (Instance_Slot_Type (-Package_Info.Frame_Scope_Level));
+
+      if Trace_Elaboration then
+         Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl));
+      end if;
+
+      -- Elaborate objects declarations.
+      Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl));
+   end Elaborate_Package_Body;
+
+   -- Elaborate all packages which DESIGN_UNIT depends on.
+   -- The packages are elaborated only once.  The body, if the package needs
+   -- one, can be loaded during the elaboration.
+   -- Recursive function.
+   -- FIXME: handle pathological cases of recursion.
+   -- Due to the rules of analysis, it is not possible to have a circulare
+   -- dependence.
+   procedure Elaborate_Dependence (Design_Unit: Iir_Design_Unit) is
+      Depend_List: Iir_Design_Unit_List;
+      Design: Iir;
+      Library_Unit: Iir;
+   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_Entity_Aspect_Entity then
+            --  During Sem, the architecture may be still unknown, and the
+            --  dependency is therefore the aspect.
+            Library_Unit := Get_Architecture (Design);
+            Design := Get_Design_Unit (Library_Unit);
+         else
+            Library_Unit := Get_Library_Unit (Design);
+         end if;
+         -- Elaborates only non-elaborated packages.
+         case Get_Kind (Library_Unit) is
+            when Iir_Kind_Package_Declaration =>
+               declare
+                  Info : constant Sim_Info_Acc := Get_Info (Library_Unit);
+                  Body_Design: Iir_Design_Unit;
+               begin
+                  if Package_Instances (Info.Inst_Slot) = null then
+                     --  Package not yet elaborated.
+
+                     --  Load the body now, as it can add objects in the
+                     --  package instance.
+                     Body_Design := Libraries.Load_Secondary_Unit
+                       (Design, Null_Identifier, Design_Unit);
+
+                     --  First the packages on which DESIGN depends.
+                     Elaborate_Dependence (Design);
+
+                     --  Then the declaration.
+                     Elaborate_Package (Library_Unit);
+
+                     --  And then the body (if any).
+                     if Body_Design = Null_Iir then
+                        if Get_Need_Body (Library_Unit) then
+                           Error_Msg_Elab
+                             ("no package body for `" &
+                                Image_Identifier (Library_Unit) & ''');
+                        end if;
+                     else
+                        -- Note: the body can elaborate some packages.
+                        Elaborate_Dependence (Body_Design);
+
+                        Elaborate_Package_Body
+                          (Get_Library_Unit (Body_Design));
+                     end if;
+                  end if;
+               end;
+            when Iir_Kind_Entity_Declaration
+              | Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Architecture_Body =>
+               Elaborate_Dependence (Design);
+            when others =>
+               Error_Kind ("elaborate_dependence", Library_Unit);
+         end case;
+      end loop;
+   end Elaborate_Dependence;
+
+   --  Create a block instance to instantiate OBJ (block, component,
+   --  architecture, generate) in FATHER.  STMT is the statement/declaration
+   --  at the origin of the instantiation (it is generally the same as OBJ,
+   --  except for component where STMT is the component instantation
+   --  statement).
+   function Create_Block_Instance
+     (Father : Block_Instance_Acc;
+      Obj : Iir;
+      Stmt : Iir)
+      return Block_Instance_Acc
+   is
+      Obj_Info : constant Sim_Info_Acc := Get_Info (Obj);
+      Res : Block_Instance_Acc;
+   begin
+      Res := new Block_Instance_Type'
+        (Max_Objs => Obj_Info.Nbr_Objects,
+         Scope_Level => Obj_Info.Frame_Scope_Level,
+         Up_Block => Father,
+         Label => Stmt,
+         Stmt => Obj,
+         Parent => Father,
+         Children => null,
+         Brother => null,
+         Marker => Empty_Marker,
+         Objects => (others => null),
+         Elab_Objects => 0,
+         In_Wait_Flag => False,
+         Actuals_Ref => null,
+         Result => null);
+
+      if Father /= null then
+         Res.Brother := Father.Children;
+         Father.Children := Res;
+      end if;
+
+      return Res;
+   end Create_Block_Instance;
+
+   function Create_Protected_Object (Block: Block_Instance_Acc; Decl: Iir)
+                                    return Iir_Value_Literal_Acc
+   is
+      Bod : constant Iir := Get_Protected_Type_Body (Decl);
+      Inst : Block_Instance_Acc;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Protected_Table.Increment_Last;
+      Res := Create_Protected_Value (Protected_Table.Last);
+
+      Inst := Create_Subprogram_Instance (Block, Bod);
+      Protected_Table.Table (Res.Prot) := Inst;
+
+      --  Temporary put the instancce on the stack in case of function calls
+      --  during the elaboration of the protected object.
+      Current_Process.Instance := Inst;
+
+      Elaborate_Declarative_Part (Inst, Get_Declaration_Chain (Bod));
+
+      Current_Process.Instance := Block;
+
+      return Res;
+   end Create_Protected_Object;
+
+   --  Create an value_literal for DECL (defined in BLOCK) and set it with
+   --  its default values. Nodes are shared.
+   function Create_Value_For_Type
+     (Block: Block_Instance_Acc; Decl: Iir; Default : Boolean)
+      return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      Bounds : Iir_Value_Literal_Acc;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            if Default then
+               Bounds := Execute_Bounds (Block, Decl);
+               Res := Bounds.Left;
+            else
+               case Get_Info (Get_Base_Type (Decl)).Scalar_Mode is
+                  when Iir_Value_B1 =>
+                     Res := Create_B1_Value (False);
+                  when Iir_Value_E32 =>
+                     Res := Create_E32_Value (0);
+                  when Iir_Value_I64 =>
+                     Res := Create_I64_Value (0);
+                  when Iir_Value_F64 =>
+                     Res := Create_F64_Value (0.0);
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            end if;
+
+         when Iir_Kind_Array_Subtype_Definition =>
+            Res := Create_Array_Bounds_From_Type (Block, Decl, True);
+            declare
+               El : Iir_Value_Literal_Acc;
+            begin
+               if Res.Val_Array.Len > 0 then
+                  El := Create_Value_For_Type
+                    (Block, Get_Element_Subtype (Decl), Default);
+                  Res.Val_Array.V (1) := El;
+                  for I in 2 .. Res.Val_Array.Len loop
+                     Res.Val_Array.V (I) := El;
+                  end loop;
+               end if;
+            end;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            declare
+               El : Iir_Element_Declaration;
+               List : constant Iir_List :=
+                 Get_Elements_Declaration_List (Get_Base_Type (Decl));
+            begin
+               Res := Create_Record_Value
+                 (Iir_Index32 (Get_Nbr_Elements (List)));
+
+               for I in Natural loop
+                  El := Get_Nth_Element (List, I);
+                  exit when El = Null_Iir;
+                  Res.Val_Record.V (1 + Get_Element_Position (El)) :=
+                    Create_Value_For_Type (Block, Get_Type (El), Default);
+               end loop;
+            end;
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            return Create_Access_Value (null);
+         when Iir_Kind_Protected_Type_Declaration =>
+            return Create_Protected_Object (Block, Decl);
+         when others =>
+            Error_Kind ("create_value_for_type", Decl);
+      end case;
+      return Res;
+   end Create_Value_For_Type;
+
+   procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+   begin
+      --  Check elaboration order.
+      --  Note: this is not done for package since objects from package are
+      --  commons (same scope), and package annotation order can be different
+      --  from package elaboration order (eg: body).
+      if Slot /= Instance.Elab_Objects + 1
+        or else Instance.Objects (Slot) /= null
+      then
+         Error_Msg_Elab ("bad elaboration order");
+         raise Internal_Error;
+      end if;
+      Instance.Elab_Objects := Slot;
+   end Create_Object;
+
+   procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Info : constant Sim_Info_Acc := Get_Info (Decl);
+      Slot : constant Object_Slot_Type := Info.Slot;
+   begin
+      if Slot /= Instance.Elab_Objects
+        or else Info.Scope_Level /= Instance.Scope_Level
+      then
+         Error_Msg_Elab ("bad destroy order");
+         raise Internal_Error;
+      end if;
+      --  Clear the slot (this is necessary for ranges).
+      Instance.Objects (Slot) := null;
+      Instance.Elab_Objects := Slot - 1;
+   end Destroy_Object;
+
+   procedure Create_Signal (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+   begin
+      if Slot /= Instance.Elab_Objects + 1
+        or else Instance.Objects (Slot) /= null
+      then
+         Error_Msg_Elab ("bad elaboration order");
+         raise Internal_Error;
+      end if;
+      --  One slot is reserved for default value
+      Instance.Elab_Objects := Slot + 1;
+   end Create_Signal;
+
+   function Create_Terminal_Object (Block: Block_Instance_Acc;
+                                    Decl : Iir;
+                                    Def: Iir)
+                                   return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Scalar_Nature_Definition =>
+            Res := Create_Terminal_Value
+              (Create_Scalar_Terminal (Decl, Block));
+         when others =>
+            Error_Kind ("create_terminal_object", Def);
+      end case;
+      return Res;
+   end Create_Terminal_Object;
+
+   procedure Create_Terminal (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+   begin
+      if Slot + 1 = Instance.Elab_Objects then
+         --  Reference terminal of nature declaration may have already been
+         --  elaborated.
+         return;
+      end if;
+      if Slot /= Instance.Elab_Objects then
+         Error_Msg_Elab ("bad elaboration order");
+         raise Internal_Error;
+      end if;
+      Instance.Objects (Slot) :=
+        Create_Terminal_Object (Instance, Decl, Get_Nature (Decl));
+      Instance.Elab_Objects := Slot + 1;
+   end Create_Terminal;
+
+   function Create_Quantity_Object (Block: Block_Instance_Acc;
+                                    Decl : Iir;
+                                    Def: Iir)
+                                   return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      Kind : Quantity_Kind;
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition =>
+            case Iir_Kinds_Quantity_Declaration (Get_Kind (Decl)) is
+               when Iir_Kind_Across_Quantity_Declaration =>
+                  Kind := Quantity_Across;
+               when Iir_Kind_Through_Quantity_Declaration =>
+                  Kind := Quantity_Through;
+               when Iir_Kind_Free_Quantity_Declaration =>
+                  Kind := Quantity_Free;
+            end case;
+            Res := Create_Quantity_Value
+              (Create_Scalar_Quantity (Kind, Decl, Block));
+         when others =>
+            Error_Kind ("create_quantity_object", Def);
+      end case;
+      return Res;
+   end Create_Quantity_Object;
+
+   function Create_Quantity (Instance : Block_Instance_Acc; Decl : Iir)
+     return Iir_Value_Literal_Acc
+   is
+      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      if Slot /= Instance.Elab_Objects then
+         Error_Msg_Elab ("bad elaboration order");
+         raise Internal_Error;
+      end if;
+      Res := Create_Quantity_Object (Instance, Decl, Get_Type (Decl));
+      Instance.Objects (Slot) := Res;
+      Instance.Elab_Objects := Slot + 1;
+      return Res;
+   end Create_Quantity;
+
+   function Elaborate_Bound_Constraint
+     (Instance : Block_Instance_Acc; Bound: Iir)
+      return Iir_Value_Literal_Acc
+   is
+      Value : Iir_Value_Literal_Acc;
+      Ref : constant Iir := Get_Type (Bound);
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := Create_Value_For_Type (Instance, Ref, False);
+      Res := Unshare (Res, Instance_Pool);
+      Value := Execute_Expression (Instance, Bound);
+      Assign_Value_To_Object (Instance, Res, Ref, Value, Bound);
+      return Res;
+   end Elaborate_Bound_Constraint;
+
+   procedure Elaborate_Range_Expression
+     (Instance : Block_Instance_Acc; Rc: Iir_Range_Expression)
+   is
+      Range_Info : constant Sim_Info_Acc := Get_Info (Rc);
+      Val : Iir_Value_Literal_Acc;
+   begin
+      if Range_Info.Scope_Level /= Instance.Scope_Level
+        or else Instance.Objects (Range_Info.Slot) /= null
+      then
+         --  A range expression may have already been created, for example
+         --  when severals objects are created with the same subtype:
+         --    variable v, v1 : bit_vector (x to y);
+         return;
+      end if;
+      if False
+        and then (Range_Info.Scope_Level /= Instance.Scope_Level
+                    or else Range_Info.Slot < Instance.Elab_Objects)
+      then
+         --  FIXME: the test is wrong for packages.
+         --  The range was already elaborated.
+         --  ?? Is that possible
+         raise Internal_Error;
+         return;
+      end if;
+      Create_Object (Instance, Rc);
+      Val := Create_Range_Value
+        (Elaborate_Bound_Constraint (Instance, Get_Left_Limit (Rc)),
+         Elaborate_Bound_Constraint (Instance, Get_Right_Limit (Rc)),
+         Get_Direction (Rc));
+      Instance.Objects (Range_Info.Slot) := Unshare (Val, Instance_Pool);
+   end Elaborate_Range_Expression;
+
+   procedure Elaborate_Range_Constraint
+     (Instance : Block_Instance_Acc; Rc: Iir)
+   is
+   begin
+      case Get_Kind (Rc) is
+         when Iir_Kind_Range_Expression =>
+            Elaborate_Range_Expression (Instance, Rc);
+         when Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
+            null;
+         when others =>
+            Error_Kind ("elaborate_range_constraint", Rc);
+      end case;
+   end Elaborate_Range_Constraint;
+
+   --  Create the bounds of a scalar type definition.
+   --  Elaborate_Range_Constraint cannot be used, as it checks bounds (and
+   --  here we create the bounds).
+   procedure Elaborate_Type_Range
+     (Instance : Block_Instance_Acc; Rc: Iir_Range_Expression)
+   is
+      Range_Info : Sim_Info_Acc;
+      Val : Iir_Value_Literal_Acc;
+   begin
+      Range_Info := Get_Info (Rc);
+      Create_Object (Instance, Rc);
+      Val := Create_Range_Value
+        (Execute_Expression (Instance, Get_Left_Limit (Rc)),
+         Execute_Expression (Instance, Get_Right_Limit (Rc)),
+         Get_Direction (Rc));
+      Instance.Objects (Range_Info.Slot) := Unshare (Val, Instance_Pool);
+   end Elaborate_Type_Range;
+
+   --  DECL is a subtype indication.
+   --  Elaborate DECL only if it is anonymous.
+   procedure Elaborate_Subtype_Indication_If_Anonymous
+     (Instance : Block_Instance_Acc; Decl : Iir) is
+   begin
+      if Is_Anonymous_Type_Definition (Decl) then
+         Elaborate_Subtype_Indication (Instance, Decl);
+      end if;
+   end Elaborate_Subtype_Indication_If_Anonymous;
+
+   --  LRM93 §12.3.1.3  Subtype Declarations
+   --  The elaboration of a subtype indication creates a subtype.
+   procedure Elaborate_Subtype_Indication
+     (Instance : Block_Instance_Acc; Ind : Iir)
+   is
+   begin
+      case Get_Kind (Ind) is
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            Elaborate_Type_Definition (Instance, Ind);
+         when Iir_Kind_Array_Subtype_Definition =>
+            --  LRM93 12.3.1.3
+            --  The elaboration of an index constraint consists of the
+            --  declaration of each of the discrete ranges in the index
+            --  constraint in some order that is not defined by the language.
+            declare
+               St_Indexes : constant Iir_List := Get_Index_Subtype_List (Ind);
+               St_El : Iir;
+            begin
+               for I in Natural loop
+                  St_El := Get_Index_Type (St_Indexes, I);
+                  exit when St_El = Null_Iir;
+                  Elaborate_Subtype_Indication_If_Anonymous (Instance, St_El);
+               end loop;
+               Elaborate_Subtype_Indication_If_Anonymous
+                 (Instance, Get_Element_Subtype (Ind));
+            end;
+         when Iir_Kind_Record_Subtype_Definition =>
+            null;
+         when Iir_Kind_Access_Subtype_Definition =>
+            null;
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            Elaborate_Range_Constraint (Instance, Get_Range_Constraint (Ind));
+         when Iir_Kind_Physical_Subtype_Definition =>
+            Elaborate_Range_Constraint (Instance, Get_Range_Constraint (Ind));
+         when others =>
+            Error_Kind ("elaborate_subtype_indication", Ind);
+      end case;
+   end Elaborate_Subtype_Indication;
+
+   --  LRM93 §12.3.1.2  Type Declarations.
+   procedure Elaborate_Type_Definition
+     (Instance : Block_Instance_Acc; Def : Iir)
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Enumeration_Type_Definition =>
+            --  Elaboration of an enumeration type definition has not effect
+            --  other than the creation of the corresponding type.
+            Elaborate_Type_Range (Instance, Get_Range_Constraint (Def));
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition =>
+            null;
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            --  Elaboration of an integer, floating point, or physical type
+            --  definition consists of the elaboration of the corresponding
+            --  range constraint.
+            Elaborate_Subtype_Indication_If_Anonymous (Instance, Def);
+            --  Elaboration of a physical unit declaration has no effect other
+            --  than to create the unit defined by the unit declaration.
+            null;
+         when Iir_Kind_Array_Type_Definition =>
+            --  Elaboration of an unconstrained array type definition consists
+            --  of the elaboration of the element subtype indication of the
+            --  array type.
+            Elaborate_Subtype_Indication_If_Anonymous
+              (Instance, Get_Element_Subtype (Def));
+         when Iir_Kind_Access_Type_Definition =>
+            --  Elaboration of an access type definition consists of the
+            --  elaboration of the corresponding subtype indication.
+            Elaborate_Subtype_Indication_If_Anonymous
+              (Instance, Get_Designated_Type (Def));
+         when Iir_Kind_File_Type_Definition =>
+            --  GHDL: There is nothing about elaboration of a file type
+            --  definition.  FIXME ??
+            null;
+         when Iir_Kind_Record_Type_Definition =>
+            --  Elaboration of a record type definition consists of the
+            --  elaboration of the equivalent single element declarations in
+            --  the given order.
+            declare
+               El : Iir_Element_Declaration;
+               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;
+                  --  Elaboration of an element declaration consists of
+                  --  elaboration of the element subtype indication.
+                  Elaborate_Subtype_Indication_If_Anonymous
+                    (Instance, Get_Type (El));
+               end loop;
+            end;
+         when Iir_Kind_Protected_Type_Declaration =>
+            Elaborate_Declarative_Part
+              (Instance, Get_Declaration_Chain (Def));
+
+         when Iir_Kind_Incomplete_Type_Definition =>
+            null;
+         when others =>
+            Error_Kind ("elaborate_type_definition", Def);
+      end case;
+   end Elaborate_Type_Definition;
+
+   --  LRM93 §12.3.1.2  Type Declarations.
+   procedure Elaborate_Type_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir_Type_Declaration)
+   is
+      Def : Iir;
+      Base_Type : Iir_Array_Type_Definition;
+   begin
+      --  Elaboration of a type declaration generally consists of the
+      --  elaboration of the definition of the type and the creation of that
+      --  type.
+      Def := Get_Type_Definition (Decl);
+      if Def = Null_Iir then
+         --  FIXME: can this happen ?
+         raise Program_Error;
+      end if;
+      if Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition then
+         Base_Type := Get_Base_Type (Def);
+         --  For a constrained array type declaration, however,
+         --  elaboration consists of the elaboration of the equivalent
+         --  anonymous unconstrained array type [...]
+         Elaborate_Subtype_Indication_If_Anonymous (Instance, Base_Type);
+         --  [...] followed by the elaboration of the named subtype
+         --  of that unconstrained type.
+         Elaborate_Subtype_Indication (Instance, Def);
+      else
+         Elaborate_Type_Definition (Instance, Def);
+      end if;
+   end Elaborate_Type_Declaration;
+
+   procedure Elaborate_Nature_Definition
+     (Instance : Block_Instance_Acc; Def : Iir)
+   is
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Scalar_Nature_Definition =>
+            Elaborate_Subtype_Indication (Instance, Get_Across_Type (Def));
+            Elaborate_Subtype_Indication (Instance, Get_Through_Type (Def));
+         when others =>
+            Error_Kind ("elaborate_nature_definition", Def);
+      end case;
+   end Elaborate_Nature_Definition;
+
+   --  LRM93 §12.2.1  The Generic Clause
+   procedure Elaborate_Generic_Clause
+     (Instance : Block_Instance_Acc; Generic_Chain : Iir)
+   is
+      Decl : Iir_Constant_Interface_Declaration;
+   begin
+      --  Elaboration of a generic clause consists of the elaboration of each
+      --  of the equivalent single generic declarations contained in the
+      --  clause, in the order given.
+      Decl := Generic_Chain;
+      while Decl /= Null_Iir loop
+         --  The elaboration of a generic declaration consists of elaborating
+         --  the subtype indication and then creating a generic constant of
+         --  that subtype.
+         Elaborate_Subtype_Indication_If_Anonymous (Instance, Get_Type (Decl));
+         Create_Object (Instance, Decl);
+         --  The value of a generic constant is not defined until a subsequent
+         --  generic map aspect is evaluated, or in the absence of a generic
+         --  map aspect, until the default expression associated with the
+         --  generic constant is evaluated to determine the value of the
+         --  constant.
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Elaborate_Generic_Clause;
+
+   --  LRM93 12.2.3  The Port Clause
+   procedure Elaborate_Port_Clause
+     (Instance : Block_Instance_Acc; Port_Chain : Iir)
+   is
+      Decl : Iir_Signal_Interface_Declaration;
+   begin
+      Decl := Port_Chain;
+      while Decl /= Null_Iir loop
+         --  LRM93 §12.2.3
+         --  The elaboration of a port declaration consists of elaborating the
+         --  subtype indication and then creating a port of that subtype.
+         Elaborate_Subtype_Indication_If_Anonymous (Instance, Get_Type (Decl));
+
+         --  Simply increase an index to check that the port was created.
+         Create_Signal (Instance, Decl);
+
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Elaborate_Port_Clause;
+
+   --  LRM93 §12.2.2  The generic Map Aspect
+   procedure Elaborate_Generic_Map_Aspect
+     (Target_Instance : Block_Instance_Acc;
+      Local_Instance : Block_Instance_Acc;
+      Map : Iir)
+   is
+      Assoc : Iir;
+      Inter : Iir_Constant_Interface_Declaration;
+      Value : Iir;
+      Val : Iir_Value_Literal_Acc;
+      Last_Individual : Iir_Value_Literal_Acc;
+   begin
+      --  Elaboration of a generic map aspect consists of elaborating the
+      --  generic association list.
+
+      --  Elaboration of a generic association list consists of the
+      --  elaboration of each generic association element in the
+      --  association list.
+      Assoc := Map;
+      while Assoc /= Null_Iir loop
+         --  Elaboration of a generic association element consists of the
+         --  elaboration of the formal part and the evaluation of the actual
+         --  part.
+         --  FIXME:  elaboration of the formal part.
+         Inter := Get_Association_Interface (Assoc);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               --  The generic association list contains an implicit
+               --  association element for each generic constant that is not
+               --  explicitly associated with an actual [GHDL: done trought
+               --  annotations] or that is associated with the reserved word
+               --  OPEN; the actual part of such an implicit association
+               --  element is the default expression appearing in the
+               --  declaration of that generic constant.
+               Value := Get_Default_Value (Inter);
+               if Value = Null_Iir then
+                  Error_Msg_Exec ("no default value", Inter);
+                  return;
+               end if;
+               Val := Execute_Expression (Target_Instance, Value);
+            when Iir_Kind_Association_Element_By_Expression =>
+               Value := Get_Actual (Assoc);
+               Val := Execute_Expression (Local_Instance, Value);
+            when Iir_Kind_Association_Element_By_Individual =>
+               Val := Create_Value_For_Type
+                 (Local_Instance, Get_Actual_Type (Assoc), False);
+
+               Last_Individual := Unshare (Val, Instance_Pool);
+               Target_Instance.Objects (Get_Info (Inter).Slot) :=
+                 Last_Individual;
+               goto Continue;
+            when others =>
+               Error_Kind ("elaborate_generic_map_aspect", Assoc);
+         end case;
+
+         if Get_Whole_Association_Flag (Assoc) then
+            --  It is an error if the value of the actual does not belong to
+            --  the subtype denoted by the subtype indication of the formal.
+            --  If the subtype denoted by the subtype indication of the
+            --  declaration of the formal is a constrained array subtype, then
+            --  an implicit subtype conversion is performed prior to this
+            --  check.
+            --  It is also an error if the type of the formal is an array type
+            --  and the value of each element of the actual does not belong to
+            --  the element subtype of the formal.
+            Implicit_Array_Conversion
+              (Target_Instance, Val, Get_Type (Inter), Inter);
+            Check_Constraints (Target_Instance, Val, Get_Type (Inter), Inter);
+
+            --  The generic constant or subelement or slice thereof designated
+            --  by the formal part is then initialized with the value
+            --  resulting from the evaluation of the corresponding actual part.
+            Target_Instance.Objects (Get_Info (Inter).Slot) :=
+              Unshare (Val, Instance_Pool);
+         else
+            declare
+               Targ : Iir_Value_Literal_Acc;
+               Is_Sig : Boolean;
+            begin
+               Execute_Name_With_Base
+                 (Target_Instance, Get_Formal (Assoc),
+                  Last_Individual, Targ, Is_Sig);
+               Store (Targ, Val);
+            end;
+         end if;
+
+         <<Continue>> null;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Elaborate_Generic_Map_Aspect;
+
+   --  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;
+
+   --  LRM93 12.2.3  The Port Clause
+   procedure Elaborate_Port_Declaration
+     (Instance : Block_Instance_Acc;
+      Decl : Iir_Signal_Interface_Declaration;
+      Default_Value : Iir_Value_Literal_Acc)
+   is
+      Val : Iir_Value_Literal_Acc;
+   begin
+      if Default_Value = null then
+         Val := Elaborate_Default_Value (Instance, Decl);
+      else
+         Val := Default_Value;
+      end if;
+      Elaborate_Signal (Instance, Decl, Val);
+   end Elaborate_Port_Declaration;
+
+   procedure Elab_Connect
+     (Formal_Instance : Block_Instance_Acc;
+      Local_Instance : Block_Instance_Acc;
+      Actual_Expr : Iir_Value_Literal_Acc;
+      Assoc : Iir_Association_Element_By_Expression)
+   is
+      Inter : Iir;
+      Actual : Iir;
+      Local_Expr : Iir_Value_Literal_Acc;
+      Formal_Expr : Iir_Value_Literal_Acc;
+   begin
+      Inter := Get_Formal (Assoc);
+      Actual := Get_Actual (Assoc);
+      Formal_Expr := Execute_Name (Formal_Instance, Inter, True);
+      Formal_Expr := Unshare_Bounds (Formal_Expr, Global_Pool'Access);
+      if Actual_Expr = null then
+         Local_Expr := Execute_Name (Local_Instance, Actual, True);
+         Local_Expr := Unshare_Bounds (Local_Expr, Global_Pool'Access);
+      else
+         Local_Expr := Actual_Expr;
+      end if;
+
+      Connect_Table.Append ((Formal => Formal_Expr,
+                             Formal_Instance => Formal_Instance,
+                             Actual => Local_Expr,
+                             Actual_Instance => Local_Instance,
+                             Assoc => Assoc));
+   end Elab_Connect;
+
+   --  LRM93 12.2.3  The Port Clause
+   --  LRM93 §12.2.4  The Port Map Aspect
+   procedure Elaborate_Port_Map_Aspect
+     (Formal_Instance : Block_Instance_Acc;
+      Actual_Instance : Block_Instance_Acc;
+      Ports : Iir;
+      Map : Iir)
+   is
+      Assoc : Iir;
+      Inter : Iir_Signal_Interface_Declaration;
+      Actual_Expr : Iir_Value_Literal_Acc;
+      Init_Expr : Iir_Value_Literal_Acc;
+      Actual : Iir;
+   begin
+      if Ports = Null_Iir then
+         return;
+      end if;
+
+      --  Elaboration of a port map aspect consists of elaborating the port
+      --  association list.
+      if Map = Null_Iir then
+         -- No port association, elaborate the port clause.
+         --  Elaboration of a port clause consists of the elaboration of each
+         --  of the equivalent signal port declaration in the clause, in the
+         --  order given.
+         Inter := Ports;
+         while Inter /= Null_Iir loop
+            Elaborate_Port_Declaration (Formal_Instance, Inter, null);
+            Inter := Get_Chain (Inter);
+         end loop;
+         return;
+      end if;
+
+      Current_Component := Formal_Instance;
+
+      Assoc := Map;
+      while Assoc /= Null_Iir loop
+         --  Elaboration of a port association list consists of the elaboration
+         --  of each port association element in the association list whose
+         --  actual is not the reserved word OPEN.
+         Inter := Get_Association_Interface (Assoc);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_By_Expression =>
+               if Get_In_Conversion (Assoc) = Null_Iir
+                 and then Get_Out_Conversion (Assoc) = Null_Iir
+               then
+                  Actual := Get_Actual (Assoc);
+                  if Is_Signal (Actual) then
+                     --  Association with a signal
+                     Init_Expr := Execute_Signal_Init_Value
+                       (Actual_Instance, Actual);
+                     Implicit_Array_Conversion
+                       (Formal_Instance, Init_Expr, Get_Type (Inter), Actual);
+                     Init_Expr := Unshare_Bounds
+                       (Init_Expr, Global_Pool'Access);
+                     Actual_Expr := null;
+                  else
+                     --  Association with an expression
+                     Init_Expr := Execute_Expression
+                       (Actual_Instance, Actual);
+                     Implicit_Array_Conversion
+                       (Formal_Instance, Init_Expr,
+                        Get_Type (Inter), Actual);
+                     Init_Expr := Unshare (Init_Expr, Global_Pool'Access);
+                     Actual_Expr := Init_Expr;
+                  end if;
+               else
+                  --  The actual doesn't define the constraints of the formal.
+                  if Get_Whole_Association_Flag (Assoc) then
+                     Init_Expr := Elaborate_Default_Value
+                       (Formal_Instance, Inter);
+                     Actual_Expr := null;
+                  end if;
+               end if;
+
+               if Get_Whole_Association_Flag (Assoc)
+                 and then Get_Collapse_Signal_Flag (Assoc)
+               then
+                  declare
+                     Slot : constant Object_Slot_Type :=
+                       Get_Info (Inter).Slot;
+                     Actual_Sig : Iir_Value_Literal_Acc;
+                  begin
+                     Actual_Sig :=
+                       Execute_Name (Actual_Instance, Actual, True);
+                     Implicit_Array_Conversion
+                       (Formal_Instance, Actual_Sig,
+                        Get_Type (Inter), Actual);
+                     Formal_Instance.Objects (Slot) := Unshare_Bounds
+                       (Actual_Sig, Global_Pool'Access);
+                     Formal_Instance.Objects (Slot + 1) := Init_Expr;
+                  end;
+               else
+                  if Get_Whole_Association_Flag (Assoc) then
+                     Elaborate_Signal (Formal_Instance, Inter, Init_Expr);
+                  end if;
+
+                  --  Elaboration of a port association element consists of the
+                  --  elaboration of the formal part; the port or subelement
+                  --  or slice thereof designated by the formal part is then
+                  --  associated with the signal or expression designated
+                  --  by the actual part.
+                  Elab_Connect
+                    (Formal_Instance, Actual_Instance, Actual_Expr, Assoc);
+               end if;
+
+            when Iir_Kind_Association_Element_Open =>
+               --  Note that an open cannot be associated with a formal that
+               --  is associated individually.
+               Elaborate_Port_Declaration (Formal_Instance, Inter, null);
+
+            when Iir_Kind_Association_Element_By_Individual =>
+               Init_Expr := Create_Value_For_Type
+                 (Formal_Instance, Get_Actual_Type (Assoc), False);
+               Elaborate_Signal (Formal_Instance, Inter, Init_Expr);
+
+            when others =>
+               Error_Kind ("elaborate_port_map_aspect", Assoc);
+         end case;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      Current_Component := null;
+   end Elaborate_Port_Map_Aspect;
+
+   --  LRM93 §12.2  Elaboration of a block header
+   --  Elaboration of a block header consists of the elaboration of the
+   --  generic clause, the generic map aspect, the port clause, and the port
+   --  map aspect, in that order.
+   procedure Elaborate_Block_Header
+     (Instance : Block_Instance_Acc; Header : Iir_Block_Header)
+   is
+   begin
+      Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Header));
+      Elaborate_Generic_Map_Aspect
+        (Instance, Instance, Get_Generic_Map_Aspect_Chain (Header));
+      Elaborate_Port_Clause (Instance, Get_Port_Chain (Header));
+      Elaborate_Port_Map_Aspect
+        (Instance, Instance,
+         Get_Port_Chain (Header), Get_Port_Map_Aspect_Chain (Header));
+   end Elaborate_Block_Header;
+
+   procedure Elaborate_Guard_Signal
+     (Instance : Block_Instance_Acc; Guard : Iir)
+   is
+      Sig : Iir_Value_Literal_Acc;
+      Info : constant Sim_Info_Acc := Get_Info (Guard);
+   begin
+      Create_Signal (Instance, Guard);
+
+      Sig := Create_Signal_Value (null);
+      Instance.Objects (Info.Slot) := Sig;
+      Instance.Objects (Info.Slot + 1) :=
+        Unshare (Create_B1_Value (False), Instance_Pool);
+
+      Signals_Table.Append ((Kind => Guard_Signal,
+                             Decl => Guard,
+                             Sig => Sig,
+                             Instance => Instance));
+   end Elaborate_Guard_Signal;
+
+   --  LRM93 §12.4.1  Block statements.
+   procedure Elaborate_Block_Statement
+     (Instance : Block_Instance_Acc; Block : Iir_Block_Statement)
+   is
+      Header : Iir_Block_Header;
+      Ninstance : Block_Instance_Acc;  -- FIXME
+      Guard : Iir;
+   begin
+      Ninstance := Create_Block_Instance (Instance, Block, Block);
+
+      Guard := Get_Guard_Decl (Block);
+      if Guard /= Null_Iir then
+         --  LRM93 12.6.4 (3)
+         --  The value of each implicit GUARD signal is set to the result of
+         --  evaluating the corresponding guard expression.
+         --  GHDL: done by grt when the guard signal is created.
+         Elaborate_Guard_Signal (Ninstance, Guard);
+      end if;
+
+      --  Elaboration of a block statement consists of the elaboration of the
+      --  block header, if present [...]
+      Header := Get_Block_Header (Block);
+      if Header /= Null_Iir then
+         Elaborate_Block_Header (Ninstance, Header);
+      end if;
+
+      --  [...] followed by the elaboration of the block declarative part [...]
+      Elaborate_Declarative_Part (Ninstance,
+                                  Get_Declaration_Chain (Block));
+      --  [...] followed by the elaboration of the block statement part.
+      Elaborate_Statement_Part
+        (Ninstance, Get_Concurrent_Statement_Chain (Block));
+      --  Elaboration of a block statement may occur under the control of a
+      --  configuration declaration.
+      --  In particular, a block configuration, wether implicit or explicit,
+      --  within a configuration declaration may supply a sequence of
+      --  additionnal implicit configuration specification to be applied
+      --  during the elaboration of the corresponding block statement.
+      --  If a block statement is being elaborated under the control of a
+      --  configuration declaration, then the sequence of implicit
+      --  configuration specifications supplied by the block configuration
+      --  is elaborated as part of the block declarative part, following all
+      --  other declarative items in that part.
+      --  The sequence of implicit configuration specifications supplied by a
+      --  block configuration, wether implicit or explicit, consists of each of
+      --  the configuration specifications implied by component configurations
+      --  occurring immediatly within the block configuration, and in the
+      --  order in which the component configurations themselves appear.
+      -- FIXME.
+   end Elaborate_Block_Statement;
+
+   function Create_Default_Association (Formal_Chain : Iir;
+                                        Local_Chain : Iir;
+                                        Node : Iir)
+                                        return Iir
+   is
+      Nbr_Formals : Natural;
+   begin
+      --  LRM93 5.2.2
+      --  The default binding indication includes a default generic map
+      --  aspect if the design entity implied by the entity aspect contains
+      --  formal generic.
+      --
+      --  LRM93 5.2.2
+      --  The default binding indication includes a default port map aspect if
+      --  the design entity implied by the entity aspect contains formal ports.
+      if Formal_Chain = Null_Iir then
+         if Local_Chain /= Null_Iir then
+            Error_Msg_Sem ("cannot create default map aspect", Node);
+         end if;
+         return Null_Iir;
+      end if;
+      Nbr_Formals := Get_Chain_Length (Formal_Chain);
+      declare
+         Assoc_List : Iir_Array (0 .. Nbr_Formals - 1) := (others => Null_Iir);
+         Assoc : Iir;
+         Local : Iir;
+         Formal : Iir;
+         Pos : Natural;
+         First, Last : Iir;
+      begin
+         --  LRM93 5.2.2
+         --  The default generic map aspect associates each local generic in
+         --  the corresponding component instantiation (if any) with a formal
+         --  of the same simple name.
+         Local := Local_Chain;
+         while Local /= Null_Iir loop
+            Formal := Formal_Chain;
+            Pos := 0;
+            while Formal /= Null_Iir loop
+               exit when Get_Identifier (Formal) = Get_Identifier (Local);
+               Formal := Get_Chain (Formal);
+               Pos := Pos + 1;
+            end loop;
+            if Formal = Null_Iir then
+               --  LRM93 5.2.2
+               --  It is an error if such a formal does not exist, or if
+               --  its mode and type are not appropriate for such an
+               --  association.
+               --  FIXME: mode/type check.
+               Error_Msg_Sem
+                 ("cannot associate local " & Disp_Node (Local), Node);
+               exit;
+            end if;
+            if Assoc_List (Pos) /= Null_Iir then
+               raise Internal_Error;
+            end if;
+            Assoc_List (Pos) := Local;
+
+            Local := Get_Chain (Local);
+         end loop;
+
+         Sub_Chain_Init (First, Last);
+         Formal := Formal_Chain;
+         for I in Assoc_List'Range loop
+            if Assoc_List (I) = Null_Iir then
+               --  LRM93 5.2.2
+               --  Any remaining unassociated formals are associated with the
+               --  actual designator any.
+               Assoc := Create_Iir (Iir_Kind_Association_Element_Open);
+            else
+               Assoc :=
+                 Create_Iir (Iir_Kind_Association_Element_By_Expression);
+               Set_Actual (Assoc, Assoc_List (I));
+            end if;
+            Set_Whole_Association_Flag (Assoc, True);
+            Set_Formal (Assoc, Formal);
+            Sub_Chain_Append (First, Last, Assoc);
+
+            Formal := Get_Chain (Formal);
+         end loop;
+         return First;
+      end;
+   end Create_Default_Association;
+
+   --  LRM93 §12.4.3
+   function Is_Fully_Bound (Conf : Iir) return Boolean
+   is
+      Binding : Iir;
+   begin
+      if Conf = Null_Iir then
+         return False;
+      end if;
+      case Get_Kind (Conf) is
+         when Iir_Kind_Configuration_Specification
+           | Iir_Kind_Component_Configuration =>
+            Binding := Get_Binding_Indication (Conf);
+            if Binding = Null_Iir then
+               return False;
+            end if;
+            if Get_Kind (Get_Entity_Aspect (Binding))
+              = Iir_Kind_Entity_Aspect_Open
+            then
+               return False;
+            end if;
+         when others =>
+            null;
+      end case;
+      return True;
+   end Is_Fully_Bound;
+
+   procedure Elaborate_Component_Instantiation
+     (Instance : Block_Instance_Acc;
+      Stmt : Iir_Component_Instantiation_Statement)
+   is
+      Frame : Block_Instance_Acc;
+   begin
+      if Is_Component_Instantiation (Stmt) then
+         declare
+            Component : constant Iir :=
+              Get_Named_Entity (Get_Instantiated_Unit (Stmt));
+         begin
+            --  Elaboration of a component instantiation statement that
+            --  instanciates a component declaration has no effect unless the
+            --  component instance is either fully bound to a design entity
+            --  defined by an entity declaration and architecture body or is
+            --  bound to a configuration of such a design entity.
+            --  FIXME: in fact the component is created.
+
+            --  If a component instance is so bound, then elaboration of the
+            --  corresponding component instantiation statement consists of the
+            --  elaboration of the implied block statement representing the
+            --  component instance and [...]
+            Frame := Create_Block_Instance (Instance, Component, Stmt);
+
+            Elaborate_Generic_Clause (Frame, Get_Generic_Chain (Component));
+            Elaborate_Generic_Map_Aspect
+              (Frame, Instance, Get_Generic_Map_Aspect_Chain (Stmt));
+            Elaborate_Port_Clause (Frame, Get_Port_Chain (Component));
+            Elaborate_Port_Map_Aspect
+              (Frame, Instance,
+               Get_Port_Chain (Component), Get_Port_Map_Aspect_Chain (Stmt));
+         end;
+      else
+         --  Direct instantiation
+         declare
+            Aspect : constant Iir := Get_Instantiated_Unit (Stmt);
+            Arch : Iir;
+            Config : Iir;
+         begin
+            case Get_Kind (Aspect) is
+               when Iir_Kind_Entity_Aspect_Entity =>
+                  Arch := Get_Architecture (Aspect);
+                  if Arch = Null_Iir then
+                     Arch := Libraries.Get_Latest_Architecture
+                       (Get_Entity (Aspect));
+                  end if;
+                  Config := Get_Library_Unit
+                    (Get_Default_Configuration_Declaration (Arch));
+               when Iir_Kind_Entity_Aspect_Configuration =>
+                  Config := Get_Configuration (Aspect);
+                  Arch := Get_Block_Specification
+                    (Get_Block_Configuration (Config));
+               when Iir_Kind_Entity_Aspect_Open =>
+                  return;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            Config := Get_Block_Configuration (Config);
+
+            Frame := Elaborate_Architecture
+              (Arch, Config, Instance, Stmt,
+               Get_Generic_Map_Aspect_Chain (Stmt),
+               Get_Port_Map_Aspect_Chain (Stmt));
+         end;
+      end if;
+   end Elaborate_Component_Instantiation;
+
+   --  LRM93 12.4.2 Generate Statements
+   procedure Elaborate_Conditional_Generate_Statement
+     (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement)
+   is
+      Scheme : Iir;
+      Ninstance : Block_Instance_Acc;
+      Lit : Iir_Value_Literal_Acc;
+   begin
+      --  LRM93 12.4.2
+      --  For a generate statement with an if generation scheme, elaboration
+      --  consists of the evaluation of the boolean expression, followed by
+      --  the generation of exactly one block statement if the expression
+      --  evaluates to TRUE, and no block statement otherwise.
+      Scheme := Get_Generation_Scheme (Generate);
+      Lit := Execute_Expression (Instance, Scheme);
+      if Lit.B1 /= True then
+         return;
+      end if;
+
+      --  LRM93 12.4.2
+      --  If generated, the block statement has the following form:
+      --  1.  The block label is the same as the label of the generate
+      --      statement.
+      --  2.  The block declarative part consists of a copy of the declarative
+      --      items contained within the generate statement.
+      --  3.  The block statement part consists of a copy of the concurrent
+      --      statement contained within the generate statement.
+      Ninstance := Create_Block_Instance (Instance, Generate, Generate);
+      Elaborate_Declarative_Part (Ninstance, Get_Declaration_Chain (Generate));
+      Elaborate_Statement_Part
+        (Ninstance, Get_Concurrent_Statement_Chain (Generate));
+   end Elaborate_Conditional_Generate_Statement;
+
+   --  LRM93 12.4.2 Generate Statements
+   procedure Elaborate_Iterative_Generate_Statement
+     (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement)
+   is
+      Scheme : constant Iir_Iterator_Declaration :=
+        Get_Generation_Scheme (Generate);
+      Ninstance : Block_Instance_Acc;
+      Sub_Instance : Block_Instance_Acc;
+      Bound, Index : Iir_Value_Literal_Acc;
+   begin
+      --  LRM93 12.4.2
+      --  For a generate statement with a for generation scheme, elaboration
+      --  consists of the elaboration of the discrete range
+
+      Ninstance := Create_Block_Instance (Instance, Generate, Generate);
+      Elaborate_Declaration (Ninstance, Scheme);
+      Bound := Execute_Bounds (Ninstance, Get_Type (Scheme));
+
+      --  Index is the iterator value.
+      Index := Unshare (Ninstance.Objects (Get_Info (Scheme).Slot),
+                        Current_Pool);
+
+      --  Initialize the iterator.
+      Store (Index, Bound.Left);
+
+      if not Is_In_Range (Index, Bound) then
+         --  Well, this instance should have never been built.
+         --  Should be destroyed ??
+         raise Internal_Error;
+         return;
+      end if;
+
+      loop
+         Sub_Instance := Create_Block_Instance (Ninstance, Generate, Scheme);
+
+         --  FIXME: this is needed to copy iterator type (if any).  But this
+         --  elaborates the subtype several times (what about side effects).
+         Elaborate_Declaration (Sub_Instance, Scheme);
+
+         --  Store index.
+         Store (Sub_Instance.Objects (Get_Info (Scheme).Slot), Index);
+
+         Elaborate_Declarative_Part
+           (Sub_Instance, Get_Declaration_Chain (Generate));
+         Elaborate_Statement_Part
+           (Sub_Instance, Get_Concurrent_Statement_Chain (Generate));
+
+         Update_Loop_Index (Index, Bound);
+         exit when not Is_In_Range (Index, Bound);
+      end loop;
+      --  FIXME: destroy index ?
+   end Elaborate_Iterative_Generate_Statement;
+
+   procedure Elaborate_Generate_Statement
+     (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement)
+   is
+      Scheme : Iir;
+   begin
+      Scheme := Get_Generation_Scheme (Generate);
+      if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+         Elaborate_Iterative_Generate_Statement (Instance, Generate);
+      else
+         Elaborate_Conditional_Generate_Statement (Instance, Generate);
+      end if;
+   end Elaborate_Generate_Statement;
+
+   procedure Elaborate_Process_Statement
+     (Instance : Block_Instance_Acc; Stmt : Iir)
+   is
+      Proc_Instance : Block_Instance_Acc;
+   begin
+      Proc_Instance := Create_Block_Instance (Instance, Stmt, Stmt);
+
+      Processes_Table.Append (Proc_Instance);
+
+      --  Processes aren't elaborated here.  They are elaborated
+      --  just before simulation.
+   end Elaborate_Process_Statement;
+
+   --  LRM93 §12.4  Elaboration of a Statement Part.
+   procedure Elaborate_Statement_Part
+     (Instance : Block_Instance_Acc; Stmt_Chain: Iir)
+   is
+      Stmt : Iir;
+   begin
+      --  Concurrent statements appearing in the statement part of a block
+      --  must be elaborated before execution begins.
+      --  Elaboration of the statement part of a block consists of the
+      --  elaboration of each concurrent statement in the order given.
+      Stmt := Stmt_Chain;
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Block_Statement =>
+               Elaborate_Block_Statement (Instance, Stmt);
+
+            when Iir_Kind_Sensitized_Process_Statement
+              | Iir_Kind_Process_Statement =>
+               Elaborate_Process_Statement (Instance, Stmt);
+
+            when Iir_Kind_Component_Instantiation_Statement =>
+               Elaborate_Component_Instantiation (Instance, Stmt);
+
+            when Iir_Kind_Generate_Statement =>
+               Elaborate_Generate_Statement (Instance, Stmt);
+
+            when Iir_Kind_Simple_Simultaneous_Statement =>
+               Add_Characteristic_Expression
+                 (Explicit,
+                  Build (Op_Plus,
+                         Instance, Get_Simultaneous_Right (Stmt),
+                         Build (Op_Minus,
+                                Instance, Get_Simultaneous_Left (Stmt))));
+
+            when others =>
+               Error_Kind ("elaborate_statement_part", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Elaborate_Statement_Part;
+
+   --  Compute the default value for declaration DECL, using either
+   --  DEFAULT_VALUE if not null, or the implicit default value for DECL.
+   --  DECL must have a type.
+   function Elaborate_Default_Value (Instance : Block_Instance_Acc; Decl : Iir)
+                                    return Iir_Value_Literal_Acc
+   is
+      Default_Value : constant Iir := Get_Default_Value (Decl);
+      Val : Iir_Value_Literal_Acc;
+   begin
+      if Default_Value /= Null_Iir then
+         Val := Execute_Expression_With_Type
+           (Instance, Default_Value, Get_Type (Decl));
+      else
+         Val := Create_Value_For_Type (Instance, Get_Type (Decl), True);
+      end if;
+      return Val;
+   end Elaborate_Default_Value;
+
+   --  LRM93 §12.3.1.1  Subprogram Declaration and Bodies
+   procedure Elaborate_Interface_List
+     (Instance : Block_Instance_Acc; Inter_Chain : Iir)
+   is
+      Inter : Iir;
+   begin
+      --  elaboration of the parameter interface list
+      --  this in turn involves the elaboration of the subtype indication of
+      --  each interface element to determine the subtype of each formal
+      --  parameter of the subprogram.
+      Inter := Inter_Chain;
+      while Inter /= Null_Iir loop
+         case Get_Kind (Inter) is
+            when Iir_Kind_Signal_Interface_Declaration
+              | Iir_Kind_Variable_Interface_Declaration
+              | Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration =>
+               Elaborate_Subtype_Indication_If_Anonymous
+                 (Instance, Get_Type (Inter));
+            when others =>
+               Error_Kind ("elaborate_interface_list", Inter);
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+   end Elaborate_Interface_List;
+
+   --  LRM93 §12.3.1.1  Subprogram Declaration and Bodies
+   procedure Elaborate_Subprogram_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+   begin
+      --  Elaboration of a subprogram declaration involves the elaboration
+      --  of the parameter interface list of the subprogram declaration; [...]
+      Elaborate_Interface_List
+        (Instance, Get_Interface_Declaration_Chain (Decl));
+
+      --  Elaboration of a subprogram body has no effect other than to
+      --  establish that the body can, from then on, be used for the
+      --  execution of calls of the subprogram.
+      --  FIXME
+      null;
+   end Elaborate_Subprogram_Declaration;
+
+   procedure Elaborate_Component_Configuration
+     (Stmt : Iir_Component_Instantiation_Statement;
+      Comp_Instance : Block_Instance_Acc;
+      Conf : Iir_Component_Configuration)
+   is
+      Component : constant Iir_Component_Declaration :=
+        Get_Named_Entity (Get_Instantiated_Unit (Stmt));
+      Entity : Iir_Entity_Declaration;
+      Arch_Name : Name_Id;
+      Arch_Design : Iir_Design_Unit;
+      Arch : Iir_Architecture_Body;
+      Arch_Frame : Block_Instance_Acc;
+      pragma Unreferenced (Arch_Frame);
+      Generic_Map_Aspect_Chain : Iir;
+      Port_Map_Aspect_Chain : Iir;
+      Binding : Iir_Binding_Indication;
+      Aspect : Iir;
+      Sub_Conf : Iir;
+   begin
+      if Trace_Elaboration then
+         Ada.Text_IO.Put ("configure component ");
+         Ada.Text_IO.Put (Name_Table.Image (Get_Label (Stmt)));
+         Ada.Text_IO.Put (": ");
+         Ada.Text_IO.Put_Line (Image_Identifier (Component));
+      end if;
+
+      --  Elaboration of a component instantiation statement that instanciates
+      --  a component declaration has no effect unless the component instance
+      --  is either fully bound to a design entity defined by an entity
+      --  declaration and architecture body or is bound to a configuration of
+      --  such a design entity.
+      if not Is_Fully_Bound (Conf) then
+         Warning_Msg (Disp_Node (Stmt) & " not bound");
+         return;
+      end if;
+
+      if Trace_Elaboration then
+         Ada.Text_IO.Put_Line
+           (" using " & Disp_Node (Conf) & " from " & Disp_Location (Conf));
+      end if;
+
+      --  If a component instance is so bound, then elaboration of the
+      --  corresponding component instantiation statement consists of the
+      --  elaboration of the implied block statement representing the
+      --  component instance and [...]
+      --  FIXME: extract frame.
+
+      --  and (within that block) the implied block statement representing the
+      --  design entity to which the component instance is so bound.
+      Arch := Null_Iir;
+      Arch_Name := Null_Identifier;
+      Binding := Get_Binding_Indication (Conf);
+      Aspect := Get_Entity_Aspect (Binding);
+
+      case Get_Kind (Conf) is
+         when Iir_Kind_Component_Configuration =>
+            Sub_Conf := Get_Block_Configuration (Conf);
+         when Iir_Kind_Configuration_Specification =>
+            Sub_Conf := Null_Iir;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      case Get_Kind (Aspect) is
+         when Iir_Kind_Design_Unit =>
+            raise Internal_Error;
+         when Iir_Kind_Entity_Aspect_Entity =>
+            Entity := Get_Entity (Aspect);
+            if Get_Architecture (Aspect) /= Null_Iir then
+               Arch_Name := Get_Identifier (Get_Architecture (Aspect));
+            end if;
+         when Iir_Kind_Entity_Aspect_Configuration =>
+            if Sub_Conf /= Null_Iir then
+               raise Internal_Error;
+            end if;
+            declare
+               Conf : constant Iir := Get_Configuration (Aspect);
+            begin
+               Entity := Get_Entity (Conf);
+               Sub_Conf := Get_Block_Configuration (Conf);
+               Arch := Get_Block_Specification (Sub_Conf);
+            end;
+         when others =>
+            Error_Kind ("elaborate_component_declaration0", Aspect);
+      end case;
+
+      if Arch = Null_Iir then
+         if Arch_Name = Null_Identifier then
+            Arch := Libraries.Get_Latest_Architecture (Entity);
+            if Arch = Null_Iir then
+               Error_Msg_Elab ("no architecture analysed for "
+                                 & Disp_Node (Entity), Stmt);
+            end if;
+            Arch_Name := Get_Identifier (Arch);
+         end if;
+         Arch_Design := Libraries.Load_Secondary_Unit
+           (Get_Design_Unit (Entity), Arch_Name, Stmt);
+         if Arch_Design = Null_Iir then
+            Error_Msg_Elab ("no architecture `" & Name_Table.Image (Arch_Name)
+                              & "' for " & Disp_Node (Entity), Stmt);
+         end if;
+         Arch := Get_Library_Unit (Arch_Design);
+      end if;
+
+      Generic_Map_Aspect_Chain := Get_Generic_Map_Aspect_Chain (Binding);
+      Port_Map_Aspect_Chain := Get_Port_Map_Aspect_Chain (Binding);
+
+      if Generic_Map_Aspect_Chain = Null_Iir then
+         --  LRM93 5.2.2
+         --  The default binding indication includes a default generic map
+         --  aspect if the design entity implied by the entity aspect contains
+         --  formal generic
+         --  GHDL: this condition is checked by create_default_association.
+         Generic_Map_Aspect_Chain :=
+           Create_Default_Association (Get_Generic_Chain (Entity),
+                                       Get_Generic_Chain (Component),
+                                       Stmt);
+      end if;
+
+      if Port_Map_Aspect_Chain = Null_Iir then
+         Port_Map_Aspect_Chain :=
+           Create_Default_Association (Get_Port_Chain (Entity),
+                                       Get_Port_Chain (Component),
+                                       Stmt);
+      end if;
+
+      if Sub_Conf = Null_Iir then
+         Sub_Conf := Get_Default_Configuration_Declaration (Arch);
+         Sub_Conf := Get_Block_Configuration (Get_Library_Unit (Sub_Conf));
+      end if;
+
+      --  FIXME: Use Sub_Conf instead of Arch for Stmt ? (But need to add
+      --  info for block configuration).
+      Arch_Frame := Elaborate_Architecture
+        (Arch, Sub_Conf, Comp_Instance, Arch,
+         Generic_Map_Aspect_Chain, Port_Map_Aspect_Chain);
+   end Elaborate_Component_Configuration;
+
+   procedure Elaborate_Block_Configuration
+     (Conf : Iir_Block_Configuration; Instance : Block_Instance_Acc);
+
+   procedure Apply_Block_Configuration_To_Iterative_Generate
+     (Stmt : Iir; Conf_Chain : Iir; Instance : Block_Instance_Acc)
+   is
+      Scheme : constant Iir := Get_Generation_Scheme (Stmt);
+      Bounds : constant Iir_Value_Literal_Acc :=
+        Execute_Bounds (Instance, Get_Type (Scheme));
+
+      Sub_Instances : Block_Instance_Acc_Array
+        (0 .. Instance_Slot_Type (Bounds.Length - 1));
+
+      type Sub_Conf_Type is array (0 .. Instance_Slot_Type (Bounds.Length - 1))
+        of Boolean;
+      Sub_Conf : Sub_Conf_Type := (others => False);
+
+      Child : Block_Instance_Acc;
+
+      Item : Iir;
+      Prev_Item : Iir;
+      Default_Item : Iir := Null_Iir;
+      Spec : Iir;
+      Expr : Iir_Value_Literal_Acc;
+      Ind : Instance_Slot_Type;
+   begin
+      --  Gather children
+      Child := Instance.Children;
+      for I in reverse Sub_Instances'Range loop
+         Sub_Instances (I) := Child;
+         Child := Child.Brother;
+      end loop;
+      if Child /= null then
+         raise Internal_Error;
+      end if;
+
+      --  Apply configuration items
+      Item := Conf_Chain;
+      while Item /= Null_Iir loop
+         Spec := Get_Block_Specification (Item);
+         if Get_Kind (Spec) = Iir_Kind_Simple_Name then
+            Spec := Get_Named_Entity (Spec);
+         end if;
+         Prev_Item := Get_Prev_Block_Configuration (Item);
+
+         case Get_Kind (Spec) is
+            when Iir_Kind_Slice_Name =>
+               Expr := Execute_Bounds (Instance, Get_Suffix (Spec));
+               Ind := Instance_Slot_Type
+                 (Get_Index_Offset (Execute_Low_Limit (Expr), Bounds, Spec));
+               for I in 1 .. Instance_Slot_Type (Expr.Length) loop
+                  Sub_Conf (Ind + I - 1) := True;
+                  Elaborate_Block_Configuration
+                    (Item, Sub_Instances (Ind + I - 1));
+               end loop;
+            when Iir_Kind_Indexed_Name =>
+               if Get_Index_List (Spec) = Iir_List_Others then
+                  --  Must be the only default block configuration
+                  pragma Assert (Default_Item = Null_Iir);
+                  Default_Item := Item;
+               else
+                  Expr := Execute_Expression
+                    (Instance, Get_First_Element (Get_Index_List (Spec)));
+                  Ind := Instance_Slot_Type
+                    (Get_Index_Offset (Expr, Bounds, Spec));
+                  Sub_Conf (Ind) := True;
+                  Elaborate_Block_Configuration (Item, Sub_Instances (Ind));
+               end if;
+            when Iir_Kind_Generate_Statement =>
+               --  Must be the only block configuration
+               pragma Assert (Item = Conf_Chain);
+               pragma Assert (Prev_Item = Null_Iir);
+               for I in Sub_Instances'Range loop
+                  Sub_Conf (I) := True;
+                  Elaborate_Block_Configuration (Item, Sub_Instances (I));
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Item := Prev_Item;
+      end loop;
+
+      if Default_Item /= Null_Iir then
+         for I in Sub_Instances'Range loop
+            if not Sub_Conf (I) then
+               Elaborate_Block_Configuration
+                 (Default_Item, Sub_Instances (I));
+            end if;
+         end loop;
+      end if;
+   end Apply_Block_Configuration_To_Iterative_Generate;
+
+   procedure Elaborate_Block_Configuration
+     (Conf : Iir_Block_Configuration; Instance : Block_Instance_Acc)
+   is
+      Blk_Info : constant Sim_Info_Acc := Get_Info (Instance.Stmt);
+      Sub_Instances : Block_Instance_Acc_Array
+        (0 .. Blk_Info.Nbr_Instances - 1);
+      type Iir_Array is array (Instance_Slot_Type range <>) of Iir;
+      Sub_Conf : Iir_Array (0 .. Blk_Info.Nbr_Instances - 1) :=
+        (others => Null_Iir);
+
+      Item : Iir;
+   begin
+      pragma Assert (Conf /= Null_Iir);
+
+      --  Associate configuration items with subinstance.  Gather items for
+      --  for-generate statements.
+      Item := Get_Configuration_Item_Chain (Conf);
+      while Item /= Null_Iir loop
+         case Get_Kind (Item) is
+            when Iir_Kind_Block_Configuration =>
+               declare
+                  Spec : Iir;
+                  Gen : Iir_Generate_Statement;
+                  Info : Sim_Info_Acc;
+               begin
+                  Spec := Get_Block_Specification (Item);
+                  if Get_Kind (Spec) = Iir_Kind_Simple_Name then
+                     Spec := Get_Named_Entity (Spec);
+                  end if;
+                  case Get_Kind (Spec) is
+                     when Iir_Kind_Slice_Name
+                       | Iir_Kind_Indexed_Name
+                       | Iir_Kind_Selected_Name =>
+                        --  Block configuration for a generate statement.
+                        Gen := Get_Named_Entity (Get_Prefix (Spec));
+                        Info := Get_Info (Gen);
+                        Set_Prev_Block_Configuration
+                          (Item, Sub_Conf (Info.Inst_Slot));
+                        Sub_Conf (Info.Inst_Slot) := Item;
+                     when Iir_Kind_Generate_Statement =>
+                        Info := Get_Info (Spec);
+                        if Sub_Conf (Info.Inst_Slot) /= Null_Iir then
+                           raise Internal_Error;
+                        end if;
+                        Sub_Conf (Info.Inst_Slot) := Item;
+                     when Iir_Kind_Block_Statement =>
+                        --  Block configuration for a block statement.
+                        Info := Get_Info (Spec);
+                        if Sub_Conf (Info.Inst_Slot) /= Null_Iir then
+                           raise Internal_Error;
+                        end if;
+                        Sub_Conf (Info.Inst_Slot) := Item;
+                     when others =>
+                        Error_Kind ("elaborate_block_configuration1", Spec);
+                  end case;
+               end;
+
+            when Iir_Kind_Component_Configuration =>
+               declare
+                  List : constant Iir_List :=
+                    Get_Instantiation_List (Item);
+                  El : Iir;
+                  Info : Sim_Info_Acc;
+               begin
+                  if List = Iir_List_All or else List = Iir_List_Others then
+                     raise Internal_Error;
+                  end if;
+                  for I in Natural loop
+                     El := Get_Nth_Element (List, I);
+                     exit when El = Null_Iir;
+                     Info := Get_Info (Get_Named_Entity (El));
+                     if Sub_Conf (Info.Inst_Slot) /= Null_Iir then
+                        raise Internal_Error;
+                     end if;
+                     Sub_Conf (Info.Inst_Slot) := Item;
+                  end loop;
+               end;
+
+            when others =>
+               Error_Kind ("elaborate_block_configuration", Item);
+         end case;
+         Item := Get_Chain (Item);
+      end loop;
+
+      --  Gather children.
+      declare
+         Child : Block_Instance_Acc;
+      begin
+         Child := Instance.Children;
+         while Child /= null loop
+            declare
+               Slot : constant Instance_Slot_Type :=
+                 Get_Info (Child.Label).Inst_Slot;
+            begin
+               if Slot /= Invalid_Instance_Slot then
+                  --  Processes have no slot.
+                  if Sub_Instances (Slot) /= null then
+                     raise Internal_Error;
+                  end if;
+                  Sub_Instances (Slot) := Child;
+               end if;
+            end;
+            Child := Child.Brother;
+         end loop;
+      end;
+
+      --  Configure sub instances.
+      declare
+         Stmt : Iir;
+         Info : Sim_Info_Acc;
+         Slot : Instance_Slot_Type;
+      begin
+         Stmt := Get_Concurrent_Statement_Chain (Instance.Stmt);
+         while Stmt /= Null_Iir loop
+            case Get_Kind (Stmt) is
+               when Iir_Kind_Generate_Statement =>
+                  Info := Get_Info (Stmt);
+                  Slot := Info.Inst_Slot;
+                  if Get_Kind (Get_Generation_Scheme (Stmt))
+                    = Iir_Kind_Iterator_Declaration
+                  then
+                     --  Iterative generate: apply to all instances
+                     Apply_Block_Configuration_To_Iterative_Generate
+                       (Stmt, Sub_Conf (Slot), Sub_Instances (Slot));
+                  else
+                     --  Conditional generate: may not be instantiated
+                     if Sub_Instances (Slot) /= null then
+                        Elaborate_Block_Configuration
+                          (Sub_Conf (Slot), Sub_Instances (Slot));
+                     end if;
+                  end if;
+               when Iir_Kind_Block_Statement =>
+                  Info := Get_Info (Stmt);
+                  Slot := Info.Inst_Slot;
+                  Elaborate_Block_Configuration
+                    (Sub_Conf (Slot), Sub_Instances (Slot));
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  if Is_Component_Instantiation (Stmt) then
+                     Info := Get_Info (Stmt);
+                     Slot := Info.Inst_Slot;
+                     Elaborate_Component_Configuration
+                       (Stmt, Sub_Instances (Slot), Sub_Conf (Slot));
+                  else
+                     --  Nothing to do for entity instantiation, will be
+                     --  done during elaboration of statements.
+                     null;
+                  end if;
+               when others =>
+                  null;
+            end case;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+      end;
+   end Elaborate_Block_Configuration;
+
+   procedure Elaborate_Alias_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir_Object_Alias_Declaration)
+   is
+      Alias_Type : Iir;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      --  LRM93 12.3.1.5
+      --  Elaboration of an alias declaration consists of the elaboration
+      --  of the subtype indication to establish the subtype associated
+      --  with the alias, folloed by the creation of the alias as an
+      --  alternative name for the named entity.
+      --  The creation of an alias for an array object involves a check
+      --  that the subtype associated with the alias includes a matching
+      --  element for each element of the named object.
+      --  It is an error if this check fails.
+      Alias_Type := Get_Type (Decl);
+      Elaborate_Subtype_Indication_If_Anonymous (Instance, Alias_Type);
+      Create_Object (Instance, Decl);
+      Res := Execute_Name (Instance, Get_Name (Decl), True);
+      Implicit_Array_Conversion (Instance, Res, Alias_Type, Get_Name (Decl));
+      Instance.Objects (Get_Info (Decl).Slot) :=
+        Unshare_Bounds (Res, Instance_Pool);
+   end Elaborate_Alias_Declaration;
+
+   --  LRM93 §12.3.2.3  Disconnection Specifications
+   procedure Elaborate_Disconnection_Specification
+     (Instance : Block_Instance_Acc;
+      Decl : Iir_Disconnection_Specification)
+   is
+      Time_Val : Iir_Value_Literal_Acc;
+      Time : Iir_Value_Time;
+      List : Iir_List;
+      Sig : Iir;
+      Val : Iir_Value_Literal_Acc;
+   begin
+      --  LRM93 §12.3.2.3
+      --  Elaboration of a disconnection specification proceeds as follows:
+      --  2. The time expression is evaluated to determine the disconnection
+      --     time for drivers of the affected signals.
+      Time_Val := Execute_Expression (Instance, Get_Expression (Decl));
+      Time := Time_Val.I64;
+
+      --  LRM93 5.3
+      --  The time expression in a disconnection specification must be static
+      --  and must evaluate to a non-negative value.
+
+      if Time < 0 then
+         Error_Msg_Sem ("time must be non-negative", Decl);
+      end if;
+
+      --  LRM93 §12.3.2.3
+      --  1. The guarded signal specification is elaborated in order to
+      --     identify the signals affected by the disconnection specification.
+      --
+      --  3. The diconnection time is associated with each affected signal for
+      --     later use in constructing disconnection statements in the
+      --     equivalent processes for guarded assignments to the affected
+      --     signals.
+      List := Get_Signal_List (Decl);
+      case List is
+         when Iir_List_All
+           | Iir_List_Others =>
+            Error_Kind ("elaborate_disconnection_specification", Decl);
+         when others =>
+            for I in Natural loop
+               Sig := Get_Nth_Element (List, I);
+               exit when Sig = Null_Iir;
+               Val := Execute_Name (Instance, Sig, True);
+               Disconnection_Table.Append ((Sig => Val, Time => Time));
+            end loop;
+      end case;
+   end Elaborate_Disconnection_Specification;
+
+   procedure Elaborate_Branch_Quantity_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Terminal_Plus, Terminal_Minus : Iir;
+      Plus, Minus : Iir_Value_Literal_Acc;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := Create_Quantity (Instance, Decl);
+
+      Terminal_Plus := Get_Plus_Terminal (Decl);
+      Plus := Execute_Name (Instance, Terminal_Plus, True);
+      Terminal_Minus := Get_Minus_Terminal (Decl);
+      if Terminal_Minus = Null_Iir then
+         --  Get the reference of the nature
+         --  FIXME: select/index
+         Terminal_Minus := Get_Reference (Get_Nature (Terminal_Plus));
+      end if;
+      Minus := Execute_Name (Instance, Terminal_Minus, True);
+
+      case Iir_Kinds_Branch_Quantity_Declaration (Get_Kind (Decl)) is
+         when Iir_Kind_Across_Quantity_Declaration =>
+            --  Expr: q - P'ref + M'ref
+            Add_Characteristic_Expression
+              (Structural,
+               Build
+                 (Op_Plus, Res.Quantity,
+                  Build (Op_Minus,
+                         Get_Terminal_Reference (Plus.Terminal),
+                         Build (Op_Plus,
+                                Get_Terminal_Reference (Minus.Terminal)))));
+         when Iir_Kind_Through_Quantity_Declaration =>
+            --  P'Contrib <- P'Contrib + q
+            --  M'Contrib <- M'Contrib - q
+            Append_Characteristic_Expression
+              (Plus.Terminal, Build (Op_Plus, Res.Quantity));
+            Append_Characteristic_Expression
+              (Minus.Terminal, Build (Op_Minus, Res.Quantity));
+      end case;
+   end Elaborate_Branch_Quantity_Declaration;
+
+   --  LRM93 §12.3.1  Elaboration of a declaration
+   procedure Elaborate_Declaration (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Expr_Mark : Mark_Type;
+      Val : Iir_Value_Literal_Acc;
+   begin
+      Mark (Expr_Mark, Expr_Pool);
+
+      --  Elaboration of a declaration has the effect of creating the declared
+      --  item.  For each declaration, the language rules (in particular scope
+      --  and visibility rules) are such that it is either impossible or
+      --  illegal to use a given item before the elaboration of its
+      --  corresponding declaration.
+      --  Similarly, it is illegal to call a subprogram before its
+      --  corresponding body is elaborated.
+      case Get_Kind (Decl) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            if not Is_Second_Subprogram_Specification (Decl) then
+               Elaborate_Subprogram_Declaration (Instance, Decl);
+            end if;
+         when Iir_Kind_Implicit_Function_Declaration
+           | Iir_Kind_Implicit_Procedure_Declaration =>
+            null;
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            Elaborate_Type_Definition (Instance, Get_Type_Definition (Decl));
+         when Iir_Kind_Type_Declaration =>
+            Elaborate_Type_Declaration (Instance, Decl);
+         when Iir_Kind_Subtype_Declaration =>
+            Elaborate_Subtype_Indication (Instance, Get_Type (Decl));
+         when Iir_Kind_Iterator_Declaration =>
+            Elaborate_Subtype_Indication_If_Anonymous
+              (Instance, Get_Type (Decl));
+            Val := Create_Value_For_Type (Instance, Get_Type (Decl), True);
+            Create_Object (Instance, Decl);
+            Instance.Objects (Get_Info (Decl).Slot) :=
+              Unshare (Val, Instance_Pool);
+         when Iir_Kind_Signal_Declaration =>
+            Elaborate_Subtype_Indication_If_Anonymous
+              (Instance, Get_Type (Decl));
+            Val := Elaborate_Default_Value (Instance, Decl);
+            Create_Signal (Instance, Decl);
+            Elaborate_Signal (Instance, Decl, Val);
+         when Iir_Kind_Variable_Declaration =>
+            Elaborate_Subtype_Indication_If_Anonymous
+              (Instance, Get_Type (Decl));
+            Val := Elaborate_Default_Value (Instance, Decl);
+            Create_Object (Instance, Decl);
+            Instance.Objects (Get_Info (Decl).Slot) :=
+              Unshare (Val, Instance_Pool);
+         when Iir_Kind_Constant_Declaration =>
+            --  Elaboration of an object declaration that declares an object
+            --  other then a file object proceeds as follows:
+            --  1.  The subtype indication is first elaborated.
+            --      This establishes the subtype of the object.
+            if Get_Deferred_Declaration_Flag (Decl) then
+               Create_Object (Instance, Decl);
+            else
+               Elaborate_Subtype_Indication_If_Anonymous
+                 (Instance, Get_Type (Decl));
+               Val := Elaborate_Default_Value (Instance, Decl);
+               if Get_Deferred_Declaration (Decl) = Null_Iir then
+                  Create_Object (Instance, Decl);
+               end if;
+               Instance.Objects (Get_Info (Decl).Slot) :=
+                 Unshare (Val, Instance_Pool);
+            end if;
+         when Iir_Kind_File_Declaration =>
+            --  LRM93 12.3.1.4
+            --  Elaboration of a file object declaration consists of the
+            --  elaboration of the subtype indication...
+            null;  -- FIXME ??
+            --  ...followed by the creation of object.
+            Create_Object (Instance, Decl);
+            --  If the file object declaration contains file_open_information,
+            --  then the implicit call to FILE_OPEN is then executed.
+            Instance.Objects (Get_Info (Decl).Slot) := Unshare
+              (File_Operation.Elaborate_File_Declaration (Instance, Decl),
+               Instance_Pool);
+         when Iir_Kind_Object_Alias_Declaration =>
+            Elaborate_Alias_Declaration (Instance, Decl);
+         when Iir_Kind_Component_Declaration =>
+            --  LRM93 12.3.1.7
+            --  Elaboration of a component declaration has no effect other
+            --  than to create a template for instantiating component
+            --  instances.
+            null;
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            null;
+         when Iir_Kind_Configuration_Specification =>
+            --  Elaboration of a configuration specification proceeds as
+            --  follows:
+            --  1. The component specification is elaborated in order to
+            --     determine which component instances are affected by the
+            --     configuration specification.
+            --  GHDL: this is done during sem.
+
+            --  2. The binding indication is elaborated to identify the design
+            --     entity to which the affected component instances will be
+            --     bound.
+            --  GHDL: this is already done during sem, according to rules
+            --     defined by section 5.3.1.1
+
+            --  3. The binding information is associated with each affected
+            --     component instance label for later use in instantiating
+            --     those component instances.
+            --  GHDL: this is done during step 1.
+
+            --  As part of this elaboration process, a check is made that both
+            --  the entity declaration and the corresponding architecture body
+            --  implied by the binding indication exist whithin the specified
+            --  library.
+            --  It is an error if this check fails.
+            --  GHDL: this is already done during sem, according to rules
+            --     defined by section 5.3.1.1
+            null;
+
+         when Iir_Kind_Attribute_Declaration =>
+            --  LRM93 12.3.1.6
+            --  Elaboration of an attribute declaration has no effect other
+            --  than to create a template for defining attributes of items.
+            null;
+
+         when Iir_Kind_Attribute_Specification =>
+            --  LRM93 12.3.2.1
+            --  Elaboration of an attribute specification proceeds as follows:
+            --  1. The entity specification is elaborated in order to
+            --     determine which items are affected by the attribute
+            --     specification.
+            --  GHDL: done by sem.
+
+            declare
+               Attr_Decl : constant Iir :=
+                 Get_Named_Entity (Get_Attribute_Designator (Decl));
+               Attr_Type : constant Iir := Get_Type (Attr_Decl);
+               Value : Iir_Attribute_Value;
+               Val : Iir_Value_Literal_Acc;
+            begin
+               Value := Get_Attribute_Value_Spec_Chain (Decl);
+               while Value /= Null_Iir loop
+                  --  2. The expression is evaluated to determine the value
+                  --     of the attribute.
+                  --     It is an error if the value of the expression does not
+                  --     belong to the subtype of the attribute; if the
+                  --     attribute is of an array type, then an implicit
+                  --     subtype conversion is first performed on the value,
+                  --     unless the attribute's subtype indication denotes an
+                  --     unconstrained array type.
+                  Val := Execute_Expression (Instance, Get_Expression (Decl));
+                  Check_Constraints (Instance, Val, Attr_Type, Decl);
+
+                  --  3. A new instance of the designated attribute is created
+                  --     and associated with each of the affected items.
+                  --
+                  --  4. Each new attribute instance is assigned the value of
+                  --     the expression.
+                  Create_Object (Instance, Value);
+                  Instance.Objects (Get_Info (Value).Slot) :=
+                    Unshare (Val, Instance_Pool);
+
+                  Value := Get_Spec_Chain (Value);
+               end loop;
+            end;
+
+         when Iir_Kind_Disconnection_Specification =>
+            Elaborate_Disconnection_Specification (Instance, Decl);
+
+         when Iir_Kind_Use_Clause =>
+            null;
+
+         when Iir_Kind_Delayed_Attribute =>
+            Elaborate_Delayed_Signal (Instance, Decl);
+         when Iir_Kind_Stable_Attribute =>
+            Elaborate_Implicit_Signal (Instance, Decl, Implicit_Stable);
+         when Iir_Kind_Quiet_Attribute =>
+            Elaborate_Implicit_Signal (Instance, Decl, Implicit_Quiet);
+         when Iir_Kind_Transaction_Attribute =>
+            Elaborate_Implicit_Signal (Instance, Decl, Implicit_Transaction);
+
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+         when Iir_Kind_Group_Template_Declaration
+           | Iir_Kind_Group_Declaration =>
+            null;
+         when Iir_Kind_Protected_Type_Body =>
+            null;
+
+         when Iir_Kind_Nature_Declaration =>
+            Elaborate_Nature_Definition (Instance, Get_Nature (Decl));
+            Create_Terminal (Instance, Get_Chain (Decl));
+
+         when Iir_Kind_Terminal_Declaration =>
+            Create_Terminal (Instance, Decl);
+
+         when Iir_Kinds_Branch_Quantity_Declaration =>
+            Elaborate_Branch_Quantity_Declaration (Instance, Decl);
+
+         when others =>
+            Error_Kind ("elaborate_declaration", Decl);
+      end case;
+
+      Release (Expr_Mark, Expr_Pool);
+   end Elaborate_Declaration;
+
+   procedure Destroy_Iterator_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Obj_Type : constant Iir := Get_Type (Decl);
+      Constraint : Iir;
+      Cons_Info : Sim_Info_Acc;
+   begin
+      if Get_Kind (Decl) /= Iir_Kind_Iterator_Declaration then
+         raise Internal_Error;
+      end if;
+      Destroy_Object (Instance, Decl);
+
+      if Get_Kind (Obj_Type) = Iir_Kind_Range_Array_Attribute
+        or else not Is_Anonymous_Type_Definition (Obj_Type)
+      then
+         return;
+      end if;
+
+      Constraint := Get_Range_Constraint (Obj_Type);
+      if Get_Kind (Constraint) /= Iir_Kind_Range_Expression then
+         return;
+      end if;
+      Cons_Info := Get_Info (Constraint);
+      if Cons_Info.Scope_Level = Instance.Scope_Level
+        and then Cons_Info.Slot = Instance.Elab_Objects
+      then
+         Destroy_Object (Instance, Constraint);
+      end if;
+   end Destroy_Iterator_Declaration;
+
+   procedure Finalize_Declarative_Part
+     (Instance : Block_Instance_Acc; Decl_Chain : Iir)
+   is
+      Decl : Iir;
+      Val : Iir_Value_Literal_Acc;
+   begin
+      Decl := Decl_Chain;
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_File_Declaration =>
+               --  LRM93 3.4.1
+               --  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.
+               Val := Instance.Objects (Get_Info (Decl).Slot);
+               if Get_Text_File_Flag (Get_Type (Decl)) then
+                  File_Operation.File_Close_Text (Val, Null_Iir);
+                  File_Operation.File_Destroy_Text (Val);
+               else
+                  File_Operation.File_Close_Binary (Val, Null_Iir);
+                  File_Operation.File_Destroy_Binary (Val);
+               end if;
+            when others =>
+               null;
+         end case;
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Finalize_Declarative_Part;
+
+   --  LRM93 §12.3  Elaboration of a Declarative Part
+   procedure Elaborate_Declarative_Part
+     (Instance : Block_Instance_Acc; Decl_Chain : Iir)
+   is
+      Decl : Iir;
+   begin
+      --  The elaboration of a declarative part consists of the elaboration
+      --  of the declarative items, if any, in the order in which they are
+      --  given in the declarative part.
+      --  [Exception for 'foreign ]
+      Decl := Decl_Chain;
+      while Decl /= Null_Iir loop
+         --  In certain cases, the elaboration of a declarative item involves
+         --  the evaluation of expressions that appear within the declarative
+         --  item.
+         --  The value of any object denoted by a primary in such an expression
+         --  must be defined at the time the primary is read.
+         --  In addition, if a primary in such an expression is a function call
+         --  then the value of any object denoted or appearing as part of an
+         --  actual designator in the function call must be defined at the
+         --  time the expression is evaluated.
+         --  FIXME: check this.
+         Elaborate_Declaration (Instance, Decl);
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Elaborate_Declarative_Part;
+
+   function Elaborate_Architecture (Arch : Iir_Architecture_Body;
+                                    Conf : Iir_Block_Configuration;
+                                    Parent_Instance : Block_Instance_Acc;
+                                    Stmt : Iir;
+                                    Generic_Map : Iir;
+                                    Port_Map : Iir)
+     return Block_Instance_Acc
+   is
+      Entity : constant Iir_Entity_Declaration := Get_Entity (Arch);
+      Instance : Block_Instance_Acc;
+      Expr_Mark : Mark_Type;
+   begin
+      Mark (Expr_Mark, Expr_Pool);
+
+      if Trace_Elaboration then
+         Ada.Text_IO.Put ("elaborating ");
+         Ada.Text_IO.Put (Image_Identifier (Arch));
+         Ada.Text_IO.Put (" of ");
+         Ada.Text_IO.Put_Line (Image_Identifier (Entity));
+      end if;
+
+      Instance := Create_Block_Instance (Parent_Instance, Arch, Stmt);
+      Instance.Up_Block := null; -- Packages_Instance;
+
+      --  LRM93 §12.1
+      --  Elaboration of a block statement involves first elaborating each not
+      --  yet elaborated package containing declarations referenced by the
+      --  block.
+      Elaborate_Dependence (Get_Design_Unit (Arch));
+
+      Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Entity));
+      Elaborate_Generic_Map_Aspect (Instance, Parent_Instance, Generic_Map);
+      Elaborate_Port_Clause (Instance, Get_Port_Chain (Entity));
+      Elaborate_Port_Map_Aspect (Instance, Parent_Instance,
+                                 Get_Port_Chain (Entity), Port_Map);
+
+      Elaborate_Declarative_Part
+        (Instance, Get_Declaration_Chain (Entity));
+      Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Arch));
+      Elaborate_Statement_Part
+        (Instance, Get_Concurrent_Statement_Chain (Entity));
+      Elaborate_Statement_Part
+        (Instance, Get_Concurrent_Statement_Chain (Arch));
+
+      --  Configure the unit.  This will create sub units.
+      Elaborate_Block_Configuration (Conf, Instance);
+
+      Release (Expr_Mark, Expr_Pool);
+
+      return Instance;
+   end Elaborate_Architecture;
+
+   -- Elaborate a design.
+   procedure Elaborate_Design (Design: Iir_Design_Unit)
+   is
+      Unit : constant Iir := Get_Library_Unit (Design);
+      Conf_Unit : Iir_Design_Unit;
+      Conf : Iir_Block_Configuration;
+      Arch_Unit : Iir_Design_Unit;
+      Arch : Iir_Architecture_Body;
+      Entity : Iir_Entity_Declaration;
+      Generic_Map : Iir;
+      Port_Map : Iir;
+   begin
+      Package_Instances :=
+        new Block_Instance_Acc_Array (1 .. Instance_Slot_Type (Nbr_Packages));
+
+      --  Use a 'fake' process to execute code during elaboration.
+      Current_Process := No_Process;
+
+      --  Find architecture and configuration for the top unit
+      case Get_Kind (Unit) is
+         when Iir_Kind_Architecture_Body =>
+            Arch := Unit;
+            Conf_Unit := Get_Default_Configuration_Declaration (Unit);
+         when Iir_Kind_Configuration_Declaration =>
+            Conf_Unit := Design;
+            Arch := Get_Block_Specification (Get_Block_Configuration (Unit));
+            Elaborate_Dependence (Design);
+         when others =>
+            Error_Kind ("elaborate_design", Unit);
+      end case;
+
+      Arch_Unit := Get_Design_Unit (Arch);
+      Entity := Get_Entity (Arch);
+
+      Elaborate_Dependence (Arch_Unit);
+
+      --  Sanity check: memory area for expressions must be empty.
+      if not Is_Empty (Expr_Pool) then
+         raise Internal_Error;
+      end if;
+
+      --  Use default values for top entity generics and ports.
+      Generic_Map := Create_Default_Association
+        (Get_Generic_Chain (Entity), Null_Iir, Entity);
+      Port_Map := Create_Default_Association
+        (Get_Port_Chain (Entity), Null_Iir, Entity);
+
+      --  Elaborate from the top configuration.
+      Conf := Get_Block_Configuration (Get_Library_Unit (Conf_Unit));
+      Top_Instance := Elaborate_Architecture
+        (Arch, Conf, null, Arch, Generic_Map, Port_Map);
+
+      Current_Process := null;
+
+      --  Stop now in case of errors.
+      if Nbr_Errors /= 0 then
+         Grt.Errors.Fatal_Error;
+      end if;
+
+      --  Sanity check: memory area for expressions must be empty.
+      if not Is_Empty (Expr_Pool) then
+         raise Internal_Error;
+      end if;
+   end Elaborate_Design;
+
+end Elaboration;
diff --git a/src/simulate/elaboration.ads b/src/simulate/elaboration.ads
new file mode 100644
index 000000000..5a9ea8da2
--- /dev/null
+++ b/src/simulate/elaboration.ads
@@ -0,0 +1,209 @@
+--  Elaboration for interpretation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Deallocation;
+with GNAT.Table;
+with Iirs; use Iirs;
+with Iir_Values; use Iir_Values;
+with Grt.Types;
+with Annotations; use Annotations;
+with Areapools;
+
+--  This package elaborates design hierarchy.
+
+package Elaboration is
+   Trace_Elaboration : Boolean := False;
+   Trace_Drivers : Boolean := False;
+
+   -- A block instance with its architecture/entity declaration is an
+   -- instancied entity.
+   type Block_Instance_Type;
+   type Block_Instance_Acc is access Block_Instance_Type;
+
+   type Objects_Array is array (Object_Slot_Type range <>) of
+     Iir_Value_Literal_Acc;
+
+   -- A block instance with its architecture/entity declaration is an
+   -- instancied entity.
+
+   type Block_Instance_Type (Max_Objs : Object_Slot_Type) is record
+      --  Flag for wait statement: true if not yet executed.
+      In_Wait_Flag : Boolean;
+
+      -- Useful informations for a dynamic block (ie, a frame).
+      -- The scope level and an access to the block of upper scope level.
+      Scope_Level: Scope_Level_Type;
+      Up_Block: Block_Instance_Acc;
+
+      --  Block, architecture, package, process, component instantiation for
+      --  this instance.
+      Label : Iir;
+
+      --  For blocks: corresponding block (different from label for direct
+      --  component instantiation statement and generate iterator).
+      --  For packages: Null_Iir
+      --  For subprograms and processes: statement being executed.
+      Stmt : Iir;
+
+      --  Instanciation tree.
+      --  Parent is always set (but null for top-level block and packages)
+      Parent: Block_Instance_Acc;
+      --  Not null only for blocks and processes.
+      Children: Block_Instance_Acc;
+      Brother: Block_Instance_Acc;
+
+      --  Pool marker for the child (only for subprograms and processes).
+      Marker : Areapools.Mark_Type;
+
+      --  Reference to the actuals, for copy-out when returning from a
+      --  procedure.
+      Actuals_Ref : Value_Array_Acc;
+
+      -- Only for function frame; contains the result.
+      Result: Iir_Value_Literal_Acc;
+
+      --  Last object elaborated (or number of objects elaborated).
+      --  Note: this is generally the slot index of the next object to be
+      --  elaborated (this may be wrong for dynamic objects due to execution
+      --  branches).
+      Elab_Objects : Object_Slot_Type := 0;
+
+      --  Values of the objects in that frame.
+      Objects : Objects_Array (1 .. Max_Objs);
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Block_Instance_Type, Name => Block_Instance_Acc);
+
+   procedure Elaborate_Design (Design: Iir_Design_Unit);
+
+   procedure Elaborate_Declarative_Part
+     (Instance : Block_Instance_Acc; Decl_Chain : Iir);
+
+   --  Reverse operation of Elaborate_Declarative_Part.
+   --  At least, finalize files.
+   procedure Finalize_Declarative_Part
+     (Instance : Block_Instance_Acc; Decl_Chain : Iir);
+
+   procedure Elaborate_Declaration (Instance : Block_Instance_Acc; Decl : Iir);
+
+   procedure Destroy_Iterator_Declaration
+     (Instance : Block_Instance_Acc; Decl : Iir);
+
+   --  Create a value for type DECL.  Initialize it if DEFAULT is true.
+   function Create_Value_For_Type
+     (Block: Block_Instance_Acc; Decl: Iir; Default : Boolean)
+     return Iir_Value_Literal_Acc;
+
+   --  LRM93 §12.3.1.3  Subtype Declarations
+   --  The elaboration of a subtype indication creates a subtype.
+   --  Used for allocator.
+   procedure Elaborate_Subtype_Indication
+     (Instance : Block_Instance_Acc; Ind : Iir);
+
+   --  Create object DECL.
+   --  This does nothing except marking DECL as elaborated.
+   --  Used by simulation to dynamically create subprograms interfaces.
+   procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir);
+   procedure Create_Signal (Instance : Block_Instance_Acc; Decl : Iir);
+
+   Top_Instance: Block_Instance_Acc;
+
+   type Block_Instance_Acc_Array is array (Instance_Slot_Type range <>) of
+     Block_Instance_Acc;
+   type Block_Instance_Acc_Array_Acc is access Block_Instance_Acc_Array;
+
+   Package_Instances : Block_Instance_Acc_Array_Acc;
+
+   --  Disconnections.  For each disconnection specification, the elaborator
+   --  adds an entry in the table.
+   type Disconnection_Entry is record
+      Sig : Iir_Value_Literal_Acc;
+      Time : Iir_Value_Time;
+   end record;
+
+   package Disconnection_Table is new GNAT.Table
+     (Table_Component_Type => Disconnection_Entry,
+      Table_Index_Type => Integer,
+      Table_Low_Bound => 0,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   --  Connections.  For each associations (block/component/entry), the
+   --  elaborator adds an entry in that table.
+   type Connect_Entry is record
+      Formal : Iir_Value_Literal_Acc;
+      Formal_Instance : Block_Instance_Acc;
+      Actual : Iir_Value_Literal_Acc;
+      Actual_Instance : Block_Instance_Acc;
+      Assoc : Iir;
+   end record;
+
+   package Connect_Table is new GNAT.Table
+     (Table_Component_Type => Connect_Entry,
+      Table_Index_Type => Integer,
+      Table_Low_Bound => 0,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   --  Signals.
+   type Signal_Type_Kind is
+     (User_Signal,
+      Implicit_Quiet, Implicit_Stable, Implicit_Delayed,
+      Implicit_Transaction,
+      Guard_Signal);
+
+   type Signal_Entry (Kind : Signal_Type_Kind := User_Signal) is record
+      Decl : Iir;
+      Sig : Iir_Value_Literal_Acc;
+      Instance : Block_Instance_Acc;
+      case Kind is
+         when User_Signal =>
+            Init : Iir_Value_Literal_Acc;
+         when Implicit_Quiet | Implicit_Stable | Implicit_Delayed
+           | Implicit_Transaction =>
+            Time : Grt.Types.Ghdl_I64;
+            Prefix : Iir_Value_Literal_Acc;
+         when Guard_Signal =>
+            null;
+      end case;
+   end record;
+
+   package Signals_Table is new GNAT.Table
+     (Table_Component_Type => Signal_Entry,
+      Table_Index_Type => Integer,
+      Table_Low_Bound => 0,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   type Process_Index_Type is new Natural;
+
+   package Processes_Table is new GNAT.Table
+     (Table_Component_Type => Block_Instance_Acc,
+      Table_Index_Type => Process_Index_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package Protected_Table is new GNAT.Table
+     (Table_Component_Type => Block_Instance_Acc,
+      Table_Index_Type => Protected_Index_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 2,
+      Table_Increment => 100);
+end Elaboration;
diff --git a/src/simulate/execution.adb b/src/simulate/execution.adb
new file mode 100644
index 000000000..ef4cccc46
--- /dev/null
+++ b/src/simulate/execution.adb
@@ -0,0 +1,4837 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO; use Ada.Text_IO;
+with System;
+with Grt.Types; use Grt.Types;
+with Errorout; use Errorout;
+with Std_Package;
+with Evaluation;
+with Iirs_Utils; use Iirs_Utils;
+with Annotations; use Annotations;
+with Name_Table;
+with File_Operation;
+with Debugger; use Debugger;
+with Std_Names;
+with Str_Table;
+with Files_Map;
+with Iir_Chains; use Iir_Chains;
+with Simulation; use Simulation;
+with Grt.Astdio;
+with Grt.Stdio;
+with Grt.Options;
+with Grt.Vstrings;
+with Grt_Interface;
+with Grt.Values;
+with Grt.Errors;
+with Grt.Std_Logic_1164;
+
+package body Execution is
+
+   function Execute_Function_Call
+     (Block: Block_Instance_Acc; Expr: Iir; Imp : Iir)
+     return Iir_Value_Literal_Acc;
+
+   procedure Finish_Sequential_Statements
+     (Proc : Process_State_Acc; Complex_Stmt : Iir);
+   procedure Init_Sequential_Statements
+     (Proc : Process_State_Acc; Complex_Stmt : Iir);
+   procedure Update_Next_Statement (Proc : Process_State_Acc);
+
+   -- Display a message when an assertion has failed.
+   procedure Execute_Failed_Assertion (Report : String;
+                                       Severity : Natural;
+                                       Stmt: Iir);
+
+   function Get_Instance_By_Scope_Level
+     (Instance: Block_Instance_Acc; Scope_Level: Scope_Level_Type)
+      return Block_Instance_Acc
+   is
+      Current: Block_Instance_Acc := Instance;
+   begin
+      while Current /= null loop
+         if Current.Scope_Level = Scope_Level then
+            return Current;
+         end if;
+         Current := Current.Up_Block;
+      end loop;
+      --  Global scope (packages)
+      if Scope_Level < Scope_Level_Global then
+         return Package_Instances (Instance_Slot_Type (-Scope_Level));
+      end if;
+      if Current_Component /= null
+        and then Current_Component.Scope_Level = Scope_Level
+      then
+         return Current_Component;
+      end if;
+      if Scope_Level = Scope_Level_Global then
+         return null;
+      end if;
+      raise Internal_Error;
+   end Get_Instance_By_Scope_Level;
+
+   function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir)
+                                  return Block_Instance_Acc
+   is
+   begin
+      return Get_Instance_By_Scope_Level (Instance,
+                                          Get_Info (Decl).Scope_Level);
+   end Get_Instance_For_Slot;
+
+   function Create_Bounds_From_Length (Block : Block_Instance_Acc;
+                                       Atype : Iir;
+                                       Len : Iir_Index32)
+                                      return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      Index_Bounds : Iir_Value_Literal_Acc;
+   begin
+      Index_Bounds := Execute_Bounds (Block, Atype);
+
+      Res := Create_Range_Value (Left => Index_Bounds.Left,
+                                 Right => null,
+                                 Dir => Index_Bounds.Dir,
+                                 Length => Len);
+
+      if Len = 0 then
+         --  Special case.
+         Res.Right := Res.Left;
+         case Res.Left.Kind is
+            when Iir_Value_I64 =>
+               case Index_Bounds.Dir is
+                  when Iir_To =>
+                     Res.Left := Create_I64_Value (Res.Right.I64 + 1);
+                  when Iir_Downto =>
+                     Res.Left := Create_I64_Value (Res.Right.I64 - 1);
+               end case;
+            when others =>
+               raise Internal_Error;
+         end case;
+      else
+         case Res.Left.Kind is
+            when Iir_Value_E32 =>
+               declare
+                  R : Ghdl_E32;
+               begin
+                  case Index_Bounds.Dir is
+                     when Iir_To =>
+                        R := Res.Left.E32 + Ghdl_E32 (Len - 1);
+                     when Iir_Downto =>
+                        R := Res.Left.E32 - Ghdl_E32 (Len - 1);
+                  end case;
+                  Res.Right := Create_E32_Value (R);
+               end;
+            when Iir_Value_I64 =>
+               declare
+                  R : Ghdl_I64;
+               begin
+                  case Index_Bounds.Dir is
+                     when Iir_To =>
+                        R := Res.Left.I64 + Ghdl_I64 (Len - 1);
+                     when Iir_Downto =>
+                        R := Res.Left.I64 - Ghdl_I64 (Len - 1);
+                  end case;
+                  Res.Right := Create_I64_Value (R);
+               end;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end if;
+      return Res;
+   end Create_Bounds_From_Length;
+
+   function Execute_High_Limit (Bounds : Iir_Value_Literal_Acc)
+                                return Iir_Value_Literal_Acc is
+   begin
+      if Bounds.Dir = Iir_To then
+         return Bounds.Right;
+      else
+         return Bounds.Left;
+      end if;
+   end Execute_High_Limit;
+
+   function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc)
+                               return Iir_Value_Literal_Acc is
+   begin
+      if Bounds.Dir = Iir_To then
+         return Bounds.Left;
+      else
+         return Bounds.Right;
+      end if;
+   end Execute_Low_Limit;
+
+   function Execute_Left_Limit (Bounds : Iir_Value_Literal_Acc)
+                                return Iir_Value_Literal_Acc is
+   begin
+      return Bounds.Left;
+   end Execute_Left_Limit;
+
+   function Execute_Right_Limit (Bounds : Iir_Value_Literal_Acc)
+                                 return Iir_Value_Literal_Acc is
+   begin
+      return Bounds.Right;
+   end Execute_Right_Limit;
+
+   function Execute_Length (Bounds : Iir_Value_Literal_Acc)
+                           return Iir_Value_Literal_Acc is
+   begin
+      return Create_I64_Value (Ghdl_I64 (Bounds.Length));
+   end Execute_Length;
+
+   function Create_Enum_Value (Pos : Natural; Etype : Iir)
+                              return Iir_Value_Literal_Acc
+   is
+      Base_Type : constant Iir := Get_Base_Type (Etype);
+      Mode : constant Iir_Value_Kind :=
+        Get_Info (Base_Type).Scalar_Mode;
+   begin
+      case Mode is
+         when Iir_Value_E32 =>
+            return Create_E32_Value (Ghdl_E32 (Pos));
+         when Iir_Value_B1 =>
+            return Create_B1_Value (Ghdl_B1'Val (Pos));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Create_Enum_Value;
+
+   function String_To_Iir_Value (Str : String) return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := Create_Array_Value (Str'Length, 1);
+      Res.Bounds.D (1) := Create_Range_Value
+        (Create_I64_Value (1),
+         Create_I64_Value (Str'Length),
+         Iir_To);
+      for I in Str'Range loop
+         Res.Val_Array.V (1 + Iir_Index32 (I - Str'First)) :=
+           Create_E32_Value (Character'Pos (Str (I)));
+      end loop;
+      return Res;
+   end String_To_Iir_Value;
+
+   function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc;
+                                     Expr_Type : Iir)
+                                    return String
+   is
+   begin
+      case Get_Kind (Expr_Type) is
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition =>
+            declare
+               Str : String (1 .. 24);
+               Last : Natural;
+            begin
+               Grt.Vstrings.To_String (Str, Last, Val.F64);
+               return Str (Str'First .. Last);
+            end;
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            declare
+               Str : String (1 .. 21);
+               First : Natural;
+            begin
+               Grt.Vstrings.To_String (Str, First, Val.I64);
+               return Str (First .. Str'Last);
+            end;
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            declare
+               Lits : constant Iir_List :=
+                 Get_Enumeration_Literal_List (Expr_Type);
+               Pos : Natural;
+            begin
+               case Val.Kind is
+                  when Iir_Value_B1 =>
+                     Pos := Ghdl_B1'Pos (Val.B1);
+                  when Iir_Value_E32 =>
+                     Pos := Ghdl_E32'Pos (Val.E32);
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               return Name_Table.Image
+                 (Get_Identifier (Get_Nth_Element (Lits, Pos)));
+            end;
+         when Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            declare
+               Str : String (1 .. 21);
+               First : Natural;
+               Id : constant Name_Id :=
+                 Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type)));
+            begin
+               Grt.Vstrings.To_String (Str, First, Val.I64);
+               return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id);
+            end;
+         when others =>
+            Error_Kind ("execute_image_attribute", Expr_Type);
+      end case;
+   end Execute_Image_Attribute;
+
+   function Execute_Shift_Operator (Left : Iir_Value_Literal_Acc;
+                                    Count : Ghdl_I64;
+                                    Expr : Iir)
+                                   return Iir_Value_Literal_Acc
+   is
+      Func : constant Iir_Predefined_Shift_Functions :=
+        Get_Implicit_Definition (Get_Implementation (Expr));
+      Cnt : Iir_Index32;
+      Len : constant Iir_Index32 := Left.Bounds.D (1).Length;
+      Dir_Left : Boolean;
+      P : Iir_Index32;
+      Res : Iir_Value_Literal_Acc;
+      E : Iir_Value_Literal_Acc;
+   begin
+      --  LRM93 7.2.3
+      --  That is, if R is 0 or if L is a null array, the return value is L.
+      if Count = 0 or else Len = 0 then
+         return Left;
+      end if;
+
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Rol =>
+            Dir_Left := True;
+         when Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sra
+           | Iir_Predefined_Array_Ror =>
+            Dir_Left := False;
+      end case;
+      if Count < 0 then
+         Cnt := Iir_Index32 (-Count);
+         Dir_Left := not Dir_Left;
+      else
+         Cnt := Iir_Index32 (Count);
+      end if;
+
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl =>
+            E := Create_Enum_Value
+              (0, Get_Element_Subtype (Get_Base_Type (Get_Type (Expr))));
+         when Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               E := Left.Val_Array.V (Len);
+            else
+               E := Left.Val_Array.V (1);
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            Cnt := Cnt mod Len;
+            if not Dir_Left then
+               Cnt := (Len - Cnt) mod Len;
+            end if;
+      end case;
+
+      Res := Create_Array_Value (1);
+      Res.Bounds.D (1) := Left.Bounds.D (1);
+      Create_Array_Data (Res, Len);
+      P := 1;
+
+      case Func is
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra =>
+            if Dir_Left then
+               if Cnt < Len then
+                  for I in Cnt .. Len - 1 loop
+                     Res.Val_Array.V (P) := Left.Val_Array.V (I + 1);
+                     P := P + 1;
+                  end loop;
+               else
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Res.Val_Array.V (P) := E;
+                  P := P + 1;
+               end loop;
+            else
+               if Cnt > Len then
+                  Cnt := Len;
+               end if;
+               for I in 0 .. Cnt - 1 loop
+                  Res.Val_Array.V (P) := E;
+                  P := P + 1;
+               end loop;
+               for I in Cnt .. Len - 1 loop
+                  Res.Val_Array.V (P) := Left.Val_Array.V (I - Cnt + 1);
+                  P := P + 1;
+               end loop;
+            end if;
+         when Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            for I in 1 .. Len loop
+               Res.Val_Array.V (P) := Left.Val_Array.V (Cnt + 1);
+               P := P + 1;
+               Cnt := Cnt + 1;
+               if Cnt = Len then
+                  Cnt := 0;
+               end if;
+            end loop;
+      end case;
+      return Res;
+   end Execute_Shift_Operator;
+
+   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
+     "0123456789ABCDEF";
+
+   function Execute_Bit_Vector_To_String (Val : Iir_Value_Literal_Acc;
+                                          Log_Base : Natural)
+                                         return Iir_Value_Literal_Acc
+   is
+      Base : constant Natural := 2 ** Log_Base;
+      Blen : constant Natural := Natural (Val.Bounds.D (1).Length);
+      Str : String (1 .. (Blen + Log_Base - 1) / Log_Base);
+      Pos : Natural;
+      V : Natural;
+      N : Natural;
+   begin
+      V := 0;
+      N := 1;
+      Pos := Str'Last;
+      for I in reverse Val.Val_Array.V'Range loop
+         V := V + Ghdl_B1'Pos (Val.Val_Array.V (I).B1) * N;
+         N := N * 2;
+         if N = Base or else I = Val.Val_Array.V'First then
+            Str (Pos) := Hex_Chars (V);
+            Pos := Pos - 1;
+            N := 1;
+            V := 0;
+         end if;
+      end loop;
+      return String_To_Iir_Value (Str);
+   end Execute_Bit_Vector_To_String;
+
+   procedure Check_Std_Ulogic_Dc
+     (Loc : Iir; V : Grt.Std_Logic_1164.Std_Ulogic)
+   is
+      use Grt.Std_Logic_1164;
+   begin
+      if V = '-' then
+         Execute_Failed_Assertion
+           ("STD_LOGIC_1164: '-' operand for matching ordering operator",
+            2, Loc);
+      end if;
+   end Check_Std_Ulogic_Dc;
+
+   --  EXPR is the expression whose implementation is an implicit function.
+   function Execute_Implicit_Function (Block : Block_Instance_Acc;
+                                       Expr: Iir;
+                                       Left_Param : Iir;
+                                       Right_Param : Iir;
+                                       Res_Type : Iir)
+                                      return Iir_Value_Literal_Acc
+   is
+      pragma Unsuppress (Overflow_Check);
+
+      Func : Iir_Predefined_Functions;
+
+      --  Rename definition for monadic operations.
+      Left, Right: Iir_Value_Literal_Acc;
+      Operand : Iir_Value_Literal_Acc renames Left;
+      Result: Iir_Value_Literal_Acc;
+
+      procedure Eval_Right is
+      begin
+         Right := Execute_Expression (Block, Right_Param);
+      end Eval_Right;
+
+      --  Eval right argument, check left and right have same length,
+      --  Create RESULT from left.
+      procedure Eval_Array is
+      begin
+         Eval_Right;
+         if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then
+            Error_Msg_Constraint (Expr);
+         end if;
+         --  Need to copy as the result is modified.
+         Result := Unshare (Left, Expr_Pool'Access);
+      end Eval_Array;
+
+      Imp : Iir;
+   begin
+      Imp := Get_Implementation (Expr);
+      if Get_Kind (Imp) in Iir_Kinds_Denoting_Name then
+         Imp := Get_Named_Entity (Imp);
+      end if;
+      Func := Get_Implicit_Definition (Imp);
+
+      --  Eval left operand.
+      case Func is
+         when Iir_Predefined_Now_Function =>
+            Left := null;
+         when Iir_Predefined_Bit_Rising_Edge
+           | Iir_Predefined_Boolean_Rising_Edge
+           | Iir_Predefined_Bit_Falling_Edge
+           | Iir_Predefined_Boolean_Falling_Edge=>
+            Operand := Execute_Name (Block, Left_Param, True);
+         when others =>
+            Left := Execute_Expression (Block, Left_Param);
+      end case;
+      Right := null;
+
+      case Func is
+         when Iir_Predefined_Error =>
+            raise Internal_Error;
+
+         when Iir_Predefined_Array_Array_Concat
+           | Iir_Predefined_Element_Array_Concat
+           | Iir_Predefined_Array_Element_Concat
+           | Iir_Predefined_Element_Element_Concat =>
+            Eval_Right;
+
+            declare
+               -- Array length of the result.
+               Len: Iir_Index32;
+
+               -- Index into the result.
+               Pos: Iir_Index32;
+            begin
+               -- Compute the length of the result.
+               case Func is
+                  when Iir_Predefined_Array_Array_Concat =>
+                     Len := Left.Val_Array.Len + Right.Val_Array.Len;
+                  when Iir_Predefined_Element_Array_Concat =>
+                     Len := 1 + Right.Val_Array.Len;
+                  when Iir_Predefined_Array_Element_Concat =>
+                     Len := Left.Val_Array.Len + 1;
+                  when Iir_Predefined_Element_Element_Concat =>
+                     Len := 1 + 1;
+                  when others =>
+                     raise Program_Error;
+               end case;
+
+               -- LRM93 7.2.4
+               -- If both operands are null arrays, then the result of the
+               -- concatenation is the right operand.
+               if Len = 0 then
+                  --  Note: this return is allowed since LEFT is free, and
+                  --  RIGHT must not be free.
+                  return Right;
+               end if;
+
+               -- Create the array result.
+               Result := Create_Array_Value (Len, 1);
+               Result.Bounds.D (1) := Create_Bounds_From_Length
+                 (Block, Get_First_Element (Get_Index_Subtype_List (Res_Type)),
+                  Len);
+
+               -- Fill the result: left.
+               case Func is
+                  when Iir_Predefined_Array_Array_Concat
+                    | Iir_Predefined_Array_Element_Concat =>
+                     for I in Left.Val_Array.V'Range loop
+                        Result.Val_Array.V (I) := Left.Val_Array.V (I);
+                     end loop;
+                     Pos := Left.Val_Array.Len;
+                  when Iir_Predefined_Element_Array_Concat
+                    | Iir_Predefined_Element_Element_Concat =>
+                     Result.Val_Array.V (1) := Left;
+                     Pos := 1;
+                  when others =>
+                     raise Program_Error;
+               end case;
+
+               -- Note: here POS is equal to the position of the last element
+               -- filled, or 0 if no elements were filled.
+
+               --  Fill the result: right.
+               case Func is
+                  when Iir_Predefined_Array_Array_Concat
+                    | Iir_Predefined_Element_Array_Concat =>
+                     for I in Right.Val_Array.V'Range loop
+                        Result.Val_Array.V (Pos + I) := Right.Val_Array.V (I);
+                     end loop;
+                  when Iir_Predefined_Array_Element_Concat
+                    | Iir_Predefined_Element_Element_Concat =>
+                     Result.Val_Array.V (Pos + 1) := Right;
+                  when others =>
+                     raise Program_Error;
+               end case;
+            end;
+
+         when Iir_Predefined_Bit_And
+           | Iir_Predefined_Boolean_And =>
+            if Left.B1 = Lit_Enum_0.B1 then
+               --  Short circuit operator.
+               Result := Lit_Enum_0;
+            else
+               Eval_Right;
+               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
+            end if;
+         when Iir_Predefined_Bit_Nand
+           | Iir_Predefined_Boolean_Nand =>
+            if Left.B1 = Lit_Enum_0.B1 then
+               --  Short circuit operator.
+               Result := Lit_Enum_1;
+            else
+               Eval_Right;
+               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
+            end if;
+         when Iir_Predefined_Bit_Or
+           | Iir_Predefined_Boolean_Or =>
+            if Left.B1 = Lit_Enum_1.B1 then
+               --  Short circuit operator.
+               Result := Lit_Enum_1;
+            else
+               Eval_Right;
+               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_1.B1);
+            end if;
+         when Iir_Predefined_Bit_Nor
+           | Iir_Predefined_Boolean_Nor =>
+            if Left.B1 = Lit_Enum_1.B1 then
+               --  Short circuit operator.
+               Result := Lit_Enum_0;
+            else
+               Eval_Right;
+               Result := Boolean_To_Lit (Right.B1 = Lit_Enum_0.B1);
+            end if;
+         when Iir_Predefined_Bit_Xor
+           | Iir_Predefined_Boolean_Xor =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.B1 /= Right.B1);
+         when Iir_Predefined_Bit_Xnor
+           | Iir_Predefined_Boolean_Xnor =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.B1 = Right.B1);
+         when Iir_Predefined_Bit_Not
+           | Iir_Predefined_Boolean_Not =>
+            Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_0.B1);
+
+         when Iir_Predefined_Bit_Condition =>
+            Result := Boolean_To_Lit (Operand.B1 = Lit_Enum_1.B1);
+
+         when Iir_Predefined_Array_Sll
+           | Iir_Predefined_Array_Srl
+           | Iir_Predefined_Array_Sla
+           | Iir_Predefined_Array_Sra
+           | Iir_Predefined_Array_Rol
+           | Iir_Predefined_Array_Ror =>
+            Eval_Right;
+            Result := Execute_Shift_Operator (Left, Right.I64, Expr);
+
+         when Iir_Predefined_Enum_Equality
+           | Iir_Predefined_Integer_Equality
+           | Iir_Predefined_Array_Equality
+           | Iir_Predefined_Access_Equality
+           | Iir_Predefined_Physical_Equality
+           | Iir_Predefined_Floating_Equality
+           | Iir_Predefined_Record_Equality
+           | Iir_Predefined_Bit_Match_Equality
+           | Iir_Predefined_Bit_Array_Match_Equality =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Is_Equal (Left, Right));
+         when Iir_Predefined_Enum_Inequality
+           | Iir_Predefined_Integer_Inequality
+           | Iir_Predefined_Array_Inequality
+           | Iir_Predefined_Access_Inequality
+           | Iir_Predefined_Physical_Inequality
+           | Iir_Predefined_Floating_Inequality
+           | Iir_Predefined_Record_Inequality
+           | Iir_Predefined_Bit_Match_Inequality
+           | Iir_Predefined_Bit_Array_Match_Inequality =>
+            Eval_Right;
+            Result := Boolean_To_Lit (not Is_Equal (Left, Right));
+         when Iir_Predefined_Integer_Less
+           | Iir_Predefined_Physical_Less =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Boolean_To_Lit (Left.I64 < Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Greater
+           | Iir_Predefined_Physical_Greater =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Boolean_To_Lit (Left.I64 > Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Less_Equal
+           | Iir_Predefined_Physical_Less_Equal =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Boolean_To_Lit (Left.I64 <= Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Greater_Equal
+           | Iir_Predefined_Physical_Greater_Equal =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Boolean_To_Lit (Left.I64 >= Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Enum_Less =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_B1 =>
+                  Result := Boolean_To_Lit (Left.B1 < Right.B1);
+               when Iir_Value_E32 =>
+                  Result := Boolean_To_Lit (Left.E32 < Right.E32);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Enum_Greater =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_B1 =>
+                  Result := Boolean_To_Lit (Left.B1 > Right.B1);
+               when Iir_Value_E32 =>
+                  Result := Boolean_To_Lit (Left.E32 > Right.E32);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Enum_Less_Equal =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_B1 =>
+                  Result := Boolean_To_Lit (Left.B1 <= Right.B1);
+               when Iir_Value_E32 =>
+                  Result := Boolean_To_Lit (Left.E32 <= Right.E32);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Enum_Greater_Equal =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_B1 =>
+                  Result := Boolean_To_Lit (Left.B1 >= Right.B1);
+               when Iir_Value_E32 =>
+                  Result := Boolean_To_Lit (Left.E32 >= Right.E32);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Enum_Minimum
+           | Iir_Predefined_Physical_Minimum =>
+            Eval_Right;
+            if Compare_Value (Left, Right) = Less then
+               Result := Left;
+            else
+               Result := Right;
+            end if;
+         when Iir_Predefined_Enum_Maximum
+           | Iir_Predefined_Physical_Maximum =>
+            Eval_Right;
+            if Compare_Value (Left, Right) = Less then
+               Result := Right;
+            else
+               Result := Left;
+            end if;
+
+         when Iir_Predefined_Integer_Plus
+           | Iir_Predefined_Physical_Plus =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (Left.I64 + Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Minus
+           | Iir_Predefined_Physical_Minus =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (Left.I64 - Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Mul =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (Left.I64 * Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Mod =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  if Right.I64 = 0 then
+                     Error_Msg_Constraint (Expr);
+                  end if;
+                  Result := Create_I64_Value (Left.I64 mod Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Rem =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  if Right.I64 = 0 then
+                     Error_Msg_Constraint (Expr);
+                  end if;
+                  Result := Create_I64_Value (Left.I64 rem Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Predefined_Integer_Div =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  if Right.I64 = 0 then
+                     Error_Msg_Constraint (Expr);
+                  end if;
+                  Result := Create_I64_Value (Left.I64 / Right.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Integer_Absolute
+           | Iir_Predefined_Physical_Absolute =>
+            case Operand.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (abs Operand.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Integer_Negation
+           | Iir_Predefined_Physical_Negation =>
+            case Operand.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (-Operand.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Integer_Identity
+           | Iir_Predefined_Physical_Identity =>
+            case Operand.Kind is
+               when Iir_Value_I64 =>
+                  Result := Create_I64_Value (Operand.I64);
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Integer_Exp =>
+            Eval_Right;
+            case Left.Kind is
+               when Iir_Value_I64 =>
+                  if Right.I64 < 0 then
+                     Error_Msg_Constraint (Expr);
+                  end if;
+                  Result := Create_I64_Value (Left.I64 ** Natural (Right.I64));
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Predefined_Integer_Minimum =>
+            Eval_Right;
+            Result := Create_I64_Value (Ghdl_I64'Min (Left.I64, Right.I64));
+         when Iir_Predefined_Integer_Maximum =>
+            Eval_Right;
+            Result := Create_I64_Value (Ghdl_I64'Max (Left.I64, Right.I64));
+
+         when Iir_Predefined_Floating_Mul =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 * Right.F64);
+         when Iir_Predefined_Floating_Div =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 / Right.F64);
+         when Iir_Predefined_Floating_Minus =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 - Right.F64);
+         when Iir_Predefined_Floating_Plus =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 + Right.F64);
+         when Iir_Predefined_Floating_Exp =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 ** Integer (Right.I64));
+         when Iir_Predefined_Floating_Identity =>
+            Result := Create_F64_Value (Operand.F64);
+         when Iir_Predefined_Floating_Negation =>
+            Result := Create_F64_Value (-Operand.F64);
+         when Iir_Predefined_Floating_Absolute =>
+            Result := Create_F64_Value (abs (Operand.F64));
+         when Iir_Predefined_Floating_Less =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.F64 < Right.F64);
+         when Iir_Predefined_Floating_Less_Equal =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.F64 <= Right.F64);
+         when Iir_Predefined_Floating_Greater =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.F64 > Right.F64);
+         when Iir_Predefined_Floating_Greater_Equal =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Left.F64 >= Right.F64);
+
+         when Iir_Predefined_Floating_Minimum =>
+            Eval_Right;
+            Result := Create_F64_Value (Ghdl_F64'Min (Left.F64, Right.F64));
+         when Iir_Predefined_Floating_Maximum =>
+            Eval_Right;
+            Result := Create_F64_Value (Ghdl_F64'Max (Left.F64, Right.F64));
+
+         when Iir_Predefined_Integer_Physical_Mul =>
+            Eval_Right;
+            Result := Create_I64_Value (Left.I64 * Right.I64);
+         when Iir_Predefined_Physical_Integer_Mul =>
+            Eval_Right;
+            Result := Create_I64_Value (Left.I64 * Right.I64);
+         when Iir_Predefined_Physical_Physical_Div =>
+            Eval_Right;
+            Result := Create_I64_Value (Left.I64 / Right.I64);
+         when Iir_Predefined_Physical_Integer_Div =>
+            Eval_Right;
+            Result := Create_I64_Value (Left.I64 / Right.I64);
+         when Iir_Predefined_Real_Physical_Mul =>
+            Eval_Right;
+            Result := Create_I64_Value
+              (Ghdl_I64 (Left.F64 * Ghdl_F64 (Right.I64)));
+         when Iir_Predefined_Physical_Real_Mul =>
+            Eval_Right;
+            Result := Create_I64_Value
+              (Ghdl_I64 (Ghdl_F64 (Left.I64) * Right.F64));
+         when Iir_Predefined_Physical_Real_Div =>
+            Eval_Right;
+            Result := Create_I64_Value
+              (Ghdl_I64 (Ghdl_F64 (Left.I64) / Right.F64));
+
+         when Iir_Predefined_Universal_I_R_Mul =>
+            Eval_Right;
+            Result := Create_F64_Value (Ghdl_F64 (Left.I64) * Right.F64);
+         when Iir_Predefined_Universal_R_I_Mul =>
+            Eval_Right;
+            Result := Create_F64_Value (Left.F64 * Ghdl_F64 (Right.I64));
+
+         when Iir_Predefined_TF_Array_And =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Array_Nand =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 and Right.Val_Array.V (I).B1);
+            end loop;
+         when Iir_Predefined_TF_Array_Or =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Array_Nor =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 or Right.Val_Array.V (I).B1);
+            end loop;
+         when Iir_Predefined_TF_Array_Xor =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Array_Xnor =>
+            Eval_Array;
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 xor Right.Val_Array.V (I).B1);
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_And =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 and Right.B1;
+            end loop;
+         when Iir_Predefined_TF_Element_Array_And =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 and Left.B1;
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_Or =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 or Right.B1;
+            end loop;
+         when Iir_Predefined_TF_Element_Array_Or =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 or Left.B1;
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_Xor =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 xor Right.B1;
+            end loop;
+         when Iir_Predefined_TF_Element_Array_Xor =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 Result.Val_Array.V (I).B1 xor Left.B1;
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_Nand =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 and Right.B1);
+            end loop;
+         when Iir_Predefined_TF_Element_Array_Nand =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 and Left.B1);
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_Nor =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 or Right.B1);
+            end loop;
+         when Iir_Predefined_TF_Element_Array_Nor =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 or Left.B1);
+            end loop;
+
+         when Iir_Predefined_TF_Array_Element_Xnor =>
+            Eval_Right;
+            Result := Unshare (Left, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 xor Right.B1);
+            end loop;
+         when Iir_Predefined_TF_Element_Array_Xnor =>
+            Eval_Right;
+            Result := Unshare (Right, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 :=
+                 not (Result.Val_Array.V (I).B1 xor Left.B1);
+            end loop;
+
+         when Iir_Predefined_TF_Array_Not =>
+            --  Need to copy as the result is modified.
+            Result := Unshare (Operand, Expr_Pool'Access);
+            for I in Result.Val_Array.V'Range loop
+               Result.Val_Array.V (I).B1 := not Result.Val_Array.V (I).B1;
+            end loop;
+
+         when Iir_Predefined_TF_Reduction_And =>
+            Result := Create_B1_Value (True);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 and Operand.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Reduction_Nand =>
+            Result := Create_B1_Value (True);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 and Operand.Val_Array.V (I).B1;
+            end loop;
+            Result.B1 := not Result.B1;
+         when Iir_Predefined_TF_Reduction_Or =>
+            Result := Create_B1_Value (False);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 or Operand.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Reduction_Nor =>
+            Result := Create_B1_Value (False);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 or Operand.Val_Array.V (I).B1;
+            end loop;
+            Result.B1 := not Result.B1;
+         when Iir_Predefined_TF_Reduction_Xor =>
+            Result := Create_B1_Value (False);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 xor Operand.Val_Array.V (I).B1;
+            end loop;
+         when Iir_Predefined_TF_Reduction_Xnor =>
+            Result := Create_B1_Value (False);
+            for I in Operand.Val_Array.V'Range loop
+               Result.B1 := Result.B1 xor Operand.Val_Array.V (I).B1;
+            end loop;
+            Result.B1 := not Result.B1;
+
+         when Iir_Predefined_Bit_Rising_Edge
+           | Iir_Predefined_Boolean_Rising_Edge =>
+            return Boolean_To_Lit
+              (Execute_Event_Attribute (Operand)
+                 and then Execute_Signal_Value (Operand).B1 = True);
+         when Iir_Predefined_Bit_Falling_Edge
+           | Iir_Predefined_Boolean_Falling_Edge =>
+            return Boolean_To_Lit
+              (Execute_Event_Attribute (Operand)
+                 and then Execute_Signal_Value (Operand).B1 = False);
+
+         when Iir_Predefined_Array_Greater =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Compare_Value (Left, Right) = Greater);
+
+         when Iir_Predefined_Array_Greater_Equal =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Compare_Value (Left, Right) >= Equal);
+
+         when Iir_Predefined_Array_Less =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Compare_Value (Left, Right) = Less);
+
+         when Iir_Predefined_Array_Less_Equal =>
+            Eval_Right;
+            Result := Boolean_To_Lit (Compare_Value (Left, Right) <= Equal);
+
+         when Iir_Predefined_Array_Minimum =>
+            Eval_Right;
+            if Compare_Value (Left, Right) = Less then
+               Result := Left;
+            else
+               Result := Right;
+            end if;
+         when Iir_Predefined_Array_Maximum =>
+            Eval_Right;
+            if Compare_Value (Left, Right) = Less then
+               Result := Right;
+            else
+               Result := Left;
+            end if;
+
+         when Iir_Predefined_Vector_Maximum =>
+            declare
+               El_St : constant Iir :=
+                 Get_Return_Type (Get_Implementation (Expr));
+               V : Iir_Value_Literal_Acc;
+            begin
+               Result := Execute_Low_Limit (Execute_Bounds (Block, El_St));
+               for I in Left.Val_Array.V'Range loop
+                  V := Left.Val_Array.V (I);
+                  if Compare_Value (V, Result) = Greater then
+                     Result := V;
+                  end if;
+               end loop;
+            end;
+         when Iir_Predefined_Vector_Minimum =>
+            declare
+               El_St : constant Iir :=
+                 Get_Return_Type (Get_Implementation (Expr));
+               V : Iir_Value_Literal_Acc;
+            begin
+               Result := Execute_High_Limit (Execute_Bounds (Block, El_St));
+               for I in Left.Val_Array.V'Range loop
+                  V := Left.Val_Array.V (I);
+                  if Compare_Value (V, Result) = Less then
+                     Result := V;
+                  end if;
+               end loop;
+            end;
+
+         when Iir_Predefined_Endfile =>
+            Result := Boolean_To_Lit (File_Operation.Endfile (Left, Null_Iir));
+
+         when Iir_Predefined_Now_Function =>
+            Result := Create_I64_Value (Ghdl_I64 (Grt.Types.Current_Time));
+
+         when Iir_Predefined_Integer_To_String
+           | Iir_Predefined_Floating_To_String
+           | Iir_Predefined_Physical_To_String =>
+            Result := String_To_Iir_Value
+              (Execute_Image_Attribute (Left, Get_Type (Left_Param)));
+
+         when Iir_Predefined_Enum_To_String =>
+            declare
+               use Name_Table;
+               Base_Type : constant Iir :=
+                 Get_Base_Type (Get_Type (Left_Param));
+               Lits : constant Iir_List :=
+                 Get_Enumeration_Literal_List (Base_Type);
+               Pos : constant Natural := Get_Enum_Pos (Left);
+               Id : Name_Id;
+            begin
+               if Base_Type = Std_Package.Character_Type_Definition then
+                  Result := String_To_Iir_Value ((1 => Character'Val (Pos)));
+               else
+                  Id := Get_Identifier (Get_Nth_Element (Lits, Pos));
+                  if Is_Character (Id) then
+                     Result := String_To_Iir_Value ((1 => Get_Character (Id)));
+                  else
+                     Result := String_To_Iir_Value (Image (Id));
+                  end if;
+               end if;
+            end;
+
+         when Iir_Predefined_Array_Char_To_String =>
+            declare
+               Str : String (1 .. Natural (Left.Bounds.D (1).Length));
+               Lits : constant Iir_List :=
+                 Get_Enumeration_Literal_List
+                 (Get_Base_Type
+                    (Get_Element_Subtype (Get_Type (Left_Param))));
+               Pos : Natural;
+            begin
+               for I in Left.Val_Array.V'Range loop
+                  Pos := Get_Enum_Pos (Left.Val_Array.V (I));
+                  Str (Positive (I)) := Name_Table.Get_Character
+                    (Get_Identifier (Get_Nth_Element (Lits, Pos)));
+               end loop;
+               Result := String_To_Iir_Value (Str);
+            end;
+
+         when Iir_Predefined_Bit_Vector_To_Hstring =>
+            return Execute_Bit_Vector_To_String (Left, 4);
+
+         when Iir_Predefined_Bit_Vector_To_Ostring =>
+            return Execute_Bit_Vector_To_String (Left, 3);
+
+         when Iir_Predefined_Real_To_String_Digits =>
+            Eval_Right;
+            declare
+               Str : Grt.Vstrings.String_Real_Digits;
+               Last : Natural;
+            begin
+               Grt.Vstrings.To_String
+                 (Str, Last, Left.F64, Ghdl_I32 (Right.I64));
+               Result := String_To_Iir_Value (Str (1 .. Last));
+            end;
+         when Iir_Predefined_Real_To_String_Format =>
+            Eval_Right;
+            declare
+               Format : String (1 .. Natural (Right.Val_Array.Len) + 1);
+               Str : Grt.Vstrings.String_Real_Format;
+               Last : Natural;
+            begin
+               for I in Right.Val_Array.V'Range loop
+                  Format (Positive (I)) :=
+                    Character'Val (Right.Val_Array.V (I).E32);
+               end loop;
+               Format (Format'Last) := ASCII.NUL;
+               Grt.Vstrings.To_String
+                 (Str, Last, Left.F64, To_Ghdl_C_String (Format'Address));
+               Result := String_To_Iir_Value (Str (1 .. Last));
+            end;
+         when Iir_Predefined_Time_To_String_Unit =>
+            Eval_Right;
+            declare
+               Str : Grt.Vstrings.String_Time_Unit;
+               First : Natural;
+               Unit : Iir;
+            begin
+               Unit := Get_Unit_Chain (Std_Package.Time_Type_Definition);
+               while Unit /= Null_Iir loop
+                  exit when Evaluation.Get_Physical_Value (Unit)
+                    = Iir_Int64 (Right.I64);
+                  Unit := Get_Chain (Unit);
+               end loop;
+               if Unit = Null_Iir then
+                  Error_Msg_Exec
+                    ("to_string for time called with wrong unit", Expr);
+               end if;
+               Grt.Vstrings.To_String (Str, First, Left.I64, Right.I64);
+               Result := String_To_Iir_Value
+                 (Str (First .. Str'Last) & ' '
+                    & Name_Table.Image (Get_Identifier (Unit)));
+            end;
+
+         when Iir_Predefined_Std_Ulogic_Match_Equality =>
+            Eval_Right;
+            declare
+               use Grt.Std_Logic_1164;
+            begin
+               Result := Create_E32_Value
+                 (Std_Ulogic'Pos
+                    (Match_Eq_Table (Std_Ulogic'Val (Left.E32),
+                                     Std_Ulogic'Val (Right.E32))));
+            end;
+         when Iir_Predefined_Std_Ulogic_Match_Inequality =>
+            Eval_Right;
+            declare
+               use Grt.Std_Logic_1164;
+            begin
+               Result := Create_E32_Value
+                 (Std_Ulogic'Pos
+                    (Not_Table (Match_Eq_Table (Std_Ulogic'Val (Left.E32),
+                                                Std_Ulogic'Val (Right.E32)))));
+            end;
+         when Iir_Predefined_Std_Ulogic_Match_Ordering_Functions =>
+            Eval_Right;
+            declare
+               use Grt.Std_Logic_1164;
+               L : constant Std_Ulogic := Std_Ulogic'Val (Left.E32);
+               R : constant Std_Ulogic := Std_Ulogic'Val (Right.E32);
+               Res : Std_Ulogic;
+            begin
+               Check_Std_Ulogic_Dc (Expr, L);
+               Check_Std_Ulogic_Dc (Expr, R);
+               case Iir_Predefined_Std_Ulogic_Match_Ordering_Functions (Func)
+                  is
+                  when Iir_Predefined_Std_Ulogic_Match_Less =>
+                     Res := Match_Lt_Table (L, R);
+                  when Iir_Predefined_Std_Ulogic_Match_Less_Equal =>
+                     Res := Or_Table (Match_Lt_Table (L, R),
+                                      Match_Eq_Table (L, R));
+                  when Iir_Predefined_Std_Ulogic_Match_Greater =>
+                     Res := Not_Table (Or_Table (Match_Lt_Table (L, R),
+                                                 Match_Eq_Table (L, R)));
+                  when Iir_Predefined_Std_Ulogic_Match_Greater_Equal =>
+                     Res := Not_Table (Match_Lt_Table (L, R));
+               end case;
+               Result := Create_E32_Value (Std_Ulogic'Pos (Res));
+            end;
+
+         when Iir_Predefined_Std_Ulogic_Array_Match_Equality
+           | Iir_Predefined_Std_Ulogic_Array_Match_Inequality =>
+            Eval_Right;
+            if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then
+               Error_Msg_Constraint (Expr);
+            end if;
+            declare
+               use Grt.Std_Logic_1164;
+               Res : Std_Ulogic := '1';
+            begin
+               Result := Create_E32_Value (Std_Ulogic'Pos ('1'));
+               for I in Left.Val_Array.V'Range loop
+                  Res := And_Table
+                    (Res,
+                     Match_Eq_Table
+                       (Std_Ulogic'Val (Left.Val_Array.V (I).E32),
+                        Std_Ulogic'Val (Right.Val_Array.V (I).E32)));
+               end loop;
+               if Func = Iir_Predefined_Std_Ulogic_Array_Match_Inequality then
+                  Res := Not_Table (Res);
+               end if;
+               Result := Create_E32_Value (Std_Ulogic'Pos (Res));
+            end;
+
+         when others =>
+            Error_Msg ("execute_implicit_function: unimplemented " &
+                       Iir_Predefined_Functions'Image (Func));
+            raise Internal_Error;
+      end case;
+      return Result;
+   exception
+      when Constraint_Error =>
+         Error_Msg_Constraint (Expr);
+   end Execute_Implicit_Function;
+
+   procedure Execute_Implicit_Procedure
+     (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call)
+   is
+      Imp : constant Iir_Implicit_Procedure_Declaration :=
+        Get_Named_Entity (Get_Implementation (Stmt));
+      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
+      Assoc: Iir;
+      Args: Iir_Value_Literal_Array (0 .. 3);
+      Inter_Chain : Iir;
+      Expr_Mark : Mark_Type;
+   begin
+      Mark (Expr_Mark, Expr_Pool);
+      Assoc := Assoc_Chain;
+      for I in Iir_Index32 loop
+         exit when Assoc = Null_Iir;
+         Args (I) := Execute_Expression (Block, Get_Actual (Assoc));
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      Inter_Chain := Get_Interface_Declaration_Chain (Imp);
+      case Get_Implicit_Definition (Imp) is
+         when Iir_Predefined_Deallocate =>
+            if Args (0).Val_Access /= null then
+               Free_Heap_Value (Args (0));
+               Args (0).Val_Access := null;
+            end if;
+         when Iir_Predefined_File_Open =>
+            File_Operation.File_Open
+              (Args (0), Args (1), Args (2), Inter_Chain, Stmt);
+         when Iir_Predefined_File_Open_Status =>
+            File_Operation.File_Open_Status
+              (Args (0), Args (1), Args (2), Args (3),
+               Get_Chain (Inter_Chain), Stmt);
+         when Iir_Predefined_Write =>
+            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
+               File_Operation.Write_Text (Args (0), Args (1));
+            else
+               File_Operation.Write_Binary (Args (0), Args (1));
+            end if;
+         when Iir_Predefined_Read_Length =>
+            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
+               File_Operation.Read_Length_Text
+                 (Args (0), Args (1), Args (2));
+            else
+               File_Operation.Read_Length_Binary
+                 (Args (0), Args (1), Args (2));
+            end if;
+         when Iir_Predefined_Read =>
+            File_Operation.Read_Binary (Args (0), Args (1));
+         when Iir_Predefined_Flush =>
+            File_Operation.Flush (Args (0));
+         when Iir_Predefined_File_Close =>
+            if Get_Text_File_Flag (Get_Type (Inter_Chain)) then
+               File_Operation.File_Close_Text (Args (0), Stmt);
+            else
+               File_Operation.File_Close_Binary (Args (0), Stmt);
+            end if;
+         when others =>
+            Error_Kind ("execute_implicit_procedure",
+                        Get_Implicit_Definition (Imp));
+      end case;
+      Release (Expr_Mark, Expr_Pool);
+   end Execute_Implicit_Procedure;
+
+   procedure Execute_Foreign_Procedure
+     (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call)
+   is
+      Imp : constant Iir_Implicit_Procedure_Declaration :=
+        Get_Implementation (Stmt);
+      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
+      Assoc: Iir;
+      Args: Iir_Value_Literal_Array (0 .. 3) := (others => null);
+      Expr_Mark : Mark_Type;
+   begin
+      Mark (Expr_Mark, Expr_Pool);
+      Assoc := Assoc_Chain;
+      for I in Args'Range loop
+         exit when Assoc = Null_Iir;
+         Args (I) := Execute_Expression (Block, Get_Actual (Assoc));
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      case Get_Identifier (Imp) is
+         when Std_Names.Name_Untruncated_Text_Read =>
+            File_Operation.Untruncated_Text_Read
+              (Args (0), Args (1), Args (2));
+         when Std_Names.Name_Control_Simulation =>
+            Put_Line (Standard_Error, "simulation finished");
+            raise Simulation_Finished;
+         when others =>
+            Error_Msg_Exec ("unsupported foreign procedure call", Stmt);
+      end case;
+      Release (Expr_Mark, Expr_Pool);
+   end Execute_Foreign_Procedure;
+
+   -- Compute the offset for INDEX into a range BOUNDS.
+   -- EXPR is only used in case of error.
+   function Get_Index_Offset
+     (Index: Iir_Value_Literal_Acc;
+      Bounds: Iir_Value_Literal_Acc;
+      Expr: Iir)
+      return Iir_Index32
+   is
+      Left_Pos, Right_Pos: Iir_Value_Literal_Acc;
+   begin
+      Left_Pos := Bounds.Left;
+      Right_Pos := Bounds.Right;
+      if Index.Kind /= Left_Pos.Kind or else Index.Kind /= Right_Pos.Kind then
+         raise Internal_Error;
+      end if;
+      case Index.Kind is
+         when Iir_Value_B1 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  if Index.B1 >= Left_Pos.B1 and then
+                    Index.B1 <= Right_Pos.B1
+                  then
+                     -- to
+                     return Ghdl_B1'Pos (Index.B1) - Ghdl_B1'Pos (Left_Pos.B1);
+                  end if;
+               when Iir_Downto =>
+                  if Index.B1 <= Left_Pos.B1 and then
+                    Index.B1 >= Right_Pos.B1
+                  then
+                     -- downto
+                     return Ghdl_B1'Pos (Left_Pos.B1) - Ghdl_B1'Pos (Index.B1);
+                  end if;
+            end case;
+         when Iir_Value_E32 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  if Index.E32 >= Left_Pos.E32 and then
+                    Index.E32 <= Right_Pos.E32
+                  then
+                     -- to
+                     return Iir_Index32 (Index.E32 - Left_Pos.E32);
+                  end if;
+               when Iir_Downto =>
+                  if Index.E32 <= Left_Pos.E32 and then
+                    Index.E32 >= Right_Pos.E32
+                  then
+                     -- downto
+                     return Iir_Index32 (Left_Pos.E32 - Index.E32);
+                  end if;
+            end case;
+         when Iir_Value_I64 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  if Index.I64 >= Left_Pos.I64 and then
+                    Index.I64 <= Right_Pos.I64
+                  then
+                     -- to
+                     return Iir_Index32 (Index.I64 - Left_Pos.I64);
+                  end if;
+               when Iir_Downto =>
+                  if Index.I64 <= Left_Pos.I64 and then
+                    Index.I64 >= Right_Pos.I64
+                  then
+                     -- downto
+                     return Iir_Index32 (Left_Pos.I64 - Index.I64);
+                  end if;
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Error_Msg_Constraint (Expr);
+      return 0;
+   end Get_Index_Offset;
+
+   --  Create an iir_value_literal of kind iir_value_array and of life LIFE.
+   --  Allocate the array of bounds, and fill it from A_TYPE.
+   --  Allocate the array of values.
+   function Create_Array_Bounds_From_Type
+     (Block : Block_Instance_Acc;
+      A_Type : Iir;
+      Create_Val_Array : Boolean)
+     return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      Index_List : Iir_List;
+      Len : Iir_Index32;
+      Bound : Iir_Value_Literal_Acc;
+   begin
+      --  Only for constrained subtypes.
+      if Get_Kind (A_Type) = Iir_Kind_Array_Type_Definition then
+         raise Internal_Error;
+      end if;
+
+      Index_List := Get_Index_Subtype_List (A_Type);
+      Res := Create_Array_Value
+        (Iir_Index32 (Get_Nbr_Elements (Index_List)));
+      Len := 1;
+      for I in 1 .. Res.Bounds.Nbr_Dims loop
+         Bound := Execute_Bounds
+           (Block, Get_Nth_Element (Index_List, Natural (I - 1)));
+         Len := Len * Bound.Length;
+         Res.Bounds.D (I) := Bound;
+      end loop;
+      if Create_Val_Array then
+         Create_Array_Data (Res, Len);
+      end if;
+      return Res;
+   end Create_Array_Bounds_From_Type;
+
+   --  Return the steps (ie, offset in the array when index DIM is increased
+   --  by one) for array ARR and dimension DIM.
+   function Get_Step_For_Dim (Arr: Iir_Value_Literal_Acc; Dim : Natural)
+     return Iir_Index32
+   is
+      Bounds : Value_Bounds_Array_Acc renames Arr.Bounds;
+      Res : Iir_Index32;
+   begin
+      Res := 1;
+      for I in Iir_Index32 (Dim + 1) .. Bounds.Nbr_Dims loop
+         Res := Res * Bounds.D (I).Length;
+      end loop;
+      return Res;
+   end Get_Step_For_Dim;
+
+   --  Create a literal for a string or a bit_string
+   function String_To_Enumeration_Array_1 (Str: Iir; El_Type : Iir)
+                                          return Iir_Value_Literal_Acc
+   is
+      Lit: Iir_Value_Literal_Acc;
+      Element_Mode : Iir_Value_Scalars;
+
+      procedure Create_Lit_El
+        (Index : Iir_Index32; Literal: Iir_Enumeration_Literal)
+      is
+         R : Iir_Value_Literal_Acc;
+         P : constant Iir_Int32 := Get_Enum_Pos (Literal);
+      begin
+         case Element_Mode is
+            when Iir_Value_B1 =>
+               R := Create_B1_Value (Ghdl_B1'Val (P));
+            when Iir_Value_E32 =>
+               R := Create_E32_Value (Ghdl_E32'Val (P));
+            when others =>
+               raise Internal_Error;
+         end case;
+         Lit.Val_Array.V (Index) := R;
+      end Create_Lit_El;
+
+      El_Btype : constant Iir := Get_Base_Type (El_Type);
+      Literal_List: constant Iir_List :=
+        Get_Enumeration_Literal_List (El_Btype);
+      Len: Iir_Index32;
+      Str_As_Str: constant String := Iirs_Utils.Image_String_Lit (Str);
+      El : Iir;
+   begin
+      Element_Mode := Get_Info (El_Btype).Scalar_Mode;
+
+      case Get_Kind (Str) is
+         when Iir_Kind_String_Literal =>
+            Len := Iir_Index32 (Str_As_Str'Length);
+            Lit := Create_Array_Value (Len, 1);
+
+            for I in Lit.Val_Array.V'Range loop
+               -- FIXME: use literal from type ??
+               El := Find_Name_In_List
+                  (Literal_List,
+                   Name_Table.Get_Identifier (Str_As_Str (Natural (I))));
+               if El = Null_Iir then
+                  -- FIXME: could free what was already built.
+                  return null;
+               end if;
+               Create_Lit_El (I, El);
+            end loop;
+
+         when Iir_Kind_Bit_String_Literal =>
+            declare
+               Lit_0, Lit_1 : Iir;
+               Buf : String_Fat_Acc;
+               Len1 : Int32;
+            begin
+               Lit_0 := Get_Bit_String_0 (Str);
+               Lit_1 := Get_Bit_String_1 (Str);
+               Buf := Str_Table.Get_String_Fat_Acc (Get_String_Id (Str));
+               Len1 := Get_String_Length (Str);
+               Lit := Create_Array_Value (Iir_Index32 (Len1), 1);
+
+               if Lit_0 = Null_Iir or Lit_1 = Null_Iir then
+                  raise Internal_Error;
+               end if;
+               for I in 1 .. Len1 loop
+                  case Buf (I) is
+                     when '0' =>
+                        Create_Lit_El (Iir_Index32 (I), Lit_0);
+                     when '1' =>
+                        Create_Lit_El (Iir_Index32 (I), Lit_1);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end loop;
+            end;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      return Lit;
+   end String_To_Enumeration_Array_1;
+
+   --  Create a literal for a string or a bit_string
+   function String_To_Enumeration_Array (Block: Block_Instance_Acc; Str: Iir)
+      return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      Array_Type: constant Iir := Get_Type (Str);
+      Index_Types : constant Iir_List := Get_Index_Subtype_List (Array_Type);
+   begin
+      if Get_Nbr_Elements (Index_Types) /= 1 then
+         raise Internal_Error; -- array must be unidimensional
+      end if;
+
+      Res := String_To_Enumeration_Array_1
+        (Str, Get_Element_Subtype (Array_Type));
+
+      --  When created from static evaluation, a string may still have an
+      --  unconstrained type.
+      if Get_Constraint_State (Array_Type) /= Fully_Constrained then
+         Res.Bounds.D (1) :=
+           Create_Range_Value (Create_I64_Value (1),
+                               Create_I64_Value (Ghdl_I64 (Res.Val_Array.Len)),
+                               Iir_To,
+                               Res.Val_Array.Len);
+      else
+         Res.Bounds.D (1) :=
+           Execute_Bounds (Block, Get_First_Element (Index_Types));
+      end if;
+
+      --  The range may not be statically constant.
+      if Res.Bounds.D (1).Length /= Res.Val_Array.Len then
+         Error_Msg_Constraint (Str);
+      end if;
+
+      return Res;
+   end String_To_Enumeration_Array;
+
+   --  Fill LENGTH elements of RES, starting at ORIG by steps of STEP.
+   --  Use expressions from (BLOCK, AGGREGATE) to fill the elements.
+   --  EL_TYPE is the type of the array element.
+   procedure Fill_Array_Aggregate_1
+     (Block : Block_Instance_Acc;
+      Aggregate : Iir;
+      Res : Iir_Value_Literal_Acc;
+      Orig : Iir_Index32;
+      Step : Iir_Index32;
+      Dim : Iir_Index32;
+      Nbr_Dim : Iir_Index32;
+      El_Type : Iir)
+   is
+      Value : Iir;
+      Bound : constant Iir_Value_Literal_Acc := Res.Bounds.D (Dim);
+
+      procedure Set_Elem (Pos : Iir_Index32)
+      is
+         Val : Iir_Value_Literal_Acc;
+      begin
+         if Dim = Nbr_Dim then
+            --  VALUE is an expression (which may be an aggregate, but not
+            --  a sub-aggregate.
+            Val := Execute_Expression_With_Type (Block, Value, El_Type);
+            --  LRM93 7.3.2.2
+            --  For a multi-dimensional aggregate of dimension n, a check
+            --  is made that all (n-1)-dimensional subaggregates have the
+            --  same bounds.
+            --  GHDL: I have added an implicit array conversion, however
+            --   it may be useful to allow cases like this:
+            --     type str_array is array (natural range <>)
+            --        of string (10 downto 1);
+            --     constant floats : str_array :=
+            --         ( "00000000.0", HT & "+1.5ABCDE");
+            --   The subtype of the first sub-aggregate (0.0) is
+            --   determinated by the context, according to rule 9 and 4
+            --   of LRM93 7.3.2.2 and therefore is string (10 downto 1),
+            --   while the subtype of the second sub-aggregate (HT & ...)
+            --   is determinated by rules 1 and 2 of LRM 7.2.4, and is
+            --   string (1 to 10).
+            --   Unless an implicit conversion is used, according to the
+            --   LRM, this should fail, but it makes no sens.
+            --
+            --   FIXME: Add a warning, a flag ?
+            --Implicit_Array_Conversion (Block, Val, El_Type, Value);
+            --Check_Constraints (Block, Val, El_Type, Value);
+            Res.Val_Array.V (1 + Orig + Pos * Step) := Val;
+         else
+            case Get_Kind (Value) is
+               when Iir_Kind_Aggregate =>
+                  --  VALUE is a sub-aggregate.
+                  Fill_Array_Aggregate_1 (Block, Value, Res,
+                                          Orig + Pos * Step,
+                                          Step / Res.Bounds.D (Dim + 1).Length,
+                                          Dim + 1, Nbr_Dim, El_Type);
+               when Iir_Kind_String_Literal
+                 | Iir_Kind_Bit_String_Literal =>
+                  pragma Assert (Dim + 1 = Nbr_Dim);
+                  Val := String_To_Enumeration_Array_1 (Value, El_Type);
+                  if Val.Val_Array.Len /= Res.Bounds.D (Nbr_Dim).Length then
+                     Error_Msg_Constraint (Value);
+                  end if;
+                  for I in Val.Val_Array.V'Range loop
+                     Res.Val_Array.V (Orig + Pos * Step + I) :=
+                       Val.Val_Array.V (I);
+                  end loop;
+               when others =>
+                  Error_Kind ("fill_array_aggregate_1", Value);
+            end case;
+         end if;
+      end Set_Elem;
+
+      procedure Set_Elem_By_Expr (Expr : Iir)
+      is
+         Expr_Pos: Iir_Value_Literal_Acc;
+      begin
+         Expr_Pos := Execute_Expression (Block, Expr);
+         Set_Elem (Get_Index_Offset (Expr_Pos, Bound, Expr));
+      end Set_Elem_By_Expr;
+
+      procedure Set_Elem_By_Range (Expr : Iir)
+      is
+         A_Range : Iir_Value_Literal_Acc;
+         High, Low : Iir_Value_Literal_Acc;
+      begin
+         A_Range := Execute_Bounds (Block, Expr);
+         if Is_Nul_Range (A_Range) then
+            return;
+         end if;
+         if A_Range.Dir = Iir_To then
+            High := A_Range.Right;
+            Low := A_Range.Left;
+         else
+            High := A_Range.Left;
+            Low := A_Range.Right;
+         end if;
+
+         --  Locally modified (incremented)
+         Low := Unshare (Low, Expr_Pool'Access);
+
+         loop
+            Set_Elem (Get_Index_Offset (Low, Bound, Expr));
+            exit when Is_Equal (Low, High);
+            Increment (Low);
+         end loop;
+      end Set_Elem_By_Range;
+
+      Length : constant Iir_Index32 := Bound.Length;
+      Assoc : Iir;
+      Pos : Iir_Index32;
+   begin
+      Assoc := Get_Association_Choices_Chain (Aggregate);
+      Pos := 0;
+      while Assoc /= Null_Iir loop
+         Value := Get_Associated_Expr (Assoc);
+         loop
+            case Get_Kind (Assoc) is
+               when Iir_Kind_Choice_By_None =>
+                  if Pos >= Length then
+                     Error_Msg_Constraint (Assoc);
+                  end if;
+                  Set_Elem (Pos);
+                  Pos := Pos + 1;
+               when Iir_Kind_Choice_By_Expression =>
+                  Set_Elem_By_Expr (Get_Choice_Expression (Assoc));
+               when Iir_Kind_Choice_By_Range =>
+                  Set_Elem_By_Range (Get_Choice_Range (Assoc));
+               when Iir_Kind_Choice_By_Others =>
+                  for J in 1 .. Length loop
+                     if Res.Val_Array.V (Orig + J * Step) = null then
+                        Set_Elem (J - 1);
+                     end if;
+                  end loop;
+                  return;
+               when others =>
+                  raise Internal_Error;
+            end case;
+            Assoc := Get_Chain (Assoc);
+            exit when Assoc = Null_Iir;
+            exit when not Get_Same_Alternative_Flag (Assoc);
+         end loop;
+      end loop;
+
+      --  Check each elements have been set.
+      --  FIXME: check directly with type.
+      for J in 1 .. Length loop
+         if Res.Val_Array.V (Orig + J * Step) = null then
+            Error_Msg_Constraint (Aggregate);
+         end if;
+      end loop;
+   end Fill_Array_Aggregate_1;
+
+   --  Use expressions from (BLOCK, AGGREGATE) to fill RES.
+   procedure Fill_Array_Aggregate
+     (Block : Block_Instance_Acc;
+      Aggregate : Iir;
+      Res : Iir_Value_Literal_Acc)
+   is
+      Aggr_Type : constant Iir := Get_Type (Aggregate);
+      El_Type : constant Iir := Get_Element_Subtype (Aggr_Type);
+      Index_List : constant Iir_List := Get_Index_Subtype_List (Aggr_Type);
+      Nbr_Dim : constant Iir_Index32 :=
+        Iir_Index32 (Get_Nbr_Elements (Index_List));
+      Step : Iir_Index32;
+   begin
+      Step := Get_Step_For_Dim (Res, 1);
+      Fill_Array_Aggregate_1
+        (Block, Aggregate, Res, 0, Step, 1, Nbr_Dim, El_Type);
+   end Fill_Array_Aggregate;
+
+   function Execute_Record_Aggregate (Block: Block_Instance_Acc;
+                                      Aggregate: Iir;
+                                      Aggregate_Type: Iir)
+                                     return Iir_Value_Literal_Acc
+   is
+      List : constant Iir_List :=
+        Get_Elements_Declaration_List (Get_Base_Type (Aggregate_Type));
+
+      Res: Iir_Value_Literal_Acc;
+      Expr : Iir;
+
+      procedure Set_Expr (Pos : Iir_Index32) is
+         El : constant Iir := Get_Nth_Element (List, Natural (Pos - 1));
+      begin
+         Res.Val_Record.V (Pos) :=
+           Execute_Expression_With_Type (Block, Expr, Get_Type (El));
+      end Set_Expr;
+
+      Pos : Iir_Index32;
+      Assoc: Iir;
+      N_Expr : Iir;
+   begin
+      Res := Create_Record_Value (Iir_Index32 (Get_Nbr_Elements (List)));
+
+      Assoc := Get_Association_Choices_Chain (Aggregate);
+      Pos := 1;
+      loop
+         N_Expr := Get_Associated_Expr (Assoc);
+         if N_Expr /= Null_Iir then
+            Expr := N_Expr;
+         end if;
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_None =>
+               Set_Expr (Pos);
+               Pos := Pos + 1;
+            when Iir_Kind_Choice_By_Name =>
+               Set_Expr (1 + Get_Element_Position (Get_Choice_Name (Assoc)));
+            when Iir_Kind_Choice_By_Others =>
+               for I in Res.Val_Record.V'Range loop
+                  if Res.Val_Record.V (I) = null then
+                     Set_Expr (I);
+                  end if;
+               end loop;
+            when others =>
+               Error_Kind ("execute_record_aggregate", Assoc);
+         end case;
+         Assoc := Get_Chain (Assoc);
+         exit when Assoc = Null_Iir;
+      end loop;
+      return Res;
+   end Execute_Record_Aggregate;
+
+   function Execute_Aggregate
+     (Block: Block_Instance_Acc;
+      Aggregate: Iir;
+      Aggregate_Type: Iir)
+      return Iir_Value_Literal_Acc
+   is
+   begin
+      case Get_Kind (Aggregate_Type) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Res : Iir_Value_Literal_Acc;
+            begin
+               Res := Create_Array_Bounds_From_Type
+                 (Block, Aggregate_Type, True);
+               Fill_Array_Aggregate (Block, Aggregate, Res);
+               return Res;
+            end;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            return Execute_Record_Aggregate
+              (Block, Aggregate, Aggregate_Type);
+         when others =>
+            Error_Kind ("execute_aggregate", Aggregate_Type);
+      end case;
+   end Execute_Aggregate;
+
+   function Execute_Simple_Aggregate (Block: Block_Instance_Acc; Aggr : Iir)
+                                     return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+      List : constant Iir_List := Get_Simple_Aggregate_List (Aggr);
+   begin
+      Res := Create_Array_Bounds_From_Type (Block, Get_Type (Aggr), True);
+      for I in Res.Val_Array.V'Range loop
+         Res.Val_Array.V (I) :=
+           Execute_Expression (Block, Get_Nth_Element (List, Natural (I - 1)));
+      end loop;
+      return Res;
+   end Execute_Simple_Aggregate;
+
+   --  Fill LENGTH elements of RES, starting at ORIG by steps of STEP.
+   --  Use expressions from (BLOCK, AGGREGATE) to fill the elements.
+   --  EL_TYPE is the type of the array element.
+   procedure Execute_Name_Array_Aggregate
+     (Block : Block_Instance_Acc;
+      Aggregate : Iir;
+      Res : Iir_Value_Literal_Acc;
+      Orig : Iir_Index32;
+      Step : Iir_Index32;
+      Dim : Iir_Index32;
+      Nbr_Dim : Iir_Index32;
+      El_Type : Iir)
+   is
+      Value : Iir;
+      Bound : Iir_Value_Literal_Acc;
+
+      procedure Set_Elem (Pos : Iir_Index32)
+      is
+         Val : Iir_Value_Literal_Acc;
+         Is_Sig : Boolean;
+      begin
+         if Dim = Nbr_Dim then
+            --  VALUE is an expression (which may be an aggregate, but not
+            --  a sub-aggregate.
+            Execute_Name_With_Base (Block, Value, null, Val, Is_Sig);
+            Res.Val_Array.V (1 + Orig + Pos * Step) := Val;
+         else
+            --  VALUE is a sub-aggregate.
+            Execute_Name_Array_Aggregate
+              (Block, Value, Res,
+               Orig + Pos * Step,
+               Step / Res.Bounds.D (Dim + 1).Length,
+               Dim + 1, Nbr_Dim, El_Type);
+         end if;
+      end Set_Elem;
+
+      Assoc : Iir;
+      Pos : Iir_Index32;
+   begin
+      Assoc := Get_Association_Choices_Chain (Aggregate);
+      Bound := Res.Bounds.D (Dim);
+      Pos := 0;
+      while Assoc /= Null_Iir loop
+         Value := Get_Associated_Expr (Assoc);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_None =>
+               null;
+            when Iir_Kind_Choice_By_Expression =>
+               declare
+                  Expr_Pos: Iir_Value_Literal_Acc;
+                  Val : constant Iir := Get_Expression (Assoc);
+               begin
+                  Expr_Pos := Execute_Expression (Block, Val);
+                  Pos := Get_Index_Offset (Expr_Pos, Bound, Val);
+               end;
+            when others =>
+               raise Internal_Error;
+         end case;
+         Set_Elem (Pos);
+         Pos := Pos + 1;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Execute_Name_Array_Aggregate;
+
+   function Execute_Record_Name_Aggregate
+     (Block: Block_Instance_Acc;
+      Aggregate: Iir;
+      Aggregate_Type: Iir)
+      return Iir_Value_Literal_Acc
+   is
+      List : constant Iir_List :=
+        Get_Elements_Declaration_List (Get_Base_Type (Aggregate_Type));
+      Res: Iir_Value_Literal_Acc;
+      Expr : Iir;
+      Pos : Iir_Index32;
+      El_Pos : Iir_Index32;
+      Is_Sig : Boolean;
+      Assoc: Iir;
+   begin
+      Res := Create_Record_Value (Iir_Index32 (Get_Nbr_Elements (List)));
+      Assoc := Get_Association_Choices_Chain (Aggregate);
+      Pos := 0;
+      loop
+         Expr := Get_Associated_Expr (Assoc);
+         if Expr = Null_Iir then
+            --  List of choices is not allowed.
+            raise Internal_Error;
+         end if;
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Choice_By_None =>
+               El_Pos := Pos;
+               Pos := Pos + 1;
+            when Iir_Kind_Choice_By_Name =>
+               El_Pos := Get_Element_Position (Get_Name (Assoc));
+            when Iir_Kind_Choice_By_Others =>
+               raise Internal_Error;
+            when others =>
+               Error_Kind ("execute_record_name_aggregate", Assoc);
+         end case;
+         Execute_Name_With_Base
+           (Block, Expr, null, Res.Val_Record.V (1 + El_Pos), Is_Sig);
+         Assoc := Get_Chain (Assoc);
+         exit when Assoc = Null_Iir;
+      end loop;
+      return Res;
+   end Execute_Record_Name_Aggregate;
+
+   function Execute_Name_Aggregate
+     (Block: Block_Instance_Acc;
+      Aggregate: Iir;
+      Aggregate_Type: Iir)
+      return Iir_Value_Literal_Acc
+   is
+   begin
+      case Get_Kind (Aggregate_Type) is
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            declare
+               Res : Iir_Value_Literal_Acc;
+               El_Type : constant Iir := Get_Element_Subtype (Aggregate_Type);
+               Index_List : constant Iir_List :=
+                 Get_Index_Subtype_List (Aggregate_Type);
+               Nbr_Dim : constant Iir_Index32 :=
+                 Iir_Index32 (Get_Nbr_Elements (Index_List));
+               Step : Iir_Index32;
+            begin
+               Res := Create_Array_Bounds_From_Type
+                 (Block, Aggregate_Type, True);
+               Step := Get_Step_For_Dim (Res, 1);
+               Execute_Name_Array_Aggregate
+                 (Block, Aggregate, Res, 0, Step, 1, Nbr_Dim, El_Type);
+               return Res;
+            end;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            return Execute_Record_Name_Aggregate
+              (Block, Aggregate, Aggregate_Type);
+         when others =>
+            Error_Kind ("execute_name_aggregate", Aggregate_Type);
+      end case;
+   end Execute_Name_Aggregate;
+
+   --  Return the indexes range of dimension DIM for type or object PREFIX.
+   --  DIM starts at 1.
+   function Execute_Indexes
+     (Block: Block_Instance_Acc; Prefix: Iir; Dim : Iir_Int64)
+      return Iir_Value_Literal_Acc
+   is
+   begin
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            declare
+               Index : Iir;
+            begin
+               Index := Get_Nth_Element
+                 (Get_Index_Subtype_List (Get_Type (Prefix)),
+                  Natural (Dim - 1));
+               return Execute_Bounds (Block, Index);
+            end;
+         when Iir_Kinds_Denoting_Name =>
+            return Execute_Indexes (Block, Get_Named_Entity (Prefix), Dim);
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            Error_Kind ("execute_indexes", Prefix);
+         when others =>
+            declare
+               Orig : Iir_Value_Literal_Acc;
+            begin
+               Orig := Execute_Name (Block, Prefix, True);
+               return Orig.Bounds.D (Iir_Index32 (Dim));
+            end;
+      end case;
+   end Execute_Indexes;
+
+   function Execute_Bounds (Block: Block_Instance_Acc; Prefix: Iir)
+      return Iir_Value_Literal_Acc
+   is
+      Bound : Iir_Value_Literal_Acc;
+   begin
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Range_Expression =>
+            declare
+               Info : constant Sim_Info_Acc := Get_Info (Prefix);
+            begin
+               if Info = null then
+                  Bound := Create_Range_Value
+                    (Execute_Expression (Block, Get_Left_Limit (Prefix)),
+                     Execute_Expression (Block, Get_Right_Limit (Prefix)),
+                     Get_Direction (Prefix));
+               elsif Info.Kind = Kind_Object then
+                  Bound := Get_Instance_For_Slot
+                    (Block, Prefix).Objects (Info.Slot);
+               else
+                  raise Internal_Error;
+               end if;
+            end;
+
+         when Iir_Kind_Subtype_Declaration =>
+            return Execute_Bounds (Block, Get_Type (Prefix));
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            --  FIXME: move this block before and avoid recursion.
+            return Execute_Bounds (Block, Get_Range_Constraint (Prefix));
+
+         when Iir_Kind_Range_Array_Attribute =>
+            declare
+               Prefix_Val : Iir_Value_Literal_Acc;
+               Dim : Iir_Int64;
+            begin
+               Dim := Get_Value (Get_Parameter (Prefix));
+               Prefix_Val := Execute_Indexes (Block, Get_Prefix (Prefix), Dim);
+               Bound := Prefix_Val;
+            end;
+         when Iir_Kind_Reverse_Range_Array_Attribute =>
+            declare
+               Dim : Iir_Int64;
+            begin
+               Dim := Get_Value (Get_Parameter (Prefix));
+               Bound := Execute_Indexes (Block, Get_Prefix (Prefix), Dim);
+               case Bound.Dir is
+                  when Iir_To =>
+                     Bound := Create_Range_Value
+                       (Bound.Right, Bound.Left, Iir_Downto, Bound.Length);
+                  when Iir_Downto =>
+                     Bound := Create_Range_Value
+                       (Bound.Right, Bound.Left, Iir_To, Bound.Length);
+               end case;
+            end;
+
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Integer_Type_Definition =>
+            return Execute_Bounds
+              (Block,
+               Get_Range_Constraint (Get_Type (Get_Type_Declarator (Prefix))));
+
+         when Iir_Kinds_Denoting_Name =>
+            return Execute_Bounds (Block, Get_Named_Entity (Prefix));
+
+         when others =>
+            -- Error_Kind ("execute_bounds", Get_Kind (Prefix));
+            declare
+               Prefix_Val: Iir_Value_Literal_Acc;
+            begin
+               Prefix_Val := Execute_Expression (Block, Prefix);
+               Bound := Prefix_Val.Bounds.D (1);
+            end;
+      end case;
+      if not Bound.Dir'Valid then
+         raise Internal_Error;
+      end if;
+      return Bound;
+   end Execute_Bounds;
+
+   -- Perform type conversion as desribed in LRM93 7.3.5
+   function Execute_Type_Conversion (Block: Block_Instance_Acc;
+                                     Conv : Iir_Type_Conversion;
+                                     Val : Iir_Value_Literal_Acc)
+                                    return Iir_Value_Literal_Acc
+   is
+      Target_Type : constant Iir := Get_Type (Conv);
+      Res: Iir_Value_Literal_Acc;
+   begin
+      Res := Val;
+      case Get_Kind (Target_Type) is
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            case Res.Kind is
+               when Iir_Value_I64 =>
+                  null;
+               when Iir_Value_F64 =>
+                  if Res.F64 > Ghdl_F64 (Iir_Int64'Last) or
+                    Res.F64 < Ghdl_F64 (Iir_Int64'First)
+                  then
+                     Error_Msg_Constraint (Conv);
+                  end if;
+                  Res := Create_I64_Value (Ghdl_I64 (Res.F64));
+               when Iir_Value_B1
+                 | Iir_Value_E32
+                 | Iir_Value_Range
+                 | Iir_Value_Array
+                 | Iir_Value_Signal
+                 | Iir_Value_Record
+                 | Iir_Value_Access
+                 | Iir_Value_File
+                 | Iir_Value_Protected
+                 | Iir_Value_Quantity
+                 | Iir_Value_Terminal =>
+                  --  These values are not of abstract numeric type.
+                  raise Internal_Error;
+            end case;
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition =>
+            case Res.Kind is
+               when Iir_Value_F64 =>
+                  null;
+               when Iir_Value_I64 =>
+                  Res := Create_F64_Value (Ghdl_F64 (Res.I64));
+               when Iir_Value_B1
+                 | Iir_Value_E32
+                 | Iir_Value_Range
+                 | Iir_Value_Array
+                 | Iir_Value_Signal
+                 | Iir_Value_Record
+                 | Iir_Value_Access
+                 | Iir_Value_File
+                 | Iir_Value_Protected
+                 | Iir_Value_Quantity
+                 | Iir_Value_Terminal =>
+                  --  These values are not of abstract numeric type.
+                  raise Internal_Error;
+            end case;
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            -- must be same type.
+            null;
+         when Iir_Kind_Array_Type_Definition =>
+            --  LRM93 7.3.5
+            --  if the type mark denotes an unconstrained array type and the
+            --  operand is not a null array, then for each index position, the
+            --  bounds of the result are obtained by converting the bounds of
+            --  the operand to the corresponding index type of the target type.
+            -- FIXME: what is bound conversion ??
+            null;
+         when Iir_Kind_Array_Subtype_Definition =>
+            --  LRM93 7.3.5
+            --  If the type mark denotes a constrained array subtype, then the
+            --  bounds of the result are those imposed by the type mark.
+            Implicit_Array_Conversion (Block, Res, Target_Type, Conv);
+         when others =>
+            Error_Kind ("execute_type_conversion", Target_Type);
+      end case;
+      Check_Constraints (Block, Res, Target_Type, Conv);
+      return Res;
+   end Execute_Type_Conversion;
+
+   --  Decrement VAL.
+   --  May raise a constraint error using EXPR.
+   function Execute_Dec (Val : Iir_Value_Literal_Acc; Expr : Iir)
+     return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      case Val.Kind is
+         when Iir_Value_B1 =>
+            if Val.B1 = False then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_B1_Value (False);
+         when Iir_Value_E32 =>
+            if Val.E32 = 0 then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_E32_Value (Val.E32 - 1);
+         when Iir_Value_I64 =>
+            if Val.I64 = Ghdl_I64'First then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_I64_Value (Val.I64 - 1);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Execute_Dec;
+
+   --  Increment VAL.
+   --  May raise a constraint error using EXPR.
+   function Execute_Inc (Val : Iir_Value_Literal_Acc; Expr : Iir)
+     return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      case Val.Kind is
+         when Iir_Value_B1 =>
+            if Val.B1 = True then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_B1_Value (True);
+         when Iir_Value_E32 =>
+            if Val.E32 = Ghdl_E32'Last then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_E32_Value (Val.E32 + 1);
+         when Iir_Value_I64 =>
+            if Val.I64 = Ghdl_I64'Last then
+               Error_Msg_Constraint (Expr);
+            end if;
+            Res := Create_I64_Value (Val.I64 + 1);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Execute_Inc;
+
+   function Execute_Expression_With_Type
+     (Block: Block_Instance_Acc;
+      Expr: Iir;
+      Expr_Type : Iir)
+     return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      if Get_Kind (Expr) = Iir_Kind_Aggregate
+        and then not Is_Fully_Constrained_Type (Get_Type (Expr))
+      then
+         return Execute_Aggregate (Block, Expr, Expr_Type);
+      else
+         Res := Execute_Expression (Block, Expr);
+         Implicit_Array_Conversion (Block, Res, Expr_Type, Expr);
+         Check_Constraints (Block, Res, Expr_Type, Expr);
+         return Res;
+      end if;
+   end Execute_Expression_With_Type;
+
+   function Execute_Signal_Init_Value (Block : Block_Instance_Acc; Expr : Iir)
+                                      return Iir_Value_Literal_Acc
+   is
+      Base : constant Iir := Get_Object_Prefix (Expr);
+      Info : constant Sim_Info_Acc := Get_Info (Base);
+      Bblk : Block_Instance_Acc;
+      Base_Val : Iir_Value_Literal_Acc;
+      Res : Iir_Value_Literal_Acc;
+      Is_Sig : Boolean;
+   begin
+      Bblk := Get_Instance_By_Scope_Level (Block, Info.Scope_Level);
+      Base_Val := Bblk.Objects (Info.Slot + 1);
+      Execute_Name_With_Base (Block, Expr, Base_Val, Res, Is_Sig);
+      pragma Assert (Is_Sig);
+      return Res;
+   end Execute_Signal_Init_Value;
+
+   procedure Execute_Name_With_Base (Block: Block_Instance_Acc;
+                                     Expr: Iir;
+                                     Base : Iir_Value_Literal_Acc;
+                                     Res : out Iir_Value_Literal_Acc;
+                                     Is_Sig : out Boolean)
+   is
+      Slot_Block: Block_Instance_Acc;
+   begin
+      --  Default value
+      Is_Sig := False;
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Transaction_Attribute =>
+            Is_Sig := True;
+            if Base /= null then
+               Res := Base;
+            else
+               Slot_Block := Get_Instance_For_Slot (Block, Expr);
+               Res := Slot_Block.Objects (Get_Info (Expr).Slot);
+            end if;
+
+         when Iir_Kind_Object_Alias_Declaration =>
+            pragma Assert (Base = null);
+            --  FIXME: add a flag ?
+            case Get_Kind (Get_Object_Prefix (Expr)) is
+               when Iir_Kind_Signal_Declaration
+                 | Iir_Kind_Signal_Interface_Declaration
+                 | Iir_Kind_Guard_Signal_Declaration =>
+                  Is_Sig := True;
+               when others =>
+                  Is_Sig := False;
+            end case;
+            Slot_Block := Get_Instance_For_Slot (Block, Expr);
+            Res := Slot_Block.Objects (Get_Info (Expr).Slot);
+
+         when Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Terminal_Declaration
+           | Iir_Kinds_Quantity_Declaration =>
+            if Base /= null then
+               Res := Base;
+            else
+               declare
+                  Info : constant Sim_Info_Acc := Get_Info (Expr);
+               begin
+                  Slot_Block :=
+                    Get_Instance_By_Scope_Level (Block, Info.Scope_Level);
+                  Res := Slot_Block.Objects (Info.Slot);
+               end;
+            end if;
+
+         when Iir_Kind_Indexed_Name =>
+            declare
+               Prefix: Iir;
+               Index_List: Iir_List;
+               Index: Iir;
+               Nbr_Dimensions: Iir_Index32;
+               Value: Iir_Value_Literal_Acc;
+               Pfx: Iir_Value_Literal_Acc;
+               Pos, Off : Iir_Index32;
+            begin
+               Prefix := Get_Prefix (Expr);
+               Index_List := Get_Index_List (Expr);
+               Nbr_Dimensions := Iir_Index32 (Get_Nbr_Elements (Index_List));
+               Execute_Name_With_Base (Block, Prefix, Base, Pfx, Is_Sig);
+               for I in 1 .. Nbr_Dimensions loop
+                  Index := Get_Nth_Element (Index_List, Natural (I - 1));
+                  Value := Execute_Expression (Block, Index);
+                  Off := Get_Index_Offset (Value, Pfx.Bounds.D (I), Expr);
+                  if I = 1 then
+                     Pos := Off;
+                  else
+                     Pos := Pos * Pfx.Bounds.D (I).Length + Off;
+                  end if;
+               end loop;
+               Res := Pfx.Val_Array.V (1 + Pos);
+               --  FIXME: free PFX.
+            end;
+
+         when Iir_Kind_Slice_Name =>
+            declare
+               Prefix: Iir;
+               Prefix_Array: Iir_Value_Literal_Acc;
+
+               Srange : Iir_Value_Literal_Acc;
+               Index_Order : Order;
+               -- Lower and upper bounds of the slice.
+               Low, High: Iir_Index32;
+            begin
+               Srange := Execute_Bounds (Block, Get_Suffix (Expr));
+
+               Prefix := Get_Prefix (Expr);
+
+               Execute_Name_With_Base
+                 (Block, Prefix, Base, Prefix_Array, Is_Sig);
+               if Prefix_Array = null then
+                  raise Internal_Error;
+               end if;
+
+               --  LRM93 6.5
+               --  It is an error if the direction of the discrete range is not
+               --  the same as that of the index range of the array denoted by
+               --  the prefix of the slice name.
+               if Srange.Dir /= Prefix_Array.Bounds.D (1).Dir then
+                  Error_Msg_Exec ("slice direction mismatch", Expr);
+               end if;
+
+               --  LRM93 6.5
+               --  It is an error if either of the bounds of the
+               --  discrete range does not belong to the index range of the
+               --  prefixing array, unless the slice is a null slice.
+               Index_Order := Compare_Value (Srange.Left, Srange.Right);
+               if (Srange.Dir = Iir_To and Index_Order = Greater)
+                 or (Srange.Dir = Iir_Downto and Index_Order = Less)
+               then
+                  --  Null slice.
+                  Low := 1;
+                  High := 0;
+               else
+                  Low := Get_Index_Offset
+                    (Srange.Left, Prefix_Array.Bounds.D (1), Expr);
+                  High := Get_Index_Offset
+                    (Srange.Right, Prefix_Array.Bounds.D (1), Expr);
+               end if;
+               Res := Create_Array_Value (High - Low + 1, 1);
+               Res.Bounds.D (1) := Srange;
+               for I in Low .. High loop
+                  Res.Val_Array.V (1 + I - Low) :=
+                    Prefix_Array.Val_Array.V (1 + I);
+               end loop;
+            end;
+
+         when Iir_Kind_Selected_Element =>
+            declare
+               Prefix: Iir_Value_Literal_Acc;
+               Pos: Iir_Index32;
+            begin
+               Execute_Name_With_Base
+                 (Block, Get_Prefix (Expr), Base, Prefix, Is_Sig);
+               Pos := Get_Element_Position (Get_Selected_Element (Expr));
+               Res := Prefix.Val_Record.V (Pos + 1);
+            end;
+
+         when Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference =>
+            declare
+               Prefix: Iir_Value_Literal_Acc;
+            begin
+               Prefix := Execute_Name (Block, Get_Prefix (Expr));
+               Res := Prefix.Val_Access;
+               if Res = null then
+                  Error_Msg_Exec ("deferencing null access", Expr);
+               end if;
+            end;
+
+         when Iir_Kinds_Denoting_Name
+           | Iir_Kind_Attribute_Name =>
+            Execute_Name_With_Base
+              (Block, Get_Named_Entity (Expr), Base, Res, Is_Sig);
+
+         when Iir_Kind_Function_Call =>
+            --  A prefix can be an expression
+            if Base /= null then
+               raise Internal_Error;
+            end if;
+            Res := Execute_Expression (Block, Expr);
+
+         when Iir_Kind_Aggregate =>
+            Res := Execute_Name_Aggregate (Block, Expr, Get_Type (Expr));
+            --  FIXME: is_sig ?
+
+         when others =>
+            Error_Kind ("execute_name_with_base", Expr);
+      end case;
+   end Execute_Name_With_Base;
+
+   function Execute_Name (Block: Block_Instance_Acc;
+                          Expr: Iir;
+                          Ref : Boolean := False)
+                         return Iir_Value_Literal_Acc
+   is
+      Res: Iir_Value_Literal_Acc;
+      Is_Sig : Boolean;
+   begin
+      Execute_Name_With_Base (Block, Expr, null, Res, Is_Sig);
+      if not Is_Sig or else Ref then
+         return Res;
+      else
+         return Execute_Signal_Value (Res);
+      end if;
+   end Execute_Name;
+
+   function Execute_Image_Attribute (Block: Block_Instance_Acc; Expr: Iir)
+                                    return Iir_Value_Literal_Acc
+   is
+      Val : Iir_Value_Literal_Acc;
+      Attr_Type : constant Iir := Get_Type (Get_Prefix (Expr));
+   begin
+      Val := Execute_Expression (Block, Get_Parameter (Expr));
+      return String_To_Iir_Value
+        (Execute_Image_Attribute (Val, Attr_Type));
+   end Execute_Image_Attribute;
+
+   function Execute_Value_Attribute (Block: Block_Instance_Acc;
+                                     Str_Val : Iir_Value_Literal_Acc;
+                                     Expr: Iir)
+                                    return Iir_Value_Literal_Acc
+   is
+      use Grt_Interface;
+      use Name_Table;
+      pragma Unreferenced (Block);
+
+      Expr_Type : constant Iir := Get_Type (Expr);
+      Res : Iir_Value_Literal_Acc;
+
+      Str_Bnd : aliased Std_String_Bound := Build_Bound (Str_Val);
+      Str_Str : aliased Std_String_Uncons (1 .. Str_Bnd.Dim_1.Length);
+      Str : aliased Std_String := (To_Std_String_Basep (Str_Str'Address),
+                                   To_Std_String_Boundp (Str_Bnd'Address));
+   begin
+      Set_Std_String_From_Iir_Value (Str, Str_Val);
+      case Get_Kind (Expr_Type) is
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
+            Res := Create_I64_Value
+              (Grt.Values.Ghdl_Value_I64 (Str'Unrestricted_Access));
+         when Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Floating_Subtype_Definition =>
+            Res := Create_F64_Value
+              (Grt.Values.Ghdl_Value_F64 (Str'Unrestricted_Access));
+         when Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            declare
+               Is_Real : Boolean;
+               Lit_Pos : Ghdl_Index_Type;
+               Lit_End : Ghdl_Index_Type;
+               Unit_Pos : Ghdl_Index_Type;
+               Unit_Len : Ghdl_Index_Type;
+               Mult : Ghdl_I64;
+               Unit : Iir;
+               Unit_Id : Name_Id;
+            begin
+               Grt.Values.Ghdl_Value_Physical_Split
+                 (Str'Unrestricted_Access,
+                  Is_Real, Lit_Pos, Lit_End, Unit_Pos);
+
+               --  Find unit.
+               Unit_Len := 0;
+               Unit_Pos := Unit_Pos + 1;   --  From 0 based to 1 based
+               for I in Unit_Pos .. Str_Bnd.Dim_1.Length loop
+                  exit when Grt.Values.Is_Whitespace (Str_Str (I));
+                  Unit_Len := Unit_Len + 1;
+                  Str_Str (I) := Grt.Values.To_LC (Str_Str (I));
+               end loop;
+
+               Unit := Get_Primary_Unit (Expr_Type);
+               while Unit /= Null_Iir loop
+                  Unit_Id := Get_Identifier (Unit);
+                  exit when Get_Name_Length (Unit_Id) = Natural (Unit_Len)
+                    and then Image (Unit_Id) =
+                    String (Str_Str (Unit_Pos .. Unit_Pos + Unit_Len - 1));
+                  Unit := Get_Chain (Unit);
+               end loop;
+
+               if Unit = Null_Iir then
+                  Error_Msg_Exec ("incorrect unit name", Expr);
+               end if;
+               Mult := Ghdl_I64 (Get_Value (Get_Physical_Unit_Value (Unit)));
+
+               Str_Bnd.Dim_1.Length := Lit_End;
+               if Is_Real then
+                  Res := Create_I64_Value
+                    (Ghdl_I64
+                       (Grt.Values.Ghdl_Value_F64 (Str'Unrestricted_Access)
+                          * Ghdl_F64 (Mult)));
+               else
+                  Res := Create_I64_Value
+                    (Grt.Values.Ghdl_Value_I64 (Str'Unrestricted_Access)
+                       * Mult);
+               end if;
+            end;
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
+            declare
+               Lit_Start : Ghdl_Index_Type;
+               Lit_End : Ghdl_Index_Type;
+               Enums : constant Iir_List :=
+                 Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type));
+               Enum : Iir;
+               Enum_Id : Name_Id;
+            begin
+               --  Remove leading and trailing blanks
+               for I in Str_Str'Range loop
+                  if not Grt.Values.Is_Whitespace (Str_Str (I)) then
+                     Lit_Start := I;
+                     exit;
+                  end if;
+               end loop;
+               for I in reverse Lit_Start .. Str_Str'Last loop
+                  if not Grt.Values.Is_Whitespace (Str_Str (I)) then
+                     Lit_End := I;
+                     exit;
+                  end if;
+               end loop;
+
+               --  Convert to lower case.
+               for I in Lit_Start .. Lit_End loop
+                  Str_Str (I) := Grt.Values.To_LC (Str_Str (I));
+               end loop;
+
+               for I in Natural loop
+                  Enum := Get_Nth_Element (Enums, I);
+                  if Enum = Null_Iir then
+                     Error_Msg_Exec ("incorrect unit name", Expr);
+                  end if;
+                  Enum_Id := Get_Identifier (Enum);
+                  exit when (Get_Name_Length (Enum_Id) =
+                               Natural (Lit_End - Lit_Start + 1))
+                    and then (Image (Enum_Id) =
+                                String (Str_Str (Lit_Start .. Lit_End)));
+               end loop;
+
+               return Create_Enum_Value
+                 (Natural (Get_Enum_Pos (Enum)), Expr_Type);
+            end;
+         when others =>
+            Error_Kind ("value_attribute", Expr_Type);
+      end case;
+      return Res;
+   end Execute_Value_Attribute;
+
+   function Execute_Path_Instance_Name_Attribute
+     (Block : Block_Instance_Acc; Attr : Iir)
+     return Iir_Value_Literal_Acc
+   is
+      use Evaluation;
+      use Grt.Vstrings;
+      use Name_Table;
+
+      Name : constant Path_Instance_Name_Type :=
+        Get_Path_Instance_Name_Suffix (Attr);
+      Instance : Block_Instance_Acc;
+      Rstr : Rstring;
+      Is_Instance : constant Boolean :=
+        Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute;
+   begin
+      if Name.Path_Instance = Null_Iir then
+         return String_To_Iir_Value (Name.Suffix);
+      end if;
+
+      Instance := Get_Instance_By_Scope_Level
+        (Block, Get_Info (Name.Path_Instance).Frame_Scope_Level);
+
+      loop
+         case Get_Kind (Instance.Label) is
+            when Iir_Kind_Entity_Declaration =>
+               if Instance.Parent = null then
+                  Prepend (Rstr, Image (Get_Identifier (Instance.Label)));
+                  exit;
+               end if;
+            when Iir_Kind_Architecture_Body =>
+               if Is_Instance then
+                  Prepend (Rstr, ')');
+                  Prepend (Rstr, Image (Get_Identifier (Instance.Label)));
+                  Prepend (Rstr, '(');
+               end if;
+
+               if Is_Instance or else Instance.Parent = null then
+                  Prepend
+                    (Rstr,
+                     Image (Get_Identifier (Get_Entity (Instance.Label))));
+               end if;
+               if Instance.Parent = null then
+                  Prepend (Rstr, ':');
+                  exit;
+               else
+                  Instance := Instance.Parent;
+               end if;
+            when Iir_Kind_Block_Statement =>
+               Prepend (Rstr, Image (Get_Label (Instance.Label)));
+               Prepend (Rstr, ':');
+               Instance := Instance.Parent;
+            when Iir_Kind_Iterator_Declaration =>
+               declare
+                  Val : Iir_Value_Literal_Acc;
+               begin
+                  Val := Execute_Name (Instance, Instance.Label);
+                  Prepend (Rstr, ')');
+                  Prepend (Rstr, Execute_Image_Attribute
+                             (Val, Get_Type (Instance.Label)));
+                  Prepend (Rstr, '(');
+               end;
+               Instance := Instance.Parent;
+            when Iir_Kind_Generate_Statement =>
+               Prepend (Rstr, Image (Get_Label (Instance.Label)));
+               Prepend (Rstr, ':');
+               Instance := Instance.Parent;
+            when Iir_Kind_Component_Instantiation_Statement =>
+               if Is_Instance then
+                  Prepend (Rstr, '@');
+               end if;
+               Prepend (Rstr, Image (Get_Label (Instance.Label)));
+               Prepend (Rstr, ':');
+               Instance := Instance.Parent;
+            when others =>
+               Error_Kind ("Execute_Path_Instance_Name_Attribute",
+                           Instance.Label);
+         end case;
+      end loop;
+      declare
+         Str1 : String (1 .. Length (Rstr));
+         Len1 : Natural;
+      begin
+         Copy (Rstr, Str1, Len1);
+         Free (Rstr);
+         return String_To_Iir_Value (Str1 & ':' & Name.Suffix);
+      end;
+   end Execute_Path_Instance_Name_Attribute;
+
+   --  For 'Last_Event and 'Last_Active: convert the absolute last time to
+   --  a relative delay.
+   function To_Relative_Time (T : Ghdl_I64) return Iir_Value_Literal_Acc is
+      A : Ghdl_I64;
+   begin
+      if T = -Ghdl_I64'Last then
+         A := Ghdl_I64'Last;
+      else
+         A := Ghdl_I64 (Grt.Types.Current_Time) - T;
+      end if;
+      return Create_I64_Value (A);
+   end To_Relative_Time;
+
+   -- Evaluate an expression.
+   function Execute_Expression (Block: Block_Instance_Acc; Expr: Iir)
+                               return Iir_Value_Literal_Acc
+   is
+      Res: Iir_Value_Literal_Acc;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_Signal_Interface_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kind_Stable_Attribute
+           | Iir_Kind_Quiet_Attribute
+           | Iir_Kind_Delayed_Attribute
+           | Iir_Kind_Transaction_Attribute
+           | Iir_Kind_Object_Alias_Declaration =>
+            Res := Execute_Name (Block, Expr);
+            return Res;
+
+         when Iir_Kind_Constant_Interface_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Variable_Interface_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_File_Interface_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Attribute_Value
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference =>
+            return Execute_Name (Block, Expr);
+
+         when Iir_Kinds_Denoting_Name
+           | Iir_Kind_Attribute_Name =>
+            return Execute_Expression (Block, Get_Named_Entity (Expr));
+
+         when Iir_Kind_Aggregate =>
+            return Execute_Aggregate (Block, Expr, Get_Type (Expr));
+         when Iir_Kind_Simple_Aggregate =>
+            return Execute_Simple_Aggregate (Block, Expr);
+
+         when Iir_Kinds_Dyadic_Operator
+           | Iir_Kinds_Monadic_Operator =>
+            declare
+               Imp : Iir;
+            begin
+               Imp := Get_Implementation (Expr);
+               if Get_Kind (Imp) = Iir_Kind_Function_Declaration then
+                  return Execute_Function_Call (Block, Expr, Imp);
+               else
+                  if Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator then
+                     Res := Execute_Implicit_Function
+                       (Block, Expr, Get_Left (Expr), Get_Right (Expr),
+                        Get_Type (Expr));
+                  else
+                     Res := Execute_Implicit_Function
+                       (Block, Expr, Get_Operand (Expr), Null_Iir,
+                        Get_Type (Expr));
+                  end if;
+                  return Res;
+               end if;
+            end;
+
+         when Iir_Kind_Function_Call =>
+            declare
+               Imp : constant Iir :=
+                 Get_Named_Entity (Get_Implementation (Expr));
+               Assoc : Iir;
+               Args : Iir_Array (0 .. 1);
+            begin
+               if Get_Kind (Imp) = Iir_Kind_Function_Declaration then
+                  return Execute_Function_Call (Block, Expr, Imp);
+               else
+                  Assoc := Get_Parameter_Association_Chain (Expr);
+                  if Assoc /= Null_Iir then
+                     Args (0) := Get_Actual (Assoc);
+                     Assoc := Get_Chain (Assoc);
+                  else
+                     Args (0) := Null_Iir;
+                  end if;
+                  if Assoc /= Null_Iir  then
+                     Args (1) := Get_Actual (Assoc);
+                  else
+                     Args (1) := Null_Iir;
+                  end if;
+                  return Execute_Implicit_Function
+                    (Block, Expr, Args (0), Args (1), Get_Type (Expr));
+               end if;
+            end;
+
+         when Iir_Kind_Integer_Literal =>
+            declare
+               Lit_Type : constant Iir := Get_Base_Type (Get_Type (Expr));
+               Lit : constant Iir_Int64 := Get_Value (Expr);
+            begin
+               case Get_Info (Lit_Type).Scalar_Mode is
+                  when Iir_Value_I64 =>
+                     return Create_I64_Value (Ghdl_I64 (Lit));
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            end;
+
+         when Iir_Kind_Floating_Point_Literal =>
+            return Create_F64_Value (Ghdl_F64 (Get_Fp_Value (Expr)));
+
+         when Iir_Kind_Enumeration_Literal =>
+            declare
+               Lit_Type : constant Iir := Get_Base_Type (Get_Type (Expr));
+               Lit : constant Iir_Int32 := Get_Enum_Pos (Expr);
+            begin
+               case Get_Info (Lit_Type).Scalar_Mode is
+                  when Iir_Value_B1 =>
+                     return Create_B1_Value (Ghdl_B1'Val (Lit));
+                  when Iir_Value_E32 =>
+                     return Create_E32_Value (Ghdl_E32 (Lit));
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            end;
+
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Unit_Declaration =>
+            return Create_I64_Value
+              (Ghdl_I64 (Evaluation.Get_Physical_Value (Expr)));
+
+         when Iir_Kind_String_Literal
+           | Iir_Kind_Bit_String_Literal =>
+            return String_To_Enumeration_Array (Block, Expr);
+
+         when Iir_Kind_Null_Literal =>
+            return Null_Lit;
+
+         when Iir_Kind_Overflow_Literal =>
+            Error_Msg_Constraint (Expr);
+            return null;
+
+         when Iir_Kind_Parenthesis_Expression =>
+            return Execute_Expression (Block, Get_Expression (Expr));
+
+         when Iir_Kind_Type_Conversion =>
+            return Execute_Type_Conversion
+              (Block, Expr,
+               Execute_Expression (Block, Get_Expression (Expr)));
+
+         when Iir_Kind_Qualified_Expression =>
+            Res := Execute_Expression_With_Type
+              (Block, Get_Expression (Expr), Get_Type (Get_Type_Mark (Expr)));
+            return Res;
+
+         when Iir_Kind_Allocator_By_Expression =>
+            Res := Execute_Expression (Block, Get_Expression (Expr));
+            Res := Unshare_Heap (Res);
+            return Create_Access_Value (Res);
+
+         when Iir_Kind_Allocator_By_Subtype =>
+            Res := Create_Value_For_Type
+              (Block,
+               Get_Type_Of_Subtype_Indication (Get_Subtype_Indication (Expr)),
+               True);
+            Res := Unshare_Heap (Res);
+            return Create_Access_Value (Res);
+
+         when Iir_Kind_Left_Type_Attribute =>
+            Res := Execute_Bounds (Block, Get_Prefix (Expr));
+            return Execute_Left_Limit (Res);
+
+         when Iir_Kind_Right_Type_Attribute =>
+            Res := Execute_Bounds (Block, Get_Prefix (Expr));
+            return Execute_Right_Limit (Res);
+
+         when Iir_Kind_High_Type_Attribute =>
+            Res := Execute_Bounds (Block, Get_Prefix (Expr));
+            return Execute_High_Limit (Res);
+
+         when Iir_Kind_Low_Type_Attribute =>
+            Res := Execute_Bounds (Block, Get_Prefix (Expr));
+            return Execute_Low_Limit (Res);
+
+         when Iir_Kind_High_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Execute_High_Limit (Res);
+
+         when Iir_Kind_Low_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Execute_Low_Limit (Res);
+
+         when Iir_Kind_Left_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Execute_Left_Limit (Res);
+
+         when Iir_Kind_Right_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Execute_Right_Limit (Res);
+
+         when Iir_Kind_Length_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Execute_Length (Res);
+
+         when Iir_Kind_Ascending_Array_Attribute =>
+            Res := Execute_Indexes
+              (Block, Get_Prefix (Expr), Get_Value (Get_Parameter (Expr)));
+            return Boolean_To_Lit (Res.Dir = Iir_To);
+
+         when Iir_Kind_Event_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return Boolean_To_Lit (Execute_Event_Attribute (Res));
+
+         when Iir_Kind_Active_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return Boolean_To_Lit (Execute_Active_Attribute (Res));
+
+         when Iir_Kind_Driving_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return Boolean_To_Lit (Execute_Driving_Attribute (Res));
+
+         when Iir_Kind_Last_Value_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return Execute_Last_Value_Attribute (Res);
+
+         when Iir_Kind_Driving_Value_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return Execute_Driving_Value_Attribute (Res);
+
+         when Iir_Kind_Last_Event_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return To_Relative_Time (Execute_Last_Event_Attribute (Res));
+
+         when Iir_Kind_Last_Active_Attribute =>
+            Res := Execute_Name (Block, Get_Prefix (Expr), True);
+            return To_Relative_Time (Execute_Last_Active_Attribute (Res));
+
+         when Iir_Kind_Val_Attribute =>
+            declare
+               Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr));
+               Base_Type : constant Iir := Get_Base_Type (Prefix_Type);
+               Mode : constant Iir_Value_Kind :=
+                 Get_Info (Base_Type).Scalar_Mode;
+            begin
+               Res := Execute_Expression (Block, Get_Parameter (Expr));
+               case Mode is
+                  when Iir_Value_I64 =>
+                     null;
+                  when Iir_Value_E32 =>
+                     Res := Create_E32_Value (Ghdl_E32 (Res.I64));
+                  when Iir_Value_B1 =>
+                     Res := Create_B1_Value (Ghdl_B1'Val (Res.I64));
+                  when others =>
+                     Error_Kind ("execute_expression(val attribute)",
+                                 Prefix_Type);
+               end case;
+               Check_Constraints (Block, Res, Prefix_Type, Expr);
+               return Res;
+            end;
+
+         when Iir_Kind_Pos_Attribute =>
+            declare
+               N_Res: Iir_Value_Literal_Acc;
+               Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr));
+               Base_Type : constant Iir := Get_Base_Type (Prefix_Type);
+               Mode : constant Iir_Value_Kind :=
+                 Get_Info (Base_Type).Scalar_Mode;
+            begin
+               Res := Execute_Expression (Block, Get_Parameter (Expr));
+               case Mode is
+                  when Iir_Value_I64 =>
+                     null;
+                  when Iir_Value_B1 =>
+                     N_Res := Create_I64_Value (Ghdl_B1'Pos (Res.B1));
+                     Res := N_Res;
+                  when Iir_Value_E32 =>
+                     N_Res := Create_I64_Value (Ghdl_I64 (Res.E32));
+                     Res := N_Res;
+                  when others =>
+                     Error_Kind ("execute_expression(pos attribute)",
+                                 Base_Type);
+               end case;
+               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
+               return Res;
+            end;
+
+         when Iir_Kind_Succ_Attribute =>
+            Res := Execute_Expression (Block, Get_Parameter (Expr));
+            Res := Execute_Inc (Res, Expr);
+            Check_Constraints (Block, Res, Get_Type (Expr), Expr);
+            return Res;
+
+         when Iir_Kind_Pred_Attribute =>
+            Res := Execute_Expression (Block, Get_Parameter (Expr));
+            Res := Execute_Dec (Res, Expr);
+            Check_Constraints (Block, Res, Get_Type (Expr), Expr);
+            return Res;
+
+         when Iir_Kind_Leftof_Attribute =>
+            declare
+               Bound : Iir_Value_Literal_Acc;
+            begin
+               Res := Execute_Expression (Block, Get_Parameter (Expr));
+               Bound := Execute_Bounds
+                 (Block, Get_Type (Get_Prefix (Expr)));
+               case Bound.Dir is
+                  when Iir_To =>
+                     Res := Execute_Dec (Res, Expr);
+                  when Iir_Downto =>
+                     Res := Execute_Inc (Res, Expr);
+               end case;
+               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
+               return Res;
+            end;
+
+         when Iir_Kind_Rightof_Attribute =>
+            declare
+               Bound : Iir_Value_Literal_Acc;
+            begin
+               Res := Execute_Expression (Block, Get_Parameter (Expr));
+               Bound := Execute_Bounds
+                 (Block, Get_Type (Get_Prefix (Expr)));
+               case Bound.Dir is
+                  when Iir_Downto =>
+                     Res := Execute_Dec (Res, Expr);
+                  when Iir_To =>
+                     Res := Execute_Inc (Res, Expr);
+               end case;
+               Check_Constraints (Block, Res, Get_Type (Expr), Expr);
+               return Res;
+            end;
+
+         when Iir_Kind_Image_Attribute =>
+            return Execute_Image_Attribute (Block, Expr);
+
+         when Iir_Kind_Value_Attribute =>
+            Res := Execute_Expression (Block, Get_Parameter (Expr));
+            return Execute_Value_Attribute (Block, Res, Expr);
+
+         when Iir_Kind_Path_Name_Attribute
+           | Iir_Kind_Instance_Name_Attribute =>
+            return Execute_Path_Instance_Name_Attribute (Block, Expr);
+
+         when others =>
+            Error_Kind ("execute_expression", Expr);
+      end case;
+   end Execute_Expression;
+
+   procedure Execute_Dyadic_Association
+     (Out_Block: Block_Instance_Acc;
+      In_Block: Block_Instance_Acc;
+      Expr : Iir;
+      Inter_Chain: Iir)
+   is
+      Inter: Iir;
+      Val: Iir_Value_Literal_Acc;
+   begin
+      Inter := Inter_Chain;
+      for I in 0 .. 1 loop
+         if I = 0 then
+            Val := Execute_Expression (Out_Block, Get_Left (Expr));
+         else
+            Val := Execute_Expression (Out_Block, Get_Right (Expr));
+         end if;
+         Implicit_Array_Conversion (In_Block, Val, Get_Type (Inter), Expr);
+         Check_Constraints (In_Block, Val, Get_Type (Inter), Expr);
+
+         Elaboration.Create_Object (In_Block, Inter);
+         In_Block.Objects (Get_Info (Inter).Slot) :=
+           Unshare (Val, Instance_Pool);
+         Inter := Get_Chain (Inter);
+      end loop;
+   end Execute_Dyadic_Association;
+
+   procedure Execute_Monadic_Association
+     (Out_Block: Block_Instance_Acc;
+      In_Block: Block_Instance_Acc;
+      Expr : Iir;
+      Inter: Iir)
+   is
+      Val: Iir_Value_Literal_Acc;
+   begin
+      Val := Execute_Expression (Out_Block, Get_Operand (Expr));
+      Implicit_Array_Conversion (In_Block, Val, Get_Type (Inter), Expr);
+      Check_Constraints (In_Block, Val, Get_Type (Inter), Expr);
+
+      Elaboration.Create_Object (In_Block, Inter);
+      In_Block.Objects (Get_Info (Inter).Slot) :=
+        Unshare (Val, Instance_Pool);
+   end Execute_Monadic_Association;
+
+   --  Create a block instance for subprogram IMP.
+   function Create_Subprogram_Instance (Instance : Block_Instance_Acc;
+                                        Imp : Iir)
+                                       return Block_Instance_Acc
+   is
+      Func_Info : constant Sim_Info_Acc := Get_Info (Imp);
+
+      subtype Block_Type is Block_Instance_Type (Func_Info.Nbr_Objects);
+      function To_Block_Instance_Acc is new
+        Ada.Unchecked_Conversion (System.Address, Block_Instance_Acc);
+      function Alloc_Block_Instance is new
+        Alloc_On_Pool_Addr (Block_Type);
+
+      Up_Block: Block_Instance_Acc;
+      Res : Block_Instance_Acc;
+   begin
+      Up_Block := Get_Instance_By_Scope_Level
+        (Instance, Func_Info.Frame_Scope_Level - 1);
+
+      Res := To_Block_Instance_Acc
+        (Alloc_Block_Instance
+           (Instance_Pool,
+            Block_Instance_Type'(Max_Objs => Func_Info.Nbr_Objects,
+                                 Scope_Level => Func_Info.Frame_Scope_Level,
+                                 Up_Block => Up_Block,
+                                 Label => Imp,
+                                 Stmt => Null_Iir,
+                                 Parent => Instance,
+                                 Children => null,
+                                 Brother => null,
+                                 Marker => Empty_Marker,
+                                 Objects => (others => null),
+                                 Elab_Objects => 0,
+                                 In_Wait_Flag => False,
+                                 Actuals_Ref => null,
+                                 Result => null)));
+      return Res;
+   end Create_Subprogram_Instance;
+
+   -- Destroy a dynamic block_instance.
+   procedure Execute_Subprogram_Call_Final (Instance : Block_Instance_Acc)
+   is
+      Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label);
+   begin
+      Finalize_Declarative_Part
+        (Instance, Get_Declaration_Chain (Subprg_Body));
+   end Execute_Subprogram_Call_Final;
+
+   function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir)
+                                  return Iir_Value_Literal_Acc
+   is
+      Subprg_Body : constant Iir := Get_Subprogram_Body (Func);
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Current_Process.Instance := Instance;
+
+      Elaborate_Declarative_Part
+        (Instance, Get_Declaration_Chain (Subprg_Body));
+
+      -- execute statements
+      Instance.Stmt := Get_Sequential_Statement_Chain (Subprg_Body);
+      Execute_Sequential_Statements (Current_Process);
+      pragma Assert (Current_Process.Instance = Instance);
+
+      if Instance.Result = null then
+         Error_Msg_Exec
+           ("function scope exited without a return statement", Func);
+      end if;
+
+      -- Free variables, slots...
+      -- Need to copy the return value, because it can contains values from
+      -- arguments.
+      Res := Instance.Result;
+
+      Current_Process.Instance := Instance.Parent;
+      Execute_Subprogram_Call_Final (Instance);
+
+      return Res;
+   end Execute_Function_Body;
+
+   function Execute_Assoc_Function_Conversion
+     (Block : Block_Instance_Acc; Func : Iir; Val : Iir_Value_Literal_Acc)
+     return Iir_Value_Literal_Acc
+   is
+      Inter : Iir;
+      Instance : Block_Instance_Acc;
+      Res : Iir_Value_Literal_Acc;
+      Marker : Mark_Type;
+   begin
+      Mark (Marker, Instance_Pool.all);
+
+      -- Create an instance for this function.
+      Instance := Create_Subprogram_Instance (Block, Func);
+
+      Inter := Get_Interface_Declaration_Chain (Func);
+      Elaboration.Create_Object (Instance, Inter);
+      --  FIXME: implicit conversion
+      Instance.Objects (Get_Info (Inter).Slot) := Val;
+
+      Res := Execute_Function_Body (Instance, Func);
+      Res := Unshare (Res, Expr_Pool'Access);
+      Release (Marker, Instance_Pool.all);
+      return Res;
+   end Execute_Assoc_Function_Conversion;
+
+   function Execute_Assoc_Conversion
+     (Block : Block_Instance_Acc; Conv : Iir; Val : Iir_Value_Literal_Acc)
+     return Iir_Value_Literal_Acc
+   is
+      Ent : Iir;
+   begin
+      case Get_Kind (Conv) is
+         when Iir_Kind_Function_Call =>
+            --  FIXME: shouldn't CONV always be a denoting_name ?
+            return Execute_Assoc_Function_Conversion
+              (Block, Get_Named_Entity (Get_Implementation (Conv)), Val);
+         when Iir_Kind_Type_Conversion =>
+            --  FIXME: shouldn't CONV always be a denoting_name ?
+            return Execute_Type_Conversion (Block, Conv, Val);
+         when Iir_Kinds_Denoting_Name =>
+            Ent := Get_Named_Entity (Conv);
+            if Get_Kind (Ent) = Iir_Kind_Function_Declaration then
+               return Execute_Assoc_Function_Conversion (Block, Ent, Val);
+            elsif Get_Kind (Ent) in Iir_Kinds_Type_Declaration then
+               return Execute_Type_Conversion (Block, Ent, Val);
+            else
+               Error_Kind ("execute_assoc_conversion(1)", Ent);
+            end if;
+         when others =>
+            Error_Kind ("execute_assoc_conversion(2)", Conv);
+      end case;
+   end Execute_Assoc_Conversion;
+
+   --  Establish correspondance for association list ASSOC_LIST from block
+   --  instance OUT_BLOCK for subprogram of block SUBPRG_BLOCK.
+   procedure Execute_Association
+     (Out_Block: Block_Instance_Acc;
+      Subprg_Block: Block_Instance_Acc;
+      Assoc_Chain: Iir)
+   is
+      Nbr_Assoc : constant Natural := Get_Chain_Length (Assoc_Chain);
+      Assoc: Iir;
+      Actual : Iir;
+      Inter: Iir;
+      Formal : Iir;
+      Conv : Iir;
+      Val: Iir_Value_Literal_Acc;
+      Assoc_Idx : Iir_Index32;
+      Last_Individual : Iir_Value_Literal_Acc;
+      Mode : Iir_Mode;
+      Marker : Mark_Type;
+   begin
+      Subprg_Block.Actuals_Ref := null;
+      Mark (Marker, Expr_Pool);
+
+      Assoc := Assoc_Chain;
+      Assoc_Idx := 1;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         Inter := Get_Association_Interface (Assoc);
+
+         --  Extract the actual value.
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               --  Not allowed in individual association.
+               pragma Assert (Formal = Inter);
+               pragma Assert (Get_Whole_Association_Flag (Assoc));
+               Actual := Get_Default_Value (Inter);
+            when Iir_Kind_Association_Element_By_Expression =>
+               Actual := Get_Actual (Assoc);
+            when Iir_Kind_Association_Element_By_Individual =>
+               --  FIXME: signals ?
+               pragma Assert
+                 (Get_Kind (Inter) /= Iir_Kind_Signal_Interface_Declaration);
+               Last_Individual := Create_Value_For_Type
+                 (Out_Block, Get_Actual_Type (Assoc), False);
+               Last_Individual := Unshare (Last_Individual, Instance_Pool);
+
+               Elaboration.Create_Object (Subprg_Block, Inter);
+               Subprg_Block.Objects (Get_Info (Inter).Slot) := Last_Individual;
+               goto Continue;
+            when others =>
+               Error_Kind ("execute_association(1)", Assoc);
+         end case;
+
+         --  Compute actual value.
+         case Get_Kind (Inter) is
+            when Iir_Kind_Constant_Interface_Declaration
+              | Iir_Kind_File_Interface_Declaration =>
+               Val := Execute_Expression (Out_Block, Actual);
+               Implicit_Array_Conversion
+                 (Subprg_Block, Val, Get_Type (Formal), Assoc);
+               Check_Constraints (Subprg_Block, Val, Get_Type (Formal), Assoc);
+            when Iir_Kind_Signal_Interface_Declaration =>
+               Val := Execute_Name (Out_Block, Actual, True);
+               Implicit_Array_Conversion
+                 (Subprg_Block, Val, Get_Type (Formal), Assoc);
+            when Iir_Kind_Variable_Interface_Declaration =>
+               Mode := Get_Mode (Inter);
+               if Mode = Iir_In_Mode then
+                  --  FIXME: Ref ?
+                  Val := Execute_Expression (Out_Block, Actual);
+               else
+                  Val := Execute_Name (Out_Block, Actual, False);
+               end if;
+
+               --  FIXME: by value for scalars ?
+
+               --  Keep ref for back-copy
+               if Mode /= Iir_In_Mode then
+                  if Subprg_Block.Actuals_Ref = null then
+                     declare
+                        subtype Actuals_Ref_Type is
+                          Value_Array (Iir_Index32 (Nbr_Assoc));
+                        function To_Value_Array_Acc is new
+                          Ada.Unchecked_Conversion (System.Address,
+                                                    Value_Array_Acc);
+                        function Alloc_Actuals_Ref is new
+                          Alloc_On_Pool_Addr (Actuals_Ref_Type);
+
+                     begin
+                        Subprg_Block.Actuals_Ref := To_Value_Array_Acc
+                          (Alloc_Actuals_Ref
+                             (Instance_Pool,
+                              Actuals_Ref_Type'(Len => Iir_Index32 (Nbr_Assoc),
+                                                V => (others => null))));
+                     end;
+                  end if;
+                  Subprg_Block.Actuals_Ref.V (Assoc_Idx) :=
+                    Unshare_Bounds (Val, Instance_Pool);
+               end if;
+
+               if Mode = Iir_Out_Mode then
+                  if Get_Out_Conversion (Assoc) /= Null_Iir then
+                     --  For an OUT variable using an out conversion, don't
+                     --  associate with the actual, create a temporary value.
+                     Val := Create_Value_For_Type
+                       (Out_Block, Get_Type (Formal), True);
+                  elsif Get_Kind (Get_Type (Formal)) in
+                    Iir_Kinds_Scalar_Type_Definition
+                  then
+                     --  These are passed by value.  Must be reset.
+                     Val := Create_Value_For_Type
+                       (Out_Block, Get_Type (Formal), True);
+                  end if;
+               else
+                  if Get_Kind (Assoc) =
+                    Iir_Kind_Association_Element_By_Expression
+                  then
+                     Conv := Get_In_Conversion (Assoc);
+                     if Conv /= Null_Iir then
+                        Val := Execute_Assoc_Conversion
+                          (Subprg_Block, Conv, Val);
+                     end if;
+                  end if;
+
+                  --  FIXME: check constraints ?
+               end if;
+
+               Implicit_Array_Conversion
+                 (Subprg_Block, Val, Get_Type (Formal), Assoc);
+
+            when others =>
+               Error_Kind ("execute_association(2)", Inter);
+         end case;
+
+         if Get_Whole_Association_Flag (Assoc) then
+            case Get_Kind (Inter) is
+               when Iir_Kind_Constant_Interface_Declaration
+                 | Iir_Kind_Variable_Interface_Declaration
+                 | Iir_Kind_File_Interface_Declaration =>
+                  --  FIXME: Arguments are passed by copy.
+                  Elaboration.Create_Object (Subprg_Block, Inter);
+                  Subprg_Block.Objects (Get_Info (Inter).Slot) :=
+                    Unshare (Val, Instance_Pool);
+               when Iir_Kind_Signal_Interface_Declaration =>
+                  Elaboration.Create_Signal (Subprg_Block, Inter);
+                  Subprg_Block.Objects (Get_Info (Inter).Slot) :=
+                    Unshare_Bounds (Val, Instance_Pool);
+               when others =>
+                  Error_Kind ("execute_association", Inter);
+            end case;
+         else
+            declare
+               Targ : Iir_Value_Literal_Acc;
+               Is_Sig : Boolean;
+            begin
+               Execute_Name_With_Base
+                 (Subprg_Block, Formal, Last_Individual, Targ, Is_Sig);
+               Store (Targ, Val);
+            end;
+         end if;
+
+         << Continue >> null;
+         Assoc := Get_Chain (Assoc);
+         Assoc_Idx := Assoc_Idx + 1;
+      end loop;
+
+      Release (Marker, Expr_Pool);
+   end Execute_Association;
+
+   procedure Execute_Back_Association (Instance : Block_Instance_Acc)
+   is
+      Proc : Iir;
+      Assoc: Iir;
+      Inter: Iir;
+      Formal : Iir;
+      Assoc_Idx : Iir_Index32;
+   begin
+      Proc := Get_Procedure_Call (Instance.Parent.Stmt);
+      Assoc := Get_Parameter_Association_Chain (Proc);
+      Assoc_Idx := 1;
+      while Assoc /= Null_Iir loop
+         if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then
+            Formal := Get_Formal (Assoc);
+            Inter := Get_Association_Interface (Assoc);
+            case Get_Kind (Inter) is
+               when Iir_Kind_Variable_Interface_Declaration =>
+                  if Get_Mode (Inter) /= Iir_In_Mode
+                    and then Get_Kind (Get_Type (Inter)) /=
+                    Iir_Kind_File_Type_Definition
+                  then
+                     --  For out/inout variable interface, the value must
+                     --  be copied (FIXME: unless when passed by reference ?).
+                     declare
+                        Targ : constant Iir_Value_Literal_Acc :=
+                          Instance.Actuals_Ref.V (Assoc_Idx);
+                        Base : constant Iir_Value_Literal_Acc :=
+                          Instance.Objects (Get_Info (Inter).Slot);
+                        Val : Iir_Value_Literal_Acc;
+                        Conv : Iir;
+                        Is_Sig : Boolean;
+                        Expr_Mark : Mark_Type;
+                     begin
+                        Mark (Expr_Mark, Expr_Pool);
+
+                        --  Extract for individual association.
+                        Execute_Name_With_Base
+                          (Instance, Formal, Base, Val, Is_Sig);
+                        Conv := Get_Out_Conversion (Assoc);
+                        if Conv /= Null_Iir then
+                           Val := Execute_Assoc_Conversion
+                             (Instance, Conv, Val);
+                           --  FIXME: free val ?
+                        end if;
+                        Store (Targ, Val);
+
+                        Release (Expr_Mark, Expr_Pool);
+                     end;
+                  end if;
+               when Iir_Kind_File_Interface_Declaration =>
+                  null;
+               when Iir_Kind_Signal_Interface_Declaration
+                 | Iir_Kind_Constant_Interface_Declaration =>
+                  null;
+               when others =>
+                  Error_Kind ("execute_back_association", Inter);
+            end case;
+         end if;
+         Assoc := Get_Chain (Assoc);
+         Assoc_Idx := Assoc_Idx + 1;
+      end loop;
+   end Execute_Back_Association;
+
+   --  When a subprogram of a protected type is called, a link to the object
+   --  must be passed. This procedure modifies the up_link of SUBPRG_BLOCK to
+   --  point to the block of the object (extracted from CALL and BLOCK).
+   --  This change doesn't modify the parent (so that the activation chain is
+   --  not changed).
+   procedure Adjust_Up_Link_For_Protected_Object
+     (Block: Block_Instance_Acc; Call: Iir; Subprg_Block : Block_Instance_Acc)
+   is
+      Meth_Obj : constant Iir := Get_Method_Object (Call);
+      Obj : Iir_Value_Literal_Acc;
+      Obj_Block : Block_Instance_Acc;
+   begin
+      if Meth_Obj /= Null_Iir then
+         Obj := Execute_Name (Block, Meth_Obj, True);
+         Obj_Block := Protected_Table.Table (Obj.Prot);
+         Subprg_Block.Up_Block := Obj_Block;
+      end if;
+   end Adjust_Up_Link_For_Protected_Object;
+
+   function Execute_Foreign_Function_Call
+     (Block: Block_Instance_Acc; Expr : Iir; Imp : Iir)
+      return Iir_Value_Literal_Acc
+   is
+      pragma Unreferenced (Block);
+   begin
+      case Get_Identifier (Imp) is
+         when Std_Names.Name_Get_Resolution_Limit =>
+            return Create_I64_Value
+              (Ghdl_I64
+                 (Evaluation.Get_Physical_Value (Std_Package.Time_Base)));
+         when others =>
+            Error_Msg_Exec ("unsupported foreign function call", Expr);
+      end case;
+      return null;
+   end Execute_Foreign_Function_Call;
+
+   -- BLOCK is the block instance in which the function call appears.
+   function Execute_Function_Call
+     (Block: Block_Instance_Acc; Expr: Iir; Imp : Iir)
+      return Iir_Value_Literal_Acc
+   is
+      Inter_Chain : constant Iir := Get_Interface_Declaration_Chain (Imp);
+      Subprg_Block: Block_Instance_Acc;
+      Assoc_Chain: Iir;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Mark (Block.Marker, Instance_Pool.all);
+
+      Subprg_Block := Create_Subprogram_Instance (Block, Imp);
+
+      case Get_Kind (Expr) is
+         when Iir_Kind_Function_Call =>
+            Adjust_Up_Link_For_Protected_Object (Block, Expr, Subprg_Block);
+            Assoc_Chain := Get_Parameter_Association_Chain (Expr);
+            Execute_Association (Block, Subprg_Block, Assoc_Chain);
+            --  No out/inout interface for functions.
+            pragma Assert (Subprg_Block.Actuals_Ref = null);
+         when Iir_Kinds_Dyadic_Operator =>
+            Execute_Dyadic_Association
+              (Block, Subprg_Block, Expr, Inter_Chain);
+         when Iir_Kinds_Monadic_Operator =>
+            Execute_Monadic_Association
+              (Block, Subprg_Block, Expr, Inter_Chain);
+         when others =>
+            Error_Kind ("execute_subprogram_call_init", Expr);
+      end case;
+
+      if Get_Foreign_Flag (Imp) then
+         Res := Execute_Foreign_Function_Call (Subprg_Block, Expr, Imp);
+      else
+         Res := Execute_Function_Body (Subprg_Block, Imp);
+      end if;
+
+      --  Unfortunately, we don't know where the result has been allocated,
+      --  so copy it before releasing the instance pool.
+      Res := Unshare (Res, Expr_Pool'Access);
+
+      Release (Block.Marker, Instance_Pool.all);
+
+      return Res;
+   end Execute_Function_Call;
+
+   --  Slide an array VALUE using bounds from REF_VALUE.  Do not modify
+   --  VALUE if not an array.
+   procedure Implicit_Array_Conversion (Value : in out Iir_Value_Literal_Acc;
+                                        Ref_Value : Iir_Value_Literal_Acc;
+                                        Expr : Iir)
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      if Value.Kind /= Iir_Value_Array then
+         return;
+      end if;
+      Res := Create_Array_Value (Value.Bounds.Nbr_Dims);
+      Res.Val_Array := Value.Val_Array;
+      for I in Value.Bounds.D'Range loop
+         if Value.Bounds.D (I).Length /= Ref_Value.Bounds.D (I).Length then
+            Error_Msg_Constraint (Expr);
+            return;
+         end if;
+         Res.Bounds.D (I) := Ref_Value.Bounds.D (I);
+      end loop;
+      Value := Res;
+   end Implicit_Array_Conversion;
+
+   procedure Implicit_Array_Conversion (Instance : Block_Instance_Acc;
+                                        Value : in out Iir_Value_Literal_Acc;
+                                        Ref_Type : Iir;
+                                        Expr : Iir)
+   is
+      Ref_Value : Iir_Value_Literal_Acc;
+   begin
+      --  Do array conversion only if REF_TYPE is a constrained array type
+      --  definition.
+      if Value.Kind /= Iir_Value_Array then
+         return;
+      end if;
+      if Get_Constraint_State (Ref_Type) /= Fully_Constrained then
+         return;
+      end if;
+      Ref_Value := Create_Array_Bounds_From_Type (Instance, Ref_Type, True);
+      for I in Value.Bounds.D'Range loop
+         if Value.Bounds.D (I).Length /= Ref_Value.Bounds.D (I).Length then
+            Error_Msg_Constraint (Expr);
+            return;
+         end if;
+      end loop;
+      Ref_Value.Val_Array.V := Value.Val_Array.V;
+      Value := Ref_Value;
+   end Implicit_Array_Conversion;
+
+   procedure Check_Array_Constraints
+     (Instance: Block_Instance_Acc;
+      Value: Iir_Value_Literal_Acc;
+      Def: Iir;
+      Expr: Iir)
+   is
+      Index_List: Iir_List;
+      Element_Subtype: Iir;
+      New_Bounds : Iir_Value_Literal_Acc;
+   begin
+      --  Nothing to check for unconstrained arrays.
+      if not Get_Index_Constraint_Flag (Def) then
+         return;
+      end if;
+
+      Index_List := Get_Index_Subtype_List (Def);
+      for I in Value.Bounds.D'Range loop
+         New_Bounds := Execute_Bounds
+           (Instance, Get_Nth_Element (Index_List, Natural (I - 1)));
+         if not Is_Equal (Value.Bounds.D (I), New_Bounds) then
+            Error_Msg_Constraint (Expr);
+            return;
+         end if;
+      end loop;
+
+      if Boolean'(False) then
+         Index_List := Get_Index_List (Def);
+         Element_Subtype := Get_Element_Subtype (Def);
+         for I in Value.Val_Array.V'Range loop
+            Check_Constraints
+              (Instance, Value.Val_Array.V (I), Element_Subtype, Expr);
+         end loop;
+      end if;
+   end Check_Array_Constraints;
+
+   --  Check DEST and SRC are array compatible.
+   procedure Check_Array_Match
+     (Instance: Block_Instance_Acc;
+      Dest: Iir_Value_Literal_Acc;
+      Src : Iir_Value_Literal_Acc;
+      Expr: Iir)
+   is
+      pragma Unreferenced (Instance);
+   begin
+      for I in Dest.Bounds.D'Range loop
+         if Dest.Bounds.D (I).Length /= Src.Bounds.D (I).Length then
+            Error_Msg_Constraint (Expr);
+            exit;
+         end if;
+      end loop;
+   end Check_Array_Match;
+   pragma Unreferenced (Check_Array_Match);
+
+   procedure Check_Constraints
+     (Instance: Block_Instance_Acc;
+      Value: Iir_Value_Literal_Acc;
+      Def: Iir;
+      Expr: Iir)
+   is
+      Base_Type : constant Iir := Get_Base_Type (Def);
+      High, Low: Iir_Value_Literal_Acc;
+      Bound : Iir_Value_Literal_Acc;
+   begin
+      case Get_Kind (Def) is
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            Bound := Execute_Bounds (Instance, Def);
+            if Bound.Dir = Iir_To then
+               High := Bound.Right;
+               Low := Bound.Left;
+            else
+               High := Bound.Left;
+               Low := Bound.Right;
+            end if;
+            case Get_Info (Base_Type).Scalar_Mode is
+               when Iir_Value_I64 =>
+                  if Value.I64 in Low.I64 .. High.I64 then
+                     return;
+                  end if;
+               when Iir_Value_E32 =>
+                  if Value.E32 in Low.E32 .. High.E32 then
+                     return;
+                  end if;
+               when Iir_Value_F64 =>
+                  if Value.F64 in Low.F64 .. High.F64 then
+                     return;
+                  end if;
+               when Iir_Value_B1 =>
+                  if Value.B1 in Low.B1 .. High.B1 then
+                     return;
+                  end if;
+               when others =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Kind_Array_Subtype_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            Check_Array_Constraints (Instance, Value, Def, Expr);
+            return;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            declare
+               El: Iir_Element_Declaration;
+               List : Iir_List;
+            begin
+               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;
+                  Check_Constraints
+                    (Instance,
+                     Value.Val_Record.V (Get_Element_Position (El) + 1),
+                     Get_Type (El),
+                     Expr);
+               end loop;
+            end;
+            return;
+         when Iir_Kind_Integer_Type_Definition =>
+            return;
+         when Iir_Kind_Floating_Type_Definition =>
+            return;
+         when Iir_Kind_Physical_Type_Definition =>
+            return;
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            return;
+         when Iir_Kind_File_Type_Definition =>
+            return;
+         when others =>
+            Error_Kind ("check_constraints", Def);
+      end case;
+      Error_Msg_Constraint (Expr);
+   end Check_Constraints;
+
+   function Execute_Resolution_Function
+     (Block: Block_Instance_Acc; Imp : Iir; Arr : Iir_Value_Literal_Acc)
+      return Iir_Value_Literal_Acc
+   is
+      Inter : Iir;
+      Instance : Block_Instance_Acc;
+   begin
+      -- Create a frame for this function.
+      Instance := Create_Subprogram_Instance (Block, Imp);
+
+      Inter := Get_Interface_Declaration_Chain (Imp);
+      Elaboration.Create_Object (Instance, Inter);
+      Instance.Objects (Get_Info (Inter).Slot) := Arr;
+
+      return Execute_Function_Body (Instance, Imp);
+   end Execute_Resolution_Function;
+
+   procedure Execute_Signal_Assignment
+     (Instance: Block_Instance_Acc;
+      Stmt: Iir_Signal_Assignment_Statement)
+   is
+      Wf : constant Iir_Waveform_Element := Get_Waveform_Chain (Stmt);
+      Nbr_We : constant Natural := Get_Chain_Length (Wf);
+
+      Transactions : Transaction_Type (Nbr_We);
+
+      We: Iir_Waveform_Element;
+      Res: Iir_Value_Literal_Acc;
+      Rdest: Iir_Value_Literal_Acc;
+      Targ_Type : Iir;
+      Marker : Mark_Type;
+   begin
+      Mark (Marker, Expr_Pool);
+
+      Rdest := Execute_Name (Instance, Get_Target (Stmt), True);
+      Targ_Type := Get_Type (Get_Target (Stmt));
+
+      --  Disconnection statement.
+      if Wf = Null_Iir then
+         Disconnect_Signal (Rdest);
+         Release (Marker, Expr_Pool);
+         return;
+      end if;
+
+      Transactions.Stmt := Stmt;
+
+      -- LRM93 8.4.1
+      -- Evaluation of a waveform consists of the evaluation of each waveform
+      -- elements in the waveform.
+      We := Wf;
+      for I in Transactions.Els'Range loop
+         declare
+            Trans : Transaction_El_Type renames Transactions.Els (I);
+         begin
+            if Get_Time (We) /= Null_Iir then
+               Res := Execute_Expression (Instance, Get_Time (We));
+               -- LRM93 8.4.1
+               -- It is an error if the time expression in a waveform element
+               -- evaluates to a negative value.
+               if Res.I64 < 0 then
+                  Error_Msg_Exec ("time value is negative", Get_Time (We));
+               end if;
+               Trans.After := Std_Time (Res.I64);
+            else
+               -- LRM93 8.4.1
+               -- If the after clause of a waveform element is not present,
+               -- then an implicit "after 0 ns" is assumed.
+               Trans.After := 0;
+            end if;
+
+            -- LRM93 8.4.1
+            -- It is an error if the sequence of new transactions is not in
+            -- ascending order with respect to time.
+            if I > 1
+              and then Trans.After <= Transactions.Els (I - 1).After
+            then
+               Error_Msg_Exec
+                 ("sequence not in ascending order with respect to time", We);
+            end if;
+
+            if Get_Kind (Get_We_Value (We)) = Iir_Kind_Null_Literal then
+               -- null transaction.
+               Trans.Value := null;
+            else
+               -- LRM93 8.4.1
+               -- For the first form of waveform element, the value component
+               -- of the transaction is determined by the value expression in
+               -- the waveform element.
+               Trans.Value := Execute_Expression_With_Type
+                 (Instance, Get_We_Value (We), Targ_Type);
+            end if;
+         end;
+         We := Get_Chain (We);
+      end loop;
+      pragma Assert (We = Null_Iir);
+
+      case Get_Delay_Mechanism (Stmt) is
+         when Iir_Transport_Delay =>
+            Transactions.Reject := 0;
+         when Iir_Inertial_Delay =>
+            -- LRM93 8.4
+            -- or, in the case that a pulse rejection limit is specified,
+            -- a pulse whose duration is shorter than that limit will not
+            -- be transmitted.
+            -- Every inertially delayed signal assignment has a pulse
+            -- rejection limit.
+            if Get_Reject_Time_Expression (Stmt) /= Null_Iir then
+               -- LRM93 8.4
+               -- If the delay mechanism specifies inertial delay, and if the
+               -- reserved word reject followed by a time expression is
+               -- present, then the time expression specifies the pulse
+               -- rejection limit.
+               Res := Execute_Expression
+                 (Instance, Get_Reject_Time_Expression (Stmt));
+               -- LRM93 8.4
+               -- It is an error if the pulse rejection limit for any
+               -- inertially delayed signal assignement statement is either
+               -- negative ...
+               if Res.I64 < 0 then
+                  Error_Msg_Exec ("reject time negative", Stmt);
+               end if;
+               -- LRM93 8.4
+               -- ... or greather than the time expression associated with
+               -- the first waveform element.
+               Transactions.Reject := Std_Time (Res.I64);
+               if Transactions.Reject > Transactions.Els (1).After then
+                  Error_Msg_Exec
+                    ("reject time greather than time expression", Stmt);
+               end if;
+            else
+               -- LRM93 8.4
+               -- In all other cases, the pulse rejection limit is the time
+               -- expression associated ith the first waveform element.
+               Transactions.Reject := Transactions.Els (1).After;
+            end if;
+      end case;
+
+      --  FIXME: slice Transactions to remove transactions after end of time.
+      Assign_Value_To_Signal (Instance, Rdest, Transactions);
+
+      Release (Marker, Expr_Pool);
+   end Execute_Signal_Assignment;
+
+   procedure Assign_Simple_Value_To_Object
+     (Instance: Block_Instance_Acc;
+      Dest: Iir_Value_Literal_Acc;
+      Dest_Type: Iir;
+      Value: Iir_Value_Literal_Acc;
+      Stmt: Iir)
+   is
+   begin
+      if Dest.Kind /= Value.Kind then
+         raise Internal_Error; -- literal kind mismatch.
+      end if;
+
+      Check_Constraints (Instance, Value, Dest_Type, Stmt);
+
+      Store (Dest, Value);
+   end Assign_Simple_Value_To_Object;
+
+   procedure Assign_Array_Value_To_Object
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Target_Type: Iir;
+      Depth: Natural;
+      Value: Iir_Value_Literal_Acc;
+      Stmt: Iir)
+   is
+      Element_Type: Iir;
+   begin
+      if Target.Val_Array.Len /= Value.Val_Array.Len then
+         -- Dimension mismatch.
+         raise Program_Error;
+      end if;
+      if Depth = Get_Nbr_Elements (Get_Index_List (Target_Type)) then
+         Element_Type := Get_Element_Subtype (Target_Type);
+         for I in Target.Val_Array.V'Range loop
+            Assign_Value_To_Object (Instance,
+                                    Target.Val_Array.V (I),
+                                    Element_Type,
+                                    Value.Val_Array.V (I),
+                                    Stmt);
+         end loop;
+      else
+         for I in Target.Val_Array.V'Range loop
+            Assign_Array_Value_To_Object (Instance,
+                                          Target.Val_Array.V (I),
+                                          Target_Type,
+                                          Depth + 1,
+                                          Value.Val_Array.V (I),
+                                          Stmt);
+         end loop;
+      end if;
+   end Assign_Array_Value_To_Object;
+
+   procedure Assign_Record_Value_To_Object
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Target_Type: Iir;
+      Value: Iir_Value_Literal_Acc;
+      Stmt: Iir)
+   is
+      Element_Type: Iir;
+      List : Iir_List;
+      Element: Iir_Element_Declaration;
+      Pos : Iir_Index32;
+   begin
+      if Target.Val_Record.Len /= Value.Val_Record.Len then
+         -- Dimension mismatch.
+         raise Program_Error;
+      end if;
+      List := Get_Elements_Declaration_List (Target_Type);
+      for I in Natural loop
+         Element := Get_Nth_Element (List, I);
+         exit when Element = Null_Iir;
+         Element_Type := Get_Type (Element);
+         Pos := Get_Element_Position (Element);
+         Assign_Value_To_Object (Instance,
+                                 Target.Val_Record.V (1 + Pos),
+                                 Element_Type,
+                                 Value.Val_Record.V (1 + Pos),
+                                 Stmt);
+      end loop;
+   end Assign_Record_Value_To_Object;
+
+   procedure Assign_Value_To_Object
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Target_Type: Iir;
+      Value: Iir_Value_Literal_Acc;
+      Stmt: Iir)
+   is
+   begin
+      case Target.Kind is
+         when Iir_Value_Array =>
+            Assign_Array_Value_To_Object
+              (Instance, Target, Target_Type, 1, Value, Stmt);
+         when Iir_Value_Record =>
+            Assign_Record_Value_To_Object
+              (Instance, Target, Target_Type, Value, Stmt);
+         when Iir_Value_Scalars
+           | Iir_Value_Access =>
+            Assign_Simple_Value_To_Object
+              (Instance, Target, Target_Type, Value, Stmt);
+         when Iir_Value_File
+           | Iir_Value_Signal
+           | Iir_Value_Protected
+           | Iir_Value_Range
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Assign_Value_To_Object;
+
+   -- Display a message when an assertion has failed.
+   -- REPORT is the value (string) to display, or null to use default message.
+   -- SEVERITY is the severity or null to use default (error).
+   -- STMT is used to display location.
+   procedure Execute_Failed_Assertion (Report : String;
+                                       Severity : Natural;
+                                       Stmt: Iir) is
+   begin
+      -- LRM93 8.2
+      -- The error message consists of at least:
+
+      -- 4: name of the design unit containing the assertion.
+      Disp_Iir_Location (Stmt);
+
+      -- 1: an indication that this message is from an assertion.
+      Put (Standard_Error, "(assertion ");
+
+      -- 2: the value of the severity level.
+      case Severity is
+         when 0 =>
+            Put (Standard_Error, "note");
+         when 1 =>
+            Put (Standard_Error, "warning");
+         when 2 =>
+            Put (Standard_Error, "error");
+         when 3 =>
+            Put (Standard_Error, "failure");
+         when others =>
+            Error_Internal (Null_Iir, "execute_failed_assertion");
+      end case;
+      if Disp_Time_Before_Values then
+         Put (Standard_Error, " at ");
+         Grt.Astdio.Put_Time (Grt.Stdio.stderr, Current_Time);
+      end if;
+      Put (Standard_Error, "): ");
+
+      -- 3: the value of the message string.
+      Put_Line (Standard_Error, Report);
+
+      -- Stop execution if the severity is too high.
+      if Severity >= Grt.Options.Severity_Level then
+         Debug (Reason_Assert);
+         Grt.Errors.Fatal_Error;
+      end if;
+   end Execute_Failed_Assertion;
+
+   procedure Execute_Failed_Assertion (Report : Iir_Value_Literal_Acc;
+                                       Severity : Natural;
+                                       Stmt: Iir) is
+   begin
+      if Report /= null then
+         declare
+            Msg : String (1 .. Natural (Report.Val_Array.Len));
+         begin
+            for I in Report.Val_Array.V'Range loop
+               Msg (Positive (I)) :=
+                 Character'Val (Report.Val_Array.V (I).E32);
+            end loop;
+            Execute_Failed_Assertion (Msg, Severity, Stmt);
+         end;
+      else
+         -- The default value for the message string is:
+         -- "Assertion violation.".
+         -- Does the message string include quotes ?
+         Execute_Failed_Assertion ("Assertion violation.", Severity, Stmt);
+      end if;
+   end Execute_Failed_Assertion;
+
+   procedure Execute_Report_Statement
+     (Instance: Block_Instance_Acc; Stmt: Iir; Default_Severity : Natural)
+   is
+      Expr: Iir;
+      Report, Severity_Lit: Iir_Value_Literal_Acc;
+      Severity : Natural;
+      Marker : Mark_Type;
+   begin
+      Mark (Marker, Expr_Pool);
+      Expr := Get_Report_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Report := Execute_Expression (Instance, Expr);
+      else
+         Report := null;
+      end if;
+      Expr := Get_Severity_Expression (Stmt);
+      if Expr /= Null_Iir then
+         Severity_Lit := Execute_Expression (Instance, Expr);
+         Severity := Natural'Val (Severity_Lit.E32);
+      else
+         Severity := Default_Severity;
+      end if;
+      Execute_Failed_Assertion (Report, Severity, Stmt);
+      Release (Marker, Expr_Pool);
+   end Execute_Report_Statement;
+
+   function Is_In_Choice
+     (Instance: Block_Instance_Acc;
+      Choice: Iir;
+      Expr: Iir_Value_Literal_Acc)
+      return Boolean
+   is
+      Res : Boolean;
+   begin
+      case Get_Kind (Choice) is
+         when Iir_Kind_Choice_By_Others =>
+            return True;
+         when Iir_Kind_Choice_By_Expression =>
+            declare
+               Expr1: Iir_Value_Literal_Acc;
+            begin
+               Expr1 := Execute_Expression
+                 (Instance, Get_Choice_Expression (Choice));
+               Res := Is_Equal (Expr, Expr1);
+               return Res;
+            end;
+         when Iir_Kind_Choice_By_Range =>
+            declare
+               A_Range : Iir_Value_Literal_Acc;
+            begin
+               A_Range := Execute_Bounds
+                 (Instance, Get_Choice_Range (Choice));
+               Res := Is_In_Range (Expr, A_Range);
+            end;
+            return Res;
+         when others =>
+            Error_Kind ("is_in_choice", Choice);
+      end case;
+   end Is_In_Choice;
+
+   --  Return TRUE iff VAL is in the range defined by BOUNDS.
+   function Is_In_Range (Val : Iir_Value_Literal_Acc;
+                         Bounds : Iir_Value_Literal_Acc)
+     return Boolean
+   is
+      Max, Min : Iir_Value_Literal_Acc;
+   begin
+      case Bounds.Dir is
+         when Iir_To =>
+            Min := Bounds.Left;
+            Max := Bounds.Right;
+         when Iir_Downto =>
+            Min := Bounds.Right;
+            Max := Bounds.Left;
+      end case;
+
+      case Val.Kind is
+         when Iir_Value_E32 =>
+            return Val.E32 >= Min.E32 and Val.E32 <= Max.E32;
+         when Iir_Value_B1 =>
+            return Val.B1 >= Min.B1 and Val.B1 <= Max.B1;
+         when Iir_Value_I64 =>
+            return Val.I64 >= Min.I64 and Val.I64 <= Max.I64;
+         when others =>
+            raise Internal_Error;
+            return False;
+      end case;
+   end Is_In_Range;
+
+   --  Increment or decrement VAL according to BOUNDS.DIR.
+   --  FIXME: use increment ?
+   procedure Update_Loop_Index (Val : Iir_Value_Literal_Acc;
+                                Bounds : Iir_Value_Literal_Acc)
+   is
+   begin
+      case Val.Kind is
+         when Iir_Value_E32 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  Val.E32 := Val.E32 + 1;
+               when Iir_Downto =>
+                  Val.E32 := Val.E32 - 1;
+            end case;
+         when Iir_Value_B1 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  Val.B1 := True;
+               when Iir_Downto =>
+                  Val.B1 := False;
+            end case;
+         when Iir_Value_I64 =>
+            case Bounds.Dir is
+               when Iir_To =>
+                  Val.I64 := Val.I64 + 1;
+               when Iir_Downto =>
+                  Val.I64 := Val.I64 - 1;
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Update_Loop_Index;
+
+   procedure Finalize_For_Loop_Statement (Instance : Block_Instance_Acc;
+                                          Stmt : Iir)
+   is
+   begin
+      Destroy_Iterator_Declaration
+        (Instance, Get_Parameter_Specification (Stmt));
+   end Finalize_For_Loop_Statement;
+
+   procedure Finalize_Loop_Statement (Instance : Block_Instance_Acc;
+                                      Stmt : Iir)
+   is
+   begin
+      if Get_Kind (Stmt) = Iir_Kind_For_Loop_Statement then
+         Finalize_For_Loop_Statement (Instance, Stmt);
+      end if;
+   end Finalize_Loop_Statement;
+
+   procedure Execute_For_Loop_Statement (Proc : Process_State_Acc)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir_For_Loop_Statement := Instance.Stmt;
+      Iterator : constant Iir := Get_Parameter_Specification (Stmt);
+      Bounds : Iir_Value_Literal_Acc;
+      Index : Iir_Value_Literal_Acc;
+      Stmt_Chain : Iir;
+      Is_Nul : Boolean;
+      Marker : Mark_Type;
+   begin
+      --  Elaborate the iterator (and its type).
+      Elaborate_Declaration (Instance, Iterator);
+
+      -- Extract bounds.
+      Mark (Marker, Expr_Pool);
+      Bounds := Execute_Bounds (Instance, Get_Type (Iterator));
+      Index := Instance.Objects (Get_Info (Iterator).Slot);
+      Store (Index, Bounds.Left);
+      Is_Nul := Is_Nul_Range (Bounds);
+      Release (Marker, Expr_Pool);
+
+      if Is_Nul then
+         -- Loop is complete.
+         Finalize_For_Loop_Statement (Instance, Stmt);
+         Update_Next_Statement (Proc);
+      else
+         Stmt_Chain := Get_Sequential_Statement_Chain (Stmt);
+         if Stmt_Chain = Null_Iir then
+            --  Nothing to do for an empty loop.
+            Finalize_For_Loop_Statement (Instance, Stmt);
+            Update_Next_Statement (Proc);
+         else
+            Instance.Stmt := Stmt_Chain;
+         end if;
+      end if;
+   end Execute_For_Loop_Statement;
+
+   --  This function is called when there is no more statements to execute
+   --  in the statement list of a for_loop.  Returns FALSE in case of end of
+   --  loop.
+   function Finish_For_Loop_Statement (Instance : Block_Instance_Acc)
+                                      return Boolean
+   is
+      Iterator : constant Iir := Get_Parameter_Specification (Instance.Stmt);
+      Bounds : Iir_Value_Literal_Acc;
+      Index : Iir_Value_Literal_Acc;
+      Marker : Mark_Type;
+   begin
+      --  FIXME: avoid allocation.
+      Mark (Marker, Expr_Pool);
+      Bounds := Execute_Bounds (Instance, Get_Type (Iterator));
+      Index := Instance.Objects (Get_Info (Iterator).Slot);
+
+      if Is_Equal (Index, Bounds.Right) then
+         -- Loop is complete.
+         Release (Marker, Expr_Pool);
+         Finalize_For_Loop_Statement (Instance, Instance.Stmt);
+         return False;
+      else
+         -- Update the loop index.
+         Update_Loop_Index (Index, Bounds);
+
+         Release (Marker, Expr_Pool);
+
+         -- start the loop again.
+         Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt);
+         return True;
+      end if;
+   end Finish_For_Loop_Statement;
+
+   --  Evaluate boolean condition COND.  If COND is Null_Iir, returns true.
+   function Execute_Condition (Instance : Block_Instance_Acc;
+                               Cond : Iir) return Boolean
+   is
+      V : Iir_Value_Literal_Acc;
+      Res : Boolean;
+      Marker : Mark_Type;
+   begin
+      if Cond = Null_Iir then
+         return True;
+      end if;
+
+      Mark (Marker, Expr_Pool);
+      V := Execute_Expression (Instance, Cond);
+      Res := V.B1 = True;
+      Release (Marker, Expr_Pool);
+      return Res;
+   end Execute_Condition;
+
+   --  Start a while loop statement, or return FALSE if the loop is not
+   --  executed.
+   procedure Execute_While_Loop_Statement (Proc : Process_State_Acc)
+   is
+      Instance: constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir := Instance.Stmt;
+      Cond : Boolean;
+   begin
+      Cond := Execute_Condition (Instance, Get_Condition (Stmt));
+      if Cond then
+         Init_Sequential_Statements (Proc, Stmt);
+      else
+         Update_Next_Statement (Proc);
+      end if;
+   end Execute_While_Loop_Statement;
+
+   --  This function is called when there is no more statements to execute
+   --  in the statement list of a while loop.  Returns FALSE iff loop is
+   --  completed.
+   function Finish_While_Loop_Statement (Instance : Block_Instance_Acc)
+                                        return Boolean
+   is
+      Cond : Boolean;
+   begin
+      Cond := Execute_Condition (Instance, Get_Condition (Instance.Stmt));
+
+      if Cond then
+         -- start the loop again.
+         Instance.Stmt := Get_Sequential_Statement_Chain (Instance.Stmt);
+         return True;
+      else
+         -- Loop is complete.
+         return False;
+      end if;
+   end Finish_While_Loop_Statement;
+
+   --  Return TRUE if the loop must be executed again
+   function Finish_Loop_Statement (Instance : Block_Instance_Acc;
+                                   Stmt : Iir) return Boolean is
+   begin
+      Instance.Stmt := Stmt;
+      case Get_Kind (Stmt) is
+         when Iir_Kind_While_Loop_Statement =>
+            return Finish_While_Loop_Statement (Instance);
+         when Iir_Kind_For_Loop_Statement =>
+            return Finish_For_Loop_Statement (Instance);
+         when others =>
+            Error_Kind ("finish_loop_statement", Stmt);
+      end case;
+   end Finish_Loop_Statement;
+
+   --  Return FALSE if the next statement should be executed (possibly
+   --  updated).
+   procedure Execute_Exit_Next_Statement (Proc : Process_State_Acc;
+                                          Is_Exit : Boolean)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir := Instance.Stmt;
+      Label : constant Iir := Get_Named_Entity (Get_Loop_Label (Stmt));
+      Cond : Boolean;
+      Parent : Iir;
+   begin
+      Cond := Execute_Condition (Instance, Get_Condition (Stmt));
+      if not Cond then
+         Update_Next_Statement (Proc);
+         return;
+      end if;
+
+      Parent := Stmt;
+      loop
+         Parent := Get_Parent (Parent);
+         case Get_Kind (Parent) is
+            when Iir_Kind_For_Loop_Statement
+              | Iir_Kind_While_Loop_Statement =>
+               if Label = Null_Iir or else Label = Parent then
+                  --  Target is this statement.
+                  if Is_Exit then
+                     Finalize_Loop_Statement (Instance, Parent);
+                     Instance.Stmt := Parent;
+                     Update_Next_Statement (Proc);
+                  elsif not Finish_Loop_Statement (Instance, Parent) then
+                     Update_Next_Statement (Proc);
+                  else
+                     Init_Sequential_Statements (Proc, Parent);
+                  end if;
+                  return;
+               else
+                  Finalize_Loop_Statement (Instance, Parent);
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+   end Execute_Exit_Next_Statement;
+
+   procedure Execute_Case_Statement (Proc : Process_State_Acc)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir := Instance.Stmt;
+      Value: Iir_Value_Literal_Acc;
+      Assoc: Iir;
+      Stmt_Chain : Iir;
+      Marker : Mark_Type;
+   begin
+      Mark (Marker, Expr_Pool);
+
+      Value := Execute_Expression (Instance, Get_Expression (Stmt));
+      Assoc := Get_Case_Statement_Alternative_Chain (Stmt);
+
+      while Assoc /= Null_Iir loop
+         if not Get_Same_Alternative_Flag (Assoc) then
+            Stmt_Chain := Get_Associated_Chain (Assoc);
+         end if;
+
+         if Is_In_Choice (Instance, Assoc, Value) then
+            if Stmt_Chain = Null_Iir then
+               Update_Next_Statement (Proc);
+            else
+               Instance.Stmt := Stmt_Chain;
+            end if;
+            Release (Marker, Expr_Pool);
+            return;
+         end if;
+
+         Assoc := Get_Chain (Assoc);
+      end loop;
+      --  FIXME: infinite loop???
+      Error_Msg_Exec ("no choice for expression", Stmt);
+      raise Internal_Error;
+   end Execute_Case_Statement;
+
+   procedure Execute_Call_Statement (Proc : Process_State_Acc)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir := Instance.Stmt;
+      Call : constant Iir := Get_Procedure_Call (Stmt);
+      Imp  : constant Iir := Get_Named_Entity (Get_Implementation (Call));
+      Subprg_Instance : Block_Instance_Acc;
+      Assoc_Chain: Iir;
+      Subprg_Body : Iir;
+   begin
+      if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration then
+         Execute_Implicit_Procedure (Instance, Call);
+         Update_Next_Statement (Proc);
+      elsif Get_Foreign_Flag (Imp) then
+         Execute_Foreign_Procedure (Instance, Call);
+         Update_Next_Statement (Proc);
+      else
+         Mark (Instance.Marker, Instance_Pool.all);
+         Subprg_Instance := Create_Subprogram_Instance (Instance, Imp);
+         Adjust_Up_Link_For_Protected_Object
+           (Instance, Call, Subprg_Instance);
+         Assoc_Chain := Get_Parameter_Association_Chain (Call);
+         Execute_Association (Instance, Subprg_Instance, Assoc_Chain);
+
+         Current_Process.Instance := Subprg_Instance;
+         Subprg_Body := Get_Subprogram_Body (Imp);
+         Elaborate_Declarative_Part
+           (Subprg_Instance, Get_Declaration_Chain (Subprg_Body));
+
+         Init_Sequential_Statements (Proc, Subprg_Body);
+      end if;
+   end Execute_Call_Statement;
+
+   procedure Finish_Procedure_Frame (Proc : Process_State_Acc)
+   is
+      Old_Instance : constant Block_Instance_Acc := Proc.Instance;
+   begin
+      Execute_Back_Association (Old_Instance);
+      Proc.Instance := Old_Instance.Parent;
+      Execute_Subprogram_Call_Final (Old_Instance);
+      Release (Proc.Instance.Marker, Instance_Pool.all);
+   end Finish_Procedure_Frame;
+
+   procedure Execute_If_Statement
+     (Proc : Process_State_Acc; Stmt: Iir_Wait_Statement)
+   is
+      Clause: Iir;
+      Cond: Boolean;
+   begin
+      Clause := Stmt;
+      loop
+         Cond := Execute_Condition (Proc.Instance, Get_Condition (Clause));
+         if Cond then
+            Init_Sequential_Statements (Proc, Clause);
+            return;
+         end if;
+         Clause := Get_Else_Clause (Clause);
+         exit when Clause = Null_Iir;
+      end loop;
+      Update_Next_Statement (Proc);
+   end Execute_If_Statement;
+
+   procedure Execute_Variable_Assignment
+     (Proc : Process_State_Acc; Stmt : Iir)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Target : constant Iir := Get_Target (Stmt);
+      Target_Type : constant Iir := Get_Type (Target);
+      Expr : constant Iir := Get_Expression (Stmt);
+      Expr_Type : constant Iir := Get_Type (Expr);
+      Target_Val: Iir_Value_Literal_Acc;
+      Res : Iir_Value_Literal_Acc;
+      Marker : Mark_Type;
+   begin
+      Mark (Marker, Expr_Pool);
+      Target_Val := Execute_Expression (Instance, Target);
+
+      --  If the type of the target is not static and the value is
+      --  an aggregate, then the aggregate may be contrained by the
+      --  target.
+      if Get_Kind (Expr) = Iir_Kind_Aggregate
+        and then Get_Type_Staticness (Expr_Type) < Locally
+        and then Get_Kind (Expr_Type)
+        in Iir_Kinds_Array_Type_Definition
+      then
+         Res := Copy_Array_Bound (Target_Val);
+         Fill_Array_Aggregate (Instance, Expr, Res);
+      else
+         Res := Execute_Expression (Instance, Expr);
+      end if;
+      if Get_Kind (Target_Type) in Iir_Kinds_Array_Type_Definition then
+         --  Note: target_type may be dynamic (slice case), so
+         --  check_constraints is not called.
+         Implicit_Array_Conversion (Res, Target_Val, Stmt);
+      else
+         Check_Constraints (Instance, Res, Target_Type, Stmt);
+      end if;
+
+      --  Note: we need to unshare before copying to avoid
+      --  overwrites (in assignments like: v (1 to 4) := v (3 to 6)).
+      --  FIXME: improve that handling (detect overlaps before).
+      Store (Target_Val, Unshare (Res, Expr_Pool'Access));
+
+      Release (Marker, Expr_Pool);
+   end Execute_Variable_Assignment;
+
+   function Execute_Return_Statement (Proc : Process_State_Acc)
+                                     return Boolean
+   is
+      Res : Iir_Value_Literal_Acc;
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : constant Iir := Instance.Stmt;
+      Expr : constant Iir := Get_Expression (Stmt);
+   begin
+      if Expr /= Null_Iir then
+         Res := Execute_Expression (Instance, Expr);
+         Implicit_Array_Conversion (Instance, Res, Get_Type (Stmt), Stmt);
+         Check_Constraints (Instance, Res, Get_Type (Stmt), Stmt);
+         Instance.Result := Res;
+      end if;
+
+      case Get_Kind (Instance.Label) is
+         when Iir_Kind_Procedure_Declaration =>
+            Finish_Procedure_Frame (Proc);
+            Update_Next_Statement (Proc);
+            return False;
+         when Iir_Kind_Function_Declaration =>
+            return True;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Execute_Return_Statement;
+
+   procedure Finish_Sequential_Statements
+     (Proc : Process_State_Acc; Complex_Stmt : Iir)
+   is
+      Instance : Block_Instance_Acc := Proc.Instance;
+      Stmt : Iir;
+   begin
+      Stmt := Complex_Stmt;
+      loop
+         Instance.Stmt := Stmt;
+         case Get_Kind (Stmt) is
+            when Iir_Kind_For_Loop_Statement =>
+               if Finish_For_Loop_Statement (Instance) then
+                  return;
+               end if;
+            when Iir_Kind_While_Loop_Statement =>
+               if Finish_While_Loop_Statement (Instance) then
+                  return;
+               end if;
+            when Iir_Kind_Case_Statement
+              | Iir_Kind_If_Statement =>
+               null;
+            when Iir_Kind_Sensitized_Process_Statement =>
+               Instance.Stmt := Null_Iir;
+               return;
+            when Iir_Kind_Process_Statement =>
+               --  Start again.
+               Instance.Stmt := Get_Sequential_Statement_Chain (Stmt);
+               return;
+            when Iir_Kind_Procedure_Body =>
+               Finish_Procedure_Frame (Proc);
+               Instance := Proc.Instance;
+            when Iir_Kind_Function_Body =>
+               Error_Msg_Exec ("missing return statement in function", Stmt);
+            when others =>
+               Error_Kind ("execute_next_statement", Stmt);
+         end case;
+         Stmt := Get_Chain (Instance.Stmt);
+         if Stmt /= Null_Iir then
+            Instance.Stmt := Stmt;
+            return;
+         end if;
+         Stmt := Get_Parent (Instance.Stmt);
+      end loop;
+   end Finish_Sequential_Statements;
+
+   procedure Init_Sequential_Statements
+     (Proc : Process_State_Acc; Complex_Stmt : Iir)
+   is
+      Stmt : Iir;
+   begin
+      Stmt := Get_Sequential_Statement_Chain (Complex_Stmt);
+      if Stmt /= Null_Iir then
+         Proc.Instance.Stmt := Stmt;
+      else
+         Finish_Sequential_Statements (Proc, Complex_Stmt);
+      end if;
+   end Init_Sequential_Statements;
+
+   procedure Update_Next_Statement (Proc : Process_State_Acc)
+   is
+      Instance : constant Block_Instance_Acc := Proc.Instance;
+      Stmt : Iir;
+   begin
+      Stmt := Get_Chain (Instance.Stmt);
+      if Stmt /= Null_Iir then
+         Instance.Stmt := Stmt;
+         return;
+      end if;
+      Finish_Sequential_Statements (Proc, Get_Parent (Instance.Stmt));
+   end Update_Next_Statement;
+
+   procedure Execute_Sequential_Statements (Proc : Process_State_Acc)
+   is
+      Instance : Block_Instance_Acc;
+      Stmt: Iir;
+   begin
+      loop
+         Instance := Proc.Instance;
+         Stmt := Instance.Stmt;
+
+         --  End of process or subprogram.
+         exit when Stmt = Null_Iir;
+
+         if Trace_Statements then
+            declare
+               Name : Name_Id;
+               Line : Natural;
+               Col : Natural;
+            begin
+               Files_Map.Location_To_Position
+                 (Get_Location (Stmt), Name, Line, Col);
+               Put_Line ("Execute statement at "
+                           & Name_Table.Image (Name)
+                           & Natural'Image (Line));
+            end;
+         end if;
+
+         if Flag_Need_Debug then
+            Debug (Reason_Break);
+         end if;
+
+         -- execute statement STMT.
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Null_Statement =>
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_If_Statement =>
+               Execute_If_Statement (Proc, Stmt);
+
+            when Iir_Kind_Signal_Assignment_Statement =>
+               Execute_Signal_Assignment (Instance, Stmt);
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_Assertion_Statement =>
+               declare
+                  Res : Boolean;
+               begin
+                  Res := Execute_Condition
+                    (Instance, Get_Assertion_Condition (Stmt));
+                  if not Res then
+                     Execute_Report_Statement (Instance, Stmt, 2);
+                  end if;
+               end;
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_Report_Statement =>
+               Execute_Report_Statement (Instance, Stmt, 0);
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_Variable_Assignment_Statement =>
+               Execute_Variable_Assignment (Proc, Stmt);
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_Return_Statement =>
+               if Execute_Return_Statement (Proc) then
+                  return;
+               end if;
+
+            when Iir_Kind_For_Loop_Statement =>
+               Execute_For_Loop_Statement (Proc);
+
+            when Iir_Kind_While_Loop_Statement =>
+               Execute_While_Loop_Statement (Proc);
+
+            when Iir_Kind_Case_Statement =>
+               Execute_Case_Statement (Proc);
+
+            when Iir_Kind_Wait_Statement =>
+               if Execute_Wait_Statement (Instance, Stmt) then
+                  return;
+               end if;
+               Update_Next_Statement (Proc);
+
+            when Iir_Kind_Procedure_Call_Statement =>
+               Execute_Call_Statement (Proc);
+
+            when Iir_Kind_Exit_Statement =>
+               Execute_Exit_Next_Statement (Proc, True);
+            when Iir_Kind_Next_Statement =>
+               Execute_Exit_Next_Statement (Proc, False);
+
+            when others =>
+               Error_Kind ("execute_sequential_statements", Stmt);
+         end case;
+      end loop;
+   end Execute_Sequential_Statements;
+end Execution;
diff --git a/src/simulate/execution.ads b/src/simulate/execution.ads
new file mode 100644
index 000000000..faed1111d
--- /dev/null
+++ b/src/simulate/execution.ads
@@ -0,0 +1,185 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Iirs; use Iirs;
+with Iir_Values; use Iir_Values;
+with Elaboration; use Elaboration;
+with Areapools; use Areapools;
+
+package Execution is
+   Trace_Statements : Boolean := False;
+
+   -- If true, disp current time in assert message.
+   Disp_Time_Before_Values: Boolean := False;
+
+   Current_Component : Block_Instance_Acc := null;
+
+   -- State associed with each process.
+   type Process_State_Type is record
+      --  The process instance.
+      Top_Instance: Block_Instance_Acc := null;
+      Proc: Iir := Null_Iir;
+
+      --  Memory pool to allocate objects from.
+      Pool : aliased Areapool;
+
+      -- The stack of the process.
+      Instance : Block_Instance_Acc := null;
+   end record;
+   type Process_State_Acc is access all Process_State_Type;
+
+   Simulation_Finished : exception;
+
+   --  Current process being executed.  This is only for the debugger.
+   Current_Process : Process_State_Acc;
+
+   --  Pseudo process used for resolution functions, ...
+   No_Process : Process_State_Acc := new Process_State_Type;
+   -- Execute a list of sequential statements.
+   -- Return when there is no more statements to execute.
+   procedure Execute_Sequential_Statements (Proc : Process_State_Acc);
+
+   --  Evaluate an expression.
+   function Execute_Expression (Block: Block_Instance_Acc; Expr: Iir)
+                               return Iir_Value_Literal_Acc;
+
+   --  Evaluate boolean condition COND.  If COND is Null_Iir, returns true.
+   function Execute_Condition (Instance : Block_Instance_Acc;
+                               Cond : Iir) return Boolean;
+
+   --  Execute a name.  Return the value if Ref is False, or the reference
+   --  (for a signal, a quantity or a terminal) if Ref is True.
+   function Execute_Name (Block: Block_Instance_Acc;
+                          Expr: Iir;
+                          Ref : Boolean := False)
+                         return Iir_Value_Literal_Acc;
+
+   procedure Execute_Name_With_Base (Block: Block_Instance_Acc;
+                                     Expr: Iir;
+                                     Base : Iir_Value_Literal_Acc;
+                                     Res : out Iir_Value_Literal_Acc;
+                                     Is_Sig : out Boolean);
+
+   --  Return the initial value (default value) of signal name EXPR.  To be
+   --  used only during (non-dynamic) elaboration.
+   function Execute_Signal_Init_Value (Block : Block_Instance_Acc; Expr : Iir)
+                                      return Iir_Value_Literal_Acc;
+
+   function Execute_Expression_With_Type
+     (Block: Block_Instance_Acc;
+      Expr: Iir;
+      Expr_Type : Iir)
+     return Iir_Value_Literal_Acc;
+
+   function Execute_Resolution_Function
+     (Block: Block_Instance_Acc; Imp : Iir; Arr : Iir_Value_Literal_Acc)
+      return Iir_Value_Literal_Acc;
+
+   function Execute_Assoc_Conversion
+     (Block : Block_Instance_Acc; Conv : Iir; Val : Iir_Value_Literal_Acc)
+     return Iir_Value_Literal_Acc;
+
+   -- Sub function common for left/right/length/low/high attributes.
+   -- Return bounds of PREFIX.
+   function Execute_Bounds (Block: Block_Instance_Acc; Prefix: Iir)
+                            return Iir_Value_Literal_Acc;
+
+   -- Compute the offset for INDEX into a range BOUNDS.
+   -- EXPR is only used in case of error.
+   function Get_Index_Offset
+     (Index: Iir_Value_Literal_Acc;
+      Bounds: Iir_Value_Literal_Acc;
+      Expr: Iir)
+     return Iir_Index32;
+
+   function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc)
+                              return Iir_Value_Literal_Acc;
+
+   function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir)
+                                   return Block_Instance_Acc;
+
+   --  Store VALUE to TARGET.
+   --  Note: VALUE is not freed.
+   procedure Assign_Value_To_Object
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Target_Type: Iir;
+      Value: Iir_Value_Literal_Acc;
+      Stmt: Iir);
+
+   -- Check VALUE follows the constraints of DEF.
+   -- INSTANCE,DEF is the definition of a subtype.
+   -- EXPR is just used in case of error to display the location
+   -- If there is no location, EXPR can be null.
+   -- Implicitly convert VALUE (array cases).
+   -- Return in case of success.
+   -- Raise errorout.execution_constraint_error in case of failure.
+   procedure Check_Constraints
+     (Instance: Block_Instance_Acc;
+      Value: Iir_Value_Literal_Acc;
+      Def: Iir; Expr: Iir);
+
+   --  If VALUE is not an array, then this is a no-op.
+   --  If VALUE is an array, then bounds are checked and converted.  INSTANCE
+   --  is the instance corresponding to REF_TYPE.
+   --  EXPR is used in case of error.
+   procedure Implicit_Array_Conversion (Value : in out Iir_Value_Literal_Acc;
+                                        Ref_Value : Iir_Value_Literal_Acc;
+                                        Expr : Iir);
+   procedure Implicit_Array_Conversion (Instance : Block_Instance_Acc;
+                                        Value : in out Iir_Value_Literal_Acc;
+                                        Ref_Type : Iir;
+                                        Expr : Iir);
+
+   --  Create an iir_value_literal of kind iir_value_array and of life LIFE.
+   --  Allocate the array of bounds, and fill it from A_TYPE.
+   --  Allocate the array of values.
+   function Create_Array_Bounds_From_Type
+     (Block : Block_Instance_Acc;
+      A_Type : Iir;
+      Create_Val_Array : Boolean)
+     return Iir_Value_Literal_Acc;
+
+   --  Create a range from LEN for scalar type ATYPE.
+   function Create_Bounds_From_Length (Block : Block_Instance_Acc;
+                                       Atype : Iir;
+                                       Len : Iir_Index32)
+                                      return Iir_Value_Literal_Acc;
+
+   --  Return TRUE iff VAL is in the range defined by BOUNDS.
+   function Is_In_Range (Val : Iir_Value_Literal_Acc;
+                         Bounds : Iir_Value_Literal_Acc)
+     return Boolean;
+
+   --  Increment or decrement VAL according to BOUNDS.DIR.
+   procedure Update_Loop_Index (Val : Iir_Value_Literal_Acc;
+                                Bounds : Iir_Value_Literal_Acc);
+
+   --  Create a block instance for subprogram IMP.
+   function Create_Subprogram_Instance (Instance : Block_Instance_Acc;
+                                        Imp : Iir)
+                                       return Block_Instance_Acc;
+
+   function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir)
+                                  return Iir_Value_Literal_Acc;
+
+   function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc;
+                                     Expr_Type : Iir)
+                                    return String;
+end Execution;
diff --git a/src/simulate/file_operation.adb b/src/simulate/file_operation.adb
new file mode 100644
index 000000000..33700fd6c
--- /dev/null
+++ b/src/simulate/file_operation.adb
@@ -0,0 +1,341 @@
+--  File operations for interpreter
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Annotations; use Annotations;
+with Execution; use Execution;
+with Debugger; use Debugger;
+with Grt.Types; use Grt.Types;
+with Grt_Interface; use Grt_Interface;
+
+package body File_Operation is
+   --  Open a file.
+   --  See LRM93 3.4.1 for definition of arguments.
+   --  IS_TEXT is true if the file format is text.
+   --  The purpose of the IS_TEXT is to allow a text implementation of file
+   --  type TEXT, defined in std.textio.
+   procedure File_Open (Status : out Ghdl_I32;
+                        File : Iir_Value_Literal_Acc;
+                        External_Name : Iir_Value_Literal_Acc;
+                        Mode : Ghdl_I32;
+                        Is_Text : Boolean;
+                        Return_Status : Boolean)
+   is
+      Name_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (External_Name.Bounds.D (1).Length);
+      Name_Str : aliased Std_String_Uncons (1 .. Name_Len);
+      Name_Bnd : aliased Std_String_Bound := Build_Bound (External_Name);
+      Name : aliased Std_String := (To_Std_String_Basep (Name_Str'Address),
+                                    To_Std_String_Boundp (Name_Bnd'Address));
+   begin
+      -- Convert the string to an Ada string.
+      for I in External_Name.Val_Array.V'Range loop
+         Name_Str (Name_Str'First + Ghdl_Index_Type (I - 1)) :=
+           Character'Val (External_Name.Val_Array.V (I).E32);
+      end loop;
+
+      if Is_Text then
+         if Return_Status then
+            Status := Ghdl_Text_File_Open_Status
+              (File.File, Mode, Name'Unrestricted_Access);
+         else
+            Ghdl_Text_File_Open (File.File, Mode, Name'Unrestricted_Access);
+            Status := Open_Ok;
+         end if;
+      else
+         if Return_Status then
+            Status := Ghdl_File_Open_Status
+              (File.File, Mode, Name'Unrestricted_Access);
+         else
+            Ghdl_File_Open (File.File, Mode, Name'Unrestricted_Access);
+            Status := Open_Ok;
+         end if;
+      end if;
+   end File_Open;
+
+   --  Open a file.
+   procedure File_Open (File : Iir_Value_Literal_Acc;
+                        Name : Iir_Value_Literal_Acc;
+                        Mode : Iir_Value_Literal_Acc;
+                        File_Decl : Iir;
+                        Stmt : Iir)
+   is
+      pragma Unreferenced (Stmt);
+      Is_Text : constant Boolean := Get_Text_File_Flag (Get_Type (File_Decl));
+      File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E32);
+      Status : Ghdl_I32;
+   begin
+      File_Open (Status, File, Name, File_Mode, Is_Text, False);
+      if Status /= Open_Ok then
+         raise Program_Error;
+      end if;
+   end File_Open;
+
+   procedure File_Open_Status (Status : Iir_Value_Literal_Acc;
+                               File : Iir_Value_Literal_Acc;
+                               Name : Iir_Value_Literal_Acc;
+                               Mode : Iir_Value_Literal_Acc;
+                               File_Decl : Iir;
+                               Stmt : Iir)
+   is
+      pragma Unreferenced (Stmt);
+      Is_Text : constant Boolean := Get_Text_File_Flag (Get_Type (File_Decl));
+      File_Mode : constant Ghdl_I32 := Ghdl_I32 (Mode.E32);
+      R_Status : Ghdl_I32;
+   begin
+      File_Open (R_Status, File, Name, File_Mode, Is_Text, True);
+      Status.E32 := Ghdl_E32 (R_Status);
+   end File_Open_Status;
+
+   function Elaborate_File_Declaration
+     (Instance: Block_Instance_Acc; Decl: Iir_File_Declaration)
+     return Iir_Value_Literal_Acc
+   is
+      Def : constant Iir := Get_Type (Decl);
+      External_Name : Iir;
+      File_Name: Iir_Value_Literal_Acc;
+      Is_Text : constant Boolean := Get_Text_File_Flag (Def);
+      File_Mode : Ghdl_I32;
+      Res : Iir_Value_Literal_Acc;
+      Status : Ghdl_I32;
+      Mode : Iir_Value_Literal_Acc;
+   begin
+      if Is_Text then
+         Res := Create_File_Value (Ghdl_Text_File_Elaborate);
+      else
+         declare
+            Sig : constant String_Acc := Get_Info (Def).File_Signature;
+            Cstr : Ghdl_C_String;
+         begin
+            if Sig = null then
+               Cstr := null;
+            else
+               Cstr := To_Ghdl_C_String (Sig.all'Address);
+            end if;
+            Res := Create_File_Value (Ghdl_File_Elaborate (Cstr));
+         end;
+      end if;
+
+      External_Name := Get_File_Logical_Name (Decl);
+
+      --  LRM93 4.3.1.4
+      --  If file open information is not included in a given file declaration,
+      --  then the file declared by the declaration is not opened when the file
+      --  declaration is elaborated.
+      if External_Name = Null_Iir then
+         return Res;
+      end if;
+
+      File_Name := Execute_Expression (Instance, External_Name);
+      if Get_File_Open_Kind (Decl) /= Null_Iir then
+         Mode := Execute_Expression (Instance, Get_File_Open_Kind (Decl));
+         File_Mode := Ghdl_I32 (Mode.E32);
+      else
+         case Get_Mode (Decl) is
+            when Iir_In_Mode =>
+               File_Mode := Read_Mode;
+            when Iir_Out_Mode =>
+               File_Mode := Write_Mode;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end if;
+      File_Open (Status, Res, File_Name, File_Mode, Is_Text, False);
+      return Res;
+   end Elaborate_File_Declaration;
+
+   procedure File_Close_Text (File : Iir_Value_Literal_Acc; Stmt : Iir) is
+      pragma Unreferenced (Stmt);
+   begin
+      Ghdl_Text_File_Close (File.File);
+   end File_Close_Text;
+
+   procedure File_Close_Binary (File : Iir_Value_Literal_Acc; Stmt : Iir) is
+      pragma Unreferenced (Stmt);
+   begin
+      Ghdl_File_Close (File.File);
+   end File_Close_Binary;
+
+   procedure File_Destroy_Text (File : Iir_Value_Literal_Acc) is
+   begin
+      Ghdl_Text_File_Finalize (File.File);
+   end File_Destroy_Text;
+
+   procedure File_Destroy_Binary (File : Iir_Value_Literal_Acc) is
+   begin
+      Ghdl_File_Finalize (File.File);
+   end File_Destroy_Binary;
+
+
+   procedure Write_Binary (File: Iir_Value_Literal_Acc;
+                           Value: Iir_Value_Literal_Acc) is
+   begin
+      case Value.Kind is
+         when Iir_Value_B1 =>
+            Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.B1'Address), 1);
+         when Iir_Value_I64 =>
+            Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.I64'Address), 8);
+         when Iir_Value_E32 =>
+            Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.E32'Address), 4);
+         when Iir_Value_F64 =>
+            Ghdl_Write_Scalar (File.File, Ghdl_Ptr (Value.F64'Address), 8);
+         when Iir_Value_Array =>
+            for I in Value.Bounds.D'Range loop
+               Ghdl_Write_Scalar
+                 (File.File, Ghdl_Ptr (Value.Bounds.D (I).Length'Address), 4);
+            end loop;
+            for I in Value.Val_Array.V'Range loop
+               Write_Binary (File, Value.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            for I in Value.Val_Record.V'Range loop
+               Write_Binary (File, Value.Val_Record.V (I));
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Write_Binary;
+
+   procedure Write_Text (File: Iir_Value_Literal_Acc;
+                         Value: Iir_Value_Literal_Acc)
+   is
+      Val_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (Value.Bounds.D (1).Length);
+      Val_Str : aliased Std_String_Uncons (1 .. Val_Len);
+      Val_Bnd : aliased Std_String_Bound := Build_Bound (Value);
+      Val : aliased Std_String := (To_Std_String_Basep (Val_Str'Address),
+                                    To_Std_String_Boundp (Val_Bnd'Address));
+   begin
+      -- Convert the string to an Ada string.
+      for I in Value.Val_Array.V'Range loop
+         Val_Str (Val_Str'First + Ghdl_Index_Type (I - 1)) :=
+           Character'Val (Value.Val_Array.V (I).E32);
+      end loop;
+
+      Ghdl_Text_Write (File.File, Val'Unrestricted_Access);
+   end Write_Text;
+
+   function Endfile (File : Iir_Value_Literal_Acc; Stmt : Iir)
+                    return Boolean
+   is
+      pragma Unreferenced (Stmt);
+   begin
+      return Grt.Files.Ghdl_File_Endfile (File.File);
+   end Endfile;
+
+   procedure Read_Length_Text (File : Iir_Value_Literal_Acc;
+                               Value : Iir_Value_Literal_Acc;
+                               Length : Iir_Value_Literal_Acc)
+   is
+      Val_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (Value.Bounds.D (1).Length);
+      Val_Str : aliased Std_String_Uncons (1 .. Val_Len);
+      Val_Bnd : aliased Std_String_Bound := Build_Bound (Value);
+      Val : aliased Std_String := (To_Std_String_Basep (Val_Str'Address),
+                                   To_Std_String_Boundp (Val_Bnd'Address));
+      Len : Std_Integer;
+   begin
+      Len := Ghdl_Text_Read_Length (File.File, Val'Unrestricted_Access);
+      for I in 1 .. Len loop
+         Value.Val_Array.V (Iir_Index32 (I)).E32 :=
+           Character'Pos (Val_Str (Ghdl_Index_Type (I)));
+      end loop;
+      Length.I64 := Ghdl_I64 (Len);
+   end Read_Length_Text;
+
+   procedure Untruncated_Text_Read (File : Iir_Value_Literal_Acc;
+                                    Str : Iir_Value_Literal_Acc;
+                                    Length : Iir_Value_Literal_Acc)
+   is
+      Res : Ghdl_Untruncated_Text_Read_Result;
+      Val_Len : constant Ghdl_Index_Type :=
+        Ghdl_Index_Type (Str.Bounds.D (1).Length);
+      Val_Str : aliased Std_String_Uncons (1 .. Val_Len);
+      Val_Bnd : aliased Std_String_Bound := Build_Bound (Str);
+      Val : aliased Std_String := (To_Std_String_Basep (Val_Str'Address),
+                                   To_Std_String_Boundp (Val_Bnd'Address));
+   begin
+      Ghdl_Untruncated_Text_Read
+        (Res'Unrestricted_Access, File.File, Val'Unrestricted_Access);
+      for I in 1 .. Res.Len loop
+         Str.Val_Array.V (Iir_Index32 (I)).E32 :=
+           Character'Pos (Val_Str (Ghdl_Index_Type (I)));
+      end loop;
+      Length.I64 := Ghdl_I64 (Res.Len);
+   end Untruncated_Text_Read;
+
+   procedure Read_Binary (File: Iir_Value_Literal_Acc;
+                          Value: Iir_Value_Literal_Acc)
+   is
+   begin
+      case Value.Kind is
+         when Iir_Value_B1 =>
+            Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.B1'Address), 1);
+         when Iir_Value_I64 =>
+            Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.I64'Address), 8);
+         when Iir_Value_E32 =>
+            Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.E32'Address), 4);
+         when Iir_Value_F64 =>
+            Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Value.F64'Address), 8);
+         when Iir_Value_Array =>
+            for I in Value.Bounds.D'Range loop
+               declare
+                  Len : Iir_Index32;
+               begin
+                  Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Len'Address), 4);
+                  if Len /= Value.Bounds.D (I).Length then
+                     Error_Msg_Constraint (Null_Iir); --  FIXME: loc
+                  end if;
+               end;
+            end loop;
+            for I in Value.Val_Array.V'Range loop
+               Read_Binary (File, Value.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            for I in Value.Val_Record.V'Range loop
+               Read_Binary (File, Value.Val_Record.V (I));
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Read_Binary;
+
+   procedure Read_Length_Binary (File : Iir_Value_Literal_Acc;
+                                 Value : Iir_Value_Literal_Acc;
+                                 Length : Iir_Value_Literal_Acc)
+   is
+      Len : Iir_Index32;
+   begin
+      Ghdl_Read_Scalar (File.File, Ghdl_Ptr (Len'Address), 4);
+      for I in 1 .. Len loop
+         if I <= Value.Bounds.D (1).Length then
+            Read_Binary (File, Value.Val_Array.V (I));
+         else
+            --  FIXME: for empty arrays ??
+            --  Lose_Binary (File, Value.Val_Array (0));
+            raise Internal_Error;
+         end if;
+      end loop;
+      Length.I64 := Ghdl_I64 (Len);
+   end Read_Length_Binary;
+
+   procedure Flush (File : Iir_Value_Literal_Acc) is
+   begin
+      Ghdl_File_Flush (File.File);
+   end Flush;
+end File_Operation;
diff --git a/src/simulate/file_operation.ads b/src/simulate/file_operation.ads
new file mode 100644
index 000000000..b66a06756
--- /dev/null
+++ b/src/simulate/file_operation.ads
@@ -0,0 +1,81 @@
+--  File operations for interpreter
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Iirs; use Iirs;
+with Iir_Values; use Iir_Values;
+with Elaboration; use Elaboration;
+with Grt.Files; use Grt.Files;
+
+package File_Operation is
+   Null_File : constant Natural := 0;
+
+   --  Open a file.
+   procedure File_Open (File : Iir_Value_Literal_Acc;
+                        Name : Iir_Value_Literal_Acc;
+                        Mode : Iir_Value_Literal_Acc;
+                        File_Decl : Iir;
+                        Stmt : Iir);
+
+   procedure File_Open_Status (Status : Iir_Value_Literal_Acc;
+                               File : Iir_Value_Literal_Acc;
+                               Name : Iir_Value_Literal_Acc;
+                               Mode : Iir_Value_Literal_Acc;
+                               File_Decl : Iir;
+                               Stmt : Iir);
+
+   --  Close a file.
+   --  If the file was not open, this has no effects.
+   procedure File_Close_Text (File : Iir_Value_Literal_Acc; Stmt : Iir);
+   procedure File_Close_Binary (File : Iir_Value_Literal_Acc; Stmt : Iir);
+
+   procedure File_Destroy_Text (File : Iir_Value_Literal_Acc);
+   procedure File_Destroy_Binary (File : Iir_Value_Literal_Acc);
+
+   -- Elaborate a file_declaration.
+   function Elaborate_File_Declaration
+     (Instance: Block_Instance_Acc; Decl: Iir_File_Declaration)
+     return Iir_Value_Literal_Acc;
+
+   -- Write VALUE to FILE.
+   -- STMT is the statement, to display error.
+   procedure Write_Text (File: Iir_Value_Literal_Acc;
+                         Value: Iir_Value_Literal_Acc);
+   procedure Write_Binary (File: Iir_Value_Literal_Acc;
+                           Value: Iir_Value_Literal_Acc);
+
+   procedure Read_Binary (File: Iir_Value_Literal_Acc;
+                          Value: Iir_Value_Literal_Acc);
+
+   procedure Read_Length_Text (File : Iir_Value_Literal_Acc;
+                               Value : Iir_Value_Literal_Acc;
+                               Length : Iir_Value_Literal_Acc);
+
+   procedure Read_Length_Binary (File : Iir_Value_Literal_Acc;
+                                 Value : Iir_Value_Literal_Acc;
+                                 Length : Iir_Value_Literal_Acc);
+
+   procedure Untruncated_Text_Read (File : Iir_Value_Literal_Acc;
+                                    Str : Iir_Value_Literal_Acc;
+                                    Length : Iir_Value_Literal_Acc);
+
+   procedure Flush (File : Iir_Value_Literal_Acc);
+
+   --  Test end of FILE is reached.
+   function Endfile (File : Iir_Value_Literal_Acc; Stmt : Iir)
+     return Boolean;
+end File_Operation;
diff --git a/src/simulate/grt_interface.adb b/src/simulate/grt_interface.adb
new file mode 100644
index 000000000..c4eab58c4
--- /dev/null
+++ b/src/simulate/grt_interface.adb
@@ -0,0 +1,44 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Iirs; use Iirs;
+with Types; use Types;
+
+package body Grt_Interface is
+   To_Dir : constant array (Iir_Direction) of Ghdl_Dir_Type :=
+     (Iir_To => Dir_To, Iir_Downto => Dir_Downto);
+
+   function Build_Bound (Arr : Iir_Value_Literal_Acc) return Std_String_Bound
+   is
+      Rng : constant Iir_Value_Literal_Acc := Arr.Bounds.D (1);
+   begin
+      return (Dim_1 => (Left => Std_Integer (Rng.Left.I64),
+                        Right => Std_Integer (Rng.Right.I64),
+                        Dir => To_Dir (Rng.Dir),
+                        Length => Ghdl_Index_Type (Rng.Length)));
+   end Build_Bound;
+
+   procedure Set_Std_String_From_Iir_Value (Str : Std_String;
+                                            Val : Iir_Value_Literal_Acc) is
+   begin
+      for I in Val.Val_Array.V'Range loop
+         Str.Base (Ghdl_Index_Type (I - 1)) :=
+           Character'Val (Val.Val_Array.V (I).E32);
+      end loop;
+   end Set_Std_String_From_Iir_Value;
+end Grt_Interface;
diff --git a/src/simulate/grt_interface.ads b/src/simulate/grt_interface.ads
new file mode 100644
index 000000000..05f7abb69
--- /dev/null
+++ b/src/simulate/grt_interface.ads
@@ -0,0 +1,27 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Grt.Types; use Grt.Types;
+with Iir_Values; use Iir_Values;
+
+package Grt_Interface is
+   procedure Set_Std_String_From_Iir_Value (Str : Std_String;
+                                            Val : Iir_Value_Literal_Acc);
+
+   function Build_Bound (Arr : Iir_Value_Literal_Acc) return Std_String_Bound;
+end Grt_Interface;
diff --git a/src/simulate/iir_values.adb b/src/simulate/iir_values.adb
new file mode 100644
index 000000000..d80f3bf0a
--- /dev/null
+++ b/src/simulate/iir_values.adb
@@ -0,0 +1,1066 @@
+--  Naive values for interpreted simulation
+--  Copyright (C) 2014 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 GHDL; 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_Conversion;
+with GNAT.Debug_Utilities;
+with Name_Table;
+with Debugger; use Debugger;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Iir_Values is
+
+   -- Functions for iir_value_literal
+   function Is_Equal (Left, Right: Iir_Value_Literal_Acc) return Boolean is
+   begin
+      if Left.Kind /= Right.Kind then
+         raise Internal_Error;
+      end if;
+      case Left.Kind is
+         when Iir_Value_B1 =>
+            return Left.B1 = Right.B1;
+         when Iir_Value_E32 =>
+            return Left.E32 = Right.E32;
+         when Iir_Value_I64 =>
+            return Left.I64 = Right.I64;
+         when Iir_Value_F64 =>
+            return Left.F64 = Right.F64;
+         when Iir_Value_Access =>
+            return Left.Val_Access = Right.Val_Access;
+         when Iir_Value_File =>
+            raise Internal_Error;
+         when Iir_Value_Array =>
+            if Left.Bounds.Nbr_Dims /= Right.Bounds.Nbr_Dims then
+               raise Internal_Error;
+            end if;
+            for I in Left.Bounds.D'Range loop
+               if Left.Bounds.D (I).Length /= Right.Bounds.D (I).Length then
+                  return False;
+               end if;
+            end loop;
+            for I in Left.Val_Array.V'Range loop
+               if not Is_Equal (Left.Val_Array.V (I),
+                                Right.Val_Array.V (I)) then
+                  return False;
+               end if;
+            end loop;
+            return True;
+         when Iir_Value_Record =>
+            if Left.Val_Record.Len /= Right.Val_Record.Len then
+               raise Constraint_Error;
+            end if;
+            for I in Left.Val_Record.V'Range loop
+               if not Is_Equal (Left.Val_Record.V (I),
+                                Right.Val_Record.V (I)) then
+                  return False;
+               end if;
+            end loop;
+            return True;
+         when Iir_Value_Range =>
+            if Left.Dir /= Right.Dir then
+               return False;
+            end if;
+            if not Is_Equal (Left.Left, Right.Left) then
+               return False;
+            end if;
+            if not Is_Equal (Left.Right, Right.Right) then
+               return False;
+            end if;
+            return True;
+         when Iir_Value_Signal
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Is_Equal;
+
+   function Compare_Value (Left, Right : Iir_Value_Literal_Acc)
+                           return Order is
+   begin
+      if Left.Kind /= Right.Kind then
+         raise Constraint_Error;
+      end if;
+      case Left.Kind is
+         when Iir_Value_B1 =>
+            if Left.B1 < Right.B1 then
+               return Less;
+            elsif Left.B1 = Right.B1 then
+               return Equal;
+            else
+               return Greater;
+            end if;
+         when Iir_Value_E32 =>
+            if Left.E32 < Right.E32 then
+               return Less;
+            elsif Left.E32 = Right.E32 then
+               return Equal;
+            else
+               return Greater;
+            end if;
+         when Iir_Value_I64 =>
+            if Left.I64 < Right.I64 then
+               return Less;
+            elsif Left.I64 = Right.I64 then
+               return Equal;
+            else
+               return Greater;
+            end if;
+         when Iir_Value_F64 =>
+            if Left.F64 < Right.F64 then
+               return Less;
+            elsif Left.F64 = Right.F64 then
+               return Equal;
+            elsif Left.F64 > Right.F64 then
+               return Greater;
+            else
+               raise Constraint_Error;
+            end if;
+         when Iir_Value_Array =>
+            --  LRM93 §7.2.2
+            --  For discrete array types, the relation < (less than) is defined
+            --  such as the left operand is less than the right operand if
+            --  and only if:
+            --  *  the left operand is a null array and the right operand is
+            --     a non-null array; otherwise
+            --  *  both operands are non-null arrays, and one of the following
+            --     conditions is satisfied:
+            --     -  the leftmost element of the left operand is less than
+            --        that of the right; or
+            --     -  the leftmost element of the left operand is equal to
+            --        that of the right, and the tail of the left operand is
+            --        less than that of the right (the tail consists of the
+            --        remaining elements to the rights of the leftmost element
+            --        and can be null)
+            --  The relation <= (less than or equal) for discrete array types
+            --  is defined to be the inclusive disjunction of the results of
+            --  the < and = operators for the same two operands.
+            --  The relation > (greater than) and >= (greater than of equal)
+            --  are defined to be the complements of the <= and < operators
+            --  respectively for the same two operands.
+            if Left.Bounds.Nbr_Dims /= 1 or Right.Bounds.Nbr_Dims /= 1 then
+               raise Internal_Error;
+            end if;
+            for I in 1 .. Iir_Index32'Min (Left.Bounds.D (1).Length,
+                                           Right.Bounds.D (1).Length)
+            loop
+               case Compare_Value (Left.Val_Array.V (I),
+                                   Right.Val_Array.V (I)) is
+                  when Less =>
+                     return Less;
+                  when Greater =>
+                     return Greater;
+                  when Equal =>
+                     null;
+               end case;
+            end loop;
+            if Left.Bounds.D (1).Length < Right.Bounds.D (1).Length then
+               return Less;
+            elsif Left.Bounds.D (1).Length = Right.Bounds.D (1).Length then
+               return Equal;
+            else
+               return Greater;
+            end if;
+         when Iir_Value_Signal
+           | Iir_Value_Access
+           | Iir_Value_Range
+           | Iir_Value_Record
+           | Iir_Value_File
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Compare_Value;
+
+   function Is_Nul_Range (Arange : Iir_Value_Literal_Acc) return Boolean
+   is
+      Cmp : Order;
+   begin
+      Cmp := Compare_Value (Arange.Left, Arange.Right);
+      case Arange.Dir is
+         when Iir_To =>
+            return Cmp = Greater;
+         when Iir_Downto =>
+            return Cmp = Less;
+      end case;
+   end Is_Nul_Range;
+
+   procedure Increment (Val : Iir_Value_Literal_Acc) is
+   begin
+      case Val.Kind is
+         when Iir_Value_B1 =>
+            if Val.B1 = False then
+               Val.B1 := True;
+            else
+               raise Constraint_Error;
+            end if;
+         when Iir_Value_E32 =>
+            Val.E32 := Val.E32 + 1;
+         when Iir_Value_I64 =>
+            Val.I64 := Val.I64 + 1;
+         when Iir_Value_F64
+           | Iir_Value_Array
+           | Iir_Value_Record
+           | Iir_Value_Range
+           | Iir_Value_File
+           | Iir_Value_Access
+           | Iir_Value_Signal
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Increment;
+
+   procedure Store (Dest : Iir_Value_Literal_Acc; Src : Iir_Value_Literal_Acc)
+   is
+   begin
+      if Dest.Kind /= Src.Kind then
+         raise Constraint_Error;
+      end if;
+      case Dest.Kind is
+         when Iir_Value_Array =>
+            if Dest.Val_Array.Len /= Src.Val_Array.Len then
+               raise Constraint_Error;
+            end if;
+            for I in Dest.Val_Array.V'Range loop
+               Store (Dest.Val_Array.V (I), Src.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            if Dest.Val_Record.Len /= Src.Val_Record.Len then
+               raise Constraint_Error;
+            end if;
+            for I in Dest.Val_Record.V'Range loop
+               Store (Dest.Val_Record.V (I), Src.Val_Record.V (I));
+            end loop;
+         when Iir_Value_B1 =>
+            Dest.B1 := Src.B1;
+         when Iir_Value_E32 =>
+            Dest.E32 := Src.E32;
+         when Iir_Value_I64 =>
+            Dest.I64 := Src.I64;
+         when Iir_Value_F64 =>
+            Dest.F64 := Src.F64;
+         when Iir_Value_Access =>
+            Dest.Val_Access := Src.Val_Access;
+         when Iir_Value_File =>
+            Dest.File := Src.File;
+         when Iir_Value_Protected =>
+            Dest.Prot := Src.Prot;
+         when Iir_Value_Signal
+           | Iir_Value_Range
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Store;
+
+   procedure Check_Bounds (Dest : Iir_Value_Literal_Acc;
+                           Src : Iir_Value_Literal_Acc;
+                           Loc : Iir)
+   is
+   begin
+      case Dest.Kind is
+         when Iir_Value_Array =>
+            if Src.Kind /= Iir_Value_Array then
+               raise Internal_Error;
+            end if;
+            if Dest.Val_Array.Len /= Src.Val_Array.Len then
+               Error_Msg_Constraint (Loc);
+            end if;
+            if Dest.Val_Array.Len /= 0 then
+               Check_Bounds (Dest.Val_Array.V (1), Src.Val_Array.V (1), Loc);
+            end if;
+         when Iir_Value_Record =>
+            if Src.Kind /= Iir_Value_Record then
+               raise Internal_Error;
+            end if;
+            if Dest.Val_Record.Len /= Src.Val_Record.Len then
+               raise Internal_Error;
+            end if;
+            for I in Dest.Val_Record.V'Range loop
+               Check_Bounds (Dest.Val_Record.V (I), Src.Val_Record.V (I), Loc);
+            end loop;
+         when Iir_Value_Access
+           | Iir_Value_File
+           | Iir_Value_Range
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            if Src.Kind /= Dest.Kind then
+               raise Internal_Error;
+            end if;
+         when Iir_Value_B1
+           | Iir_Value_E32
+           | Iir_Value_I64
+           | Iir_Value_F64
+           | Iir_Value_Signal =>
+            return;
+      end case;
+   end Check_Bounds;
+
+   function To_Iir_Value_Literal_Acc is new Ada.Unchecked_Conversion
+     (System.Address, Iir_Value_Literal_Acc);
+   function To_Value_Array_Acc is new Ada.Unchecked_Conversion
+     (System.Address, Value_Array_Acc);
+   function To_Value_Bounds_Array_Acc is new Ada.Unchecked_Conversion
+     (System.Address, Value_Bounds_Array_Acc);
+
+   function Create_Signal_Value (Sig : Ghdl_Signal_Ptr)
+                                return Iir_Value_Literal_Acc
+   is
+      subtype Signal_Value is Iir_Value_Literal (Iir_Value_Signal);
+      function Alloc is new Alloc_On_Pool_Addr (Signal_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Global_Pool'Access,
+                (Kind => Iir_Value_Signal, Sig => Sig)));
+   end Create_Signal_Value;
+
+   function Create_Terminal_Value (Terminal : Terminal_Index_Type)
+                                  return Iir_Value_Literal_Acc
+   is
+      subtype Terminal_Value is Iir_Value_Literal (Iir_Value_Terminal);
+      function Alloc is new Alloc_On_Pool_Addr (Terminal_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Global_Pool'Access,
+                (Kind => Iir_Value_Terminal, Terminal => Terminal)));
+   end Create_Terminal_Value;
+
+   function Create_Quantity_Value (Quantity : Quantity_Index_Type)
+                                  return Iir_Value_Literal_Acc
+   is
+      subtype Quantity_Value is Iir_Value_Literal (Iir_Value_Quantity);
+      function Alloc is new Alloc_On_Pool_Addr (Quantity_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Global_Pool'Access,
+                (Kind => Iir_Value_Quantity, Quantity => Quantity)));
+   end Create_Quantity_Value;
+
+   function Create_Protected_Value (Prot : Protected_Index_Type)
+                                  return Iir_Value_Literal_Acc
+   is
+      subtype Protected_Value is Iir_Value_Literal (Iir_Value_Protected);
+      function Alloc is new Alloc_On_Pool_Addr (Protected_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Global_Pool'Access,
+                (Kind => Iir_Value_Protected, Prot => Prot)));
+   end Create_Protected_Value;
+
+   function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc
+   is
+      subtype B1_Value is Iir_Value_Literal (Iir_Value_B1);
+      function Alloc is new Alloc_On_Pool_Addr (B1_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool, (Kind => Iir_Value_B1, B1 => Val)));
+   end Create_B1_Value;
+
+   function Create_E32_Value (Val : Ghdl_E32) return Iir_Value_Literal_Acc
+   is
+      subtype E32_Value is Iir_Value_Literal (Iir_Value_E32);
+      function Alloc is new Alloc_On_Pool_Addr (E32_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool, (Kind => Iir_Value_E32, E32 => Val)));
+   end Create_E32_Value;
+
+   function Create_I64_Value (Val : Ghdl_I64) return Iir_Value_Literal_Acc
+   is
+      subtype I64_Value is Iir_Value_Literal (Iir_Value_I64);
+      function Alloc is new Alloc_On_Pool_Addr (I64_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool, (Kind => Iir_Value_I64, I64 => Val)));
+   end Create_I64_Value;
+
+   function Create_F64_Value (Val : Ghdl_F64) return Iir_Value_Literal_Acc
+   is
+      subtype F64_Value is Iir_Value_Literal (Iir_Value_F64);
+      function Alloc is new Alloc_On_Pool_Addr (F64_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool, (Kind => Iir_Value_F64, F64 => Val)));
+   end Create_F64_Value;
+
+   function Create_Access_Value (Val : Iir_Value_Literal_Acc)
+                                return Iir_Value_Literal_Acc
+   is
+      subtype Access_Value is Iir_Value_Literal (Iir_Value_Access);
+      function Alloc is new Alloc_On_Pool_Addr (Access_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool,
+                (Kind => Iir_Value_Access, Val_Access => Val)));
+   end Create_Access_Value;
+
+   function Create_Range_Value
+     (Left, Right : Iir_Value_Literal_Acc;
+      Dir : Iir_Direction;
+      Length : Iir_Index32)
+     return Iir_Value_Literal_Acc
+   is
+      subtype Range_Value is Iir_Value_Literal (Iir_Value_Range);
+      function Alloc is new Alloc_On_Pool_Addr (Range_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool,
+                (Kind => Iir_Value_Range,
+                 Left => Left,
+                 Right => Right,
+                 Dir => Dir,
+                 Length => Length)));
+   end Create_Range_Value;
+
+   function Create_File_Value (Val : Grt.Files.Ghdl_File_Index)
+                              return Iir_Value_Literal_Acc
+   is
+      subtype File_Value is Iir_Value_Literal (Iir_Value_File);
+      function Alloc is new Alloc_On_Pool_Addr (File_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Current_Pool,
+                (Kind => Iir_Value_File, File => Val)));
+   end Create_File_Value;
+
+   --  Create a range_value of life LIFE.
+   function Create_Range_Value
+     (Left, Right : Iir_Value_Literal_Acc;
+      Dir : Iir_Direction)
+      return Iir_Value_Literal_Acc
+   is
+      Low, High : Iir_Value_Literal_Acc;
+      Len : Iir_Index32;
+   begin
+      case Dir is
+         when Iir_To =>
+            Low := Left;
+            High := Right;
+         when Iir_Downto =>
+            Low := Right;
+            High := Left;
+      end case;
+
+      case (Low.Kind) is
+         when Iir_Value_B1 =>
+            if High.B1 >= Low.B1 then
+               Len := Ghdl_B1'Pos (High.B1) - Ghdl_B1'Pos (Low.B1) + 1;
+            else
+               Len := 0;
+            end if;
+         when Iir_Value_E32 =>
+            if High.E32 >= Low.E32 then
+               Len := Iir_Index32 (High.E32 - Low.E32 + 1);
+            else
+               Len := 0;
+            end if;
+         when Iir_Value_I64 =>
+            declare
+               L : Ghdl_I64;
+            begin
+               if High.I64 = Ghdl_I64'Last and Low.I64 = Ghdl_I64'First
+               then
+                  --  Prevent overflow
+                  Len := Iir_Index32'Last;
+               else
+                  L := High.I64 - Low.I64;
+                  if L >= Ghdl_I64 (Iir_Index32'Last) then
+                     --  Prevent overflow
+                     Len := Iir_Index32'Last;
+                  else
+                     L := L + 1;
+                     if L < 0 then
+                        --  null range.
+                        Len := 0;
+                     else
+                        Len := Iir_Index32 (L);
+                     end if;
+                  end if;
+               end if;
+            end;
+         when Iir_Value_F64 =>
+            Len := 0;
+         when Iir_Value_Array
+           | Iir_Value_Record
+           | Iir_Value_Access
+           | Iir_Value_File
+           | Iir_Value_Range
+           | Iir_Value_Signal
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+      return Create_Range_Value (Left, Right, Dir, Len);
+   end Create_Range_Value;
+
+   -- Return an array of length LENGTH.
+   function Create_Array_Value (Dim : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool)
+                               return Iir_Value_Literal_Acc
+   is
+      subtype Array_Value is Iir_Value_Literal (Iir_Value_Array);
+      function Alloc_Array is new Alloc_On_Pool_Addr (Array_Value);
+      subtype Dim_Type is Value_Bounds_Array (Dim);
+      function Alloc_Bounds is new Alloc_On_Pool_Addr (Dim_Type);
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := To_Iir_Value_Literal_Acc
+        (Alloc_Array (Pool,
+                      (Kind => Iir_Value_Array,
+                       Bounds => null, Val_Array => null)));
+
+      Res.Bounds := To_Value_Bounds_Array_Acc
+        (Alloc_Bounds (Pool, Dim_Type'(Nbr_Dims => Dim,
+                                       D => (others => null))));
+
+      return Res;
+   end Create_Array_Value;
+
+   procedure Create_Array_Data (Arr : Iir_Value_Literal_Acc;
+                                Len : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool)
+   is
+      use System;
+      subtype Data_Type is Value_Array (Len);
+      Res : Address;
+   begin
+      --  Manually allocate the array to handle large arrays without
+      --  creating a large temporary value.
+      Allocate
+        (Pool.all, Res, Data_Type'Size / Storage_Unit, Data_Type'Alignment);
+
+      declare
+         --  Discard the warnings for no pragma Import as we really want
+         --  to use the default initialization.
+         pragma Warnings (Off);
+         Addr1 : constant Address := Res;
+         Init : Data_Type;
+         for Init'Address use Addr1;
+         pragma Warnings (On);
+      begin
+         null;
+      end;
+
+      Arr.Val_Array := To_Value_Array_Acc (Res);
+   end Create_Array_Data;
+
+   function Create_Array_Value (Length: Iir_Index32;
+                                Dim : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool)
+                               return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := Create_Array_Value (Dim, Pool);
+      Create_Array_Data (Res, Length, Pool);
+      return Res;
+   end Create_Array_Value;
+
+   function Create_Record_Value
+     (Nbr : Iir_Index32; Pool : Areapool_Acc := Current_Pool)
+     return Iir_Value_Literal_Acc
+   is
+      subtype Record_Value is Iir_Value_Literal (Iir_Value_Record);
+      function Alloc_Record is new Alloc_On_Pool_Addr (Record_Value);
+      subtype Data_Type is Value_Array (Nbr);
+      function Alloc_Data is new Alloc_On_Pool_Addr (Data_Type);
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := To_Iir_Value_Literal_Acc
+        (Alloc_Record (Pool, (Kind => Iir_Value_Record, Val_Record => null)));
+
+      Res.Val_Record := To_Value_Array_Acc
+        (Alloc_Data (Pool, Data_Type'(Len => Nbr, V => (others => null))));
+
+      return Res;
+   end Create_Record_Value;
+
+   -- Create a copy of SRC with a specified life.
+   function Copy (Src: in Iir_Value_Literal_Acc)
+                  return Iir_Value_Literal_Acc
+   is
+      Res: Iir_Value_Literal_Acc;
+   begin
+      case Src.Kind is
+         when Iir_Value_E32 =>
+            return Create_E32_Value (Src.E32);
+         when Iir_Value_I64 =>
+            return Create_I64_Value (Src.I64);
+         when Iir_Value_F64 =>
+            return Create_F64_Value (Src.F64);
+         when Iir_Value_B1 =>
+            return Create_B1_Value (Src.B1);
+         when Iir_Value_Access =>
+            return Create_Access_Value (Src.Val_Access);
+         when Iir_Value_Array =>
+            Res := Copy_Array_Bound (Src);
+            for I in Src.Val_Array.V'Range loop
+               Res.Val_Array.V (I) := Copy (Src.Val_Array.V (I));
+            end loop;
+            return Res;
+
+         when Iir_Value_Range =>
+            return Create_Range_Value
+              (Left => Copy (Src.Left),
+               Right => Copy (Src.Right),
+               Dir => Src.Dir,
+               Length => Src.Length);
+
+         when Iir_Value_Record =>
+            Res := Copy_Record (Src);
+            for I in Src.Val_Record.V'Range loop
+               Res.Val_Record.V (I) := Copy (Src.Val_Record.V (I));
+            end loop;
+            return Res;
+
+         when Iir_Value_File =>
+            return Create_File_Value (Src.File);
+         when Iir_Value_Protected =>
+            return Create_Protected_Value (Src.Prot);
+
+         when Iir_Value_Signal
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Copy;
+
+   function Copy_Array_Bound (Src : Iir_Value_Literal_Acc)
+                             return Iir_Value_Literal_Acc
+   is
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Res := Create_Array_Value (Src.Val_Array.Len, Src.Bounds.Nbr_Dims);
+      for I in Res.Bounds.D'Range loop
+         Res.Bounds.D (I) := Copy (Src.Bounds.D (I));
+      end loop;
+      return Res;
+   end Copy_Array_Bound;
+
+   function Copy_Record (Src : Iir_Value_Literal_Acc)
+                        return Iir_Value_Literal_Acc is
+   begin
+      return Create_Record_Value (Src.Val_Record.Len);
+   end Copy_Record;
+
+   function Unshare (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
+                    return Iir_Value_Literal_Acc
+   is
+      Prev_Pool : constant Areapool_Acc := Current_Pool;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      Current_Pool := Pool;
+      Res := Copy (Src);
+      Current_Pool := Prev_Pool;
+      return Res;
+   end Unshare;
+
+   function Unshare_Bounds (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
+                           return Iir_Value_Literal_Acc is
+   begin
+      if Src.Kind /= Iir_Value_Array then
+         return Src;
+      end if;
+      declare
+         Prev_Pool : constant Areapool_Acc := Current_Pool;
+         Res : Iir_Value_Literal_Acc;
+      begin
+         Current_Pool := Pool;
+         Res := Create_Array_Value (Src.Val_Array.Len, Src.Bounds.Nbr_Dims);
+         for I in Src.Bounds.D'Range loop
+            Res.Bounds.D (I) := Copy (Src.Bounds.D (I));
+         end loop;
+         Res.Val_Array.V := Src.Val_Array.V;
+         Current_Pool := Prev_Pool;
+         return Res;
+      end;
+   end Unshare_Bounds;
+
+   Heap_Pool : aliased Areapool;
+
+   function Unshare_Heap (Src : Iir_Value_Literal_Acc)
+                         return Iir_Value_Literal_Acc is
+   begin
+      --  FIXME: this is never free.
+      return Unshare (Src, Heap_Pool'Access);
+   end Unshare_Heap;
+
+   procedure Free_Heap_Value (Acc : Iir_Value_Literal_Acc) is
+   begin
+      null;
+   end Free_Heap_Value;
+
+   function Get_Nbr_Of_Scalars (Val : Iir_Value_Literal_Acc) return Natural is
+   begin
+      case Val.Kind is
+         when Iir_Value_Scalars
+           | Iir_Value_Access
+           | Iir_Value_Signal =>
+            return 1;
+         when Iir_Value_Record =>
+            declare
+               Total : Natural := 0;
+            begin
+               for I in Val.Val_Record.V'Range loop
+                  Total := Total + Get_Nbr_Of_Scalars (Val.Val_Record.V (I));
+               end loop;
+               return Total;
+            end;
+         when Iir_Value_Array =>
+            if Val.Val_Array.Len = 0 then
+               --  Nul array
+               return 0;
+            else
+               --  At least one element.
+               return Natural (Val.Val_Array.Len)
+                 * Get_Nbr_Of_Scalars (Val.Val_Array.V (1));
+            end if;
+         when Iir_Value_File
+           | Iir_Value_Range
+           | Iir_Value_Protected
+           | Iir_Value_Terminal
+           | Iir_Value_Quantity =>
+            raise Internal_Error;
+      end case;
+   end Get_Nbr_Of_Scalars;
+
+   function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural is
+   begin
+      case Val.Kind is
+         when Iir_Value_E32 =>
+            return Ghdl_E32'Pos (Val.E32);
+         when Iir_Value_B1 =>
+            return Ghdl_B1'Pos (Val.B1);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Enum_Pos;
+
+   procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc;
+                             Tab: Ada.Text_IO.Count)
+   is
+      use Ada.Text_IO;
+      use GNAT.Debug_Utilities;
+   begin
+      Set_Col (Tab);
+      if Value = null then
+         Put_Line ("*NULL*");
+         return;
+      end if;
+
+      if Boolean'(True) then
+         Put (Image (Value.all'Address) & ' ');
+      end if;
+
+      case Value.Kind is
+         when Iir_Value_B1 =>
+            Put_Line ("b1:" & Ghdl_B1'Image (Value.B1));
+         when Iir_Value_E32 =>
+            Put_Line ("e32:" & Ghdl_E32'Image (Value.E32));
+         when Iir_Value_I64 =>
+            Put_Line ("i64:" & Ghdl_I64'Image (Value.I64));
+         when Iir_Value_F64 =>
+            Put_Line ("F64:" & Ghdl_F64'Image (Value.F64));
+         when Iir_Value_Access =>
+            -- FIXME.
+            if Value.Val_Access = null then
+               Put_Line ("access: null");
+            else
+               Put ("access: ");
+               Put_Line (Image (Value.Val_Access.all'Address));
+            end if;
+         when Iir_Value_Array =>
+            if Value.Val_Array = null then
+               Put_Line ("array, without elements");
+               return;
+            else
+               Put_Line ("array, length: "
+                         & Iir_Index32'Image (Value.Val_Array.Len));
+               declare
+                  Ntab: constant Count := Tab + Indentation;
+               begin
+                  Set_Col (Ntab);
+                  if Value.Bounds /= null then
+                     Put_Line ("bounds 1 .."
+                               & Iir_Index32'Image (Value.Bounds.Nbr_Dims)
+                               & ':');
+                     for I in Value.Bounds.D'Range loop
+                        Disp_Value_Tab (Value.Bounds.D (I), Ntab);
+                     end loop;
+                  else
+                     Put_Line ("bounds = null");
+                  end if;
+                  Set_Col (Ntab);
+                  Put_Line ("values 1 .."
+                            & Iir_Index32'Image (Value.Val_Array.Len)
+                            & ':');
+                  for I in Value.Val_Array.V'Range loop
+                     Disp_Value_Tab (Value.Val_Array.V (I), Ntab);
+                  end loop;
+               end;
+            end if;
+
+         when Iir_Value_Range =>
+            Put_Line ("range:");
+            Set_Col (Tab);
+            Put (" direction: ");
+            Put (Iir_Direction'Image (Value.Dir));
+            Put (", length:");
+            Put_Line (Iir_Index32'Image (Value.Length));
+            if Value.Left /= null then
+               Set_Col (Tab);
+               Put (" left bound: ");
+               Disp_Value_Tab (Value.Left, Col);
+            end if;
+            if Value.Right /= null then
+               Set_Col (Tab);
+               Put (" right bound: ");
+               Disp_Value_Tab (Value.Right, Col);
+            end if;
+
+         when Iir_Value_Record =>
+            Put_Line ("record:");
+            for I in Value.Val_Record.V'Range loop
+               Disp_Value_Tab (Value.Val_Record.V (I), Tab + Indentation);
+            end loop;
+         when Iir_Value_Signal =>
+            Put ("signal: ");
+            if Value.Sig = null then
+               Put_Line ("(not created)");
+            else
+               Put_Line (Image (Value.Sig.all'Address));
+            end if;
+
+         when Iir_Value_File =>
+            Put_Line ("file:" & Grt.Files.Ghdl_File_Index'Image (Value.File));
+         when Iir_Value_Protected =>
+            Put_Line ("protected");
+         when Iir_Value_Quantity =>
+            Put_Line ("quantity");
+         when Iir_Value_Terminal =>
+            Put_Line ("terminal");
+      end case;
+   end Disp_Value_Tab;
+
+   procedure Disp_Value (Value: Iir_Value_Literal_Acc) is
+   begin
+      Disp_Value_Tab (Value, 1);
+   end Disp_Value;
+
+   --  Return TRUE if VALUE has an indirect value.
+   function Is_Indirect (Value : Iir_Value_Literal_Acc) return Boolean is
+   begin
+      case Value.Kind is
+         when Iir_Value_Scalars
+           | Iir_Value_Access
+           | Iir_Value_File
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            return False;
+         when Iir_Value_Range =>
+            return Is_Indirect (Value.Left)
+              or else Is_Indirect (Value.Right);
+         when Iir_Value_Array =>
+            for I in Value.Val_Array.V'Range loop
+               if Is_Indirect (Value.Val_Array.V (I)) then
+                  return True;
+               end if;
+            end loop;
+            return False;
+         when Iir_Value_Record =>
+            for I in Value.Val_Record.V'Range loop
+               if Is_Indirect (Value.Val_Record.V (I)) then
+                  return True;
+               end if;
+            end loop;
+            return False;
+         when Iir_Value_Signal =>
+            return True;
+      end case;
+   end Is_Indirect;
+
+   procedure Disp_Iir_Value_Array (Value: Iir_Value_Literal_Acc;
+                                   A_Type: Iir;
+                                   Dim: Iir_Index32;
+                                   Off : in out Iir_Index32)
+   is
+      use Ada.Text_IO;
+      type Last_Enum_Type is (None, Char, Identifier);
+      Last_Enum: Last_Enum_Type;
+      El_Type: Iir;
+      Enum_List: Iir_List;
+      El_Id : Name_Id;
+      El_Pos : Natural;
+   begin
+      if Dim = Value.Bounds.Nbr_Dims then
+         --  Last dimension
+         El_Type := Get_Base_Type (Get_Element_Subtype (A_Type));
+
+         --  Pretty print vectors of enumerated types
+         if Get_Kind (El_Type) = Iir_Kind_Enumeration_Type_Definition
+           and then not Is_Indirect (Value)
+         then
+            Last_Enum := None;
+            Enum_List := Get_Enumeration_Literal_List (El_Type);
+            for I in 1 .. Value.Bounds.D (Dim).Length loop
+               El_Pos := Get_Enum_Pos (Value.Val_Array.V (Off));
+               Off := Off + 1;
+               El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos));
+               if Name_Table.Is_Character (El_Id) then
+                  case Last_Enum is
+                     when None =>
+                        Put ("""");
+                     when Identifier =>
+                        Put (" & """);
+                     when Char =>
+                        null;
+                  end case;
+                  Put (Name_Table.Get_Character (El_Id));
+                  Last_Enum := Char;
+               else
+                  case Last_Enum is
+                     when None =>
+                        null;
+                     when Identifier =>
+                        Put (" & ");
+                     when Char =>
+                        Put (""" & ");
+                  end case;
+                  Put (Name_Table.Image (El_Id));
+                  Last_Enum := Identifier;
+               end if;
+            end loop;
+            case Last_Enum is
+               when None =>
+                  Put ("""");
+               when Identifier =>
+                  null;
+               when Char =>
+                  Put ("""");
+            end case;
+         else
+            Put ("(");
+            for I in 1 .. Value.Bounds.D (Dim).Length loop
+               if I /= 1 then
+                  Put (", ");
+               end if;
+               Disp_Iir_Value (Value.Val_Array.V (Off), El_Type);
+               Off := Off + 1;
+            end loop;
+            Put (")");
+         end if;
+      else
+         Put ("(");
+         for I in 1 .. Value.Bounds.D (Dim).Length loop
+            if I /= 1 then
+               Put (", ");
+            end if;
+            Disp_Iir_Value_Array (Value, A_Type, Dim + 1, Off);
+         end loop;
+         Put (")");
+      end if;
+   end Disp_Iir_Value_Array;
+
+   procedure Disp_Iir_Value_Record
+     (Value: Iir_Value_Literal_Acc; A_Type: Iir)
+   is
+      use Ada.Text_IO;
+      El : Iir_Element_Declaration;
+      List : Iir_List;
+   begin
+      List := Get_Elements_Declaration_List (Get_Base_Type (A_Type));
+      Put ("(");
+      for I in Value.Val_Record.V'Range loop
+         El := Get_Nth_Element (List, Natural (I - 1));
+         if I /= 1 then
+            Put (", ");
+         end if;
+         Put (Name_Table.Image (Get_Identifier (El)));
+         Put (" => ");
+         Disp_Iir_Value (Value.Val_Record.V (I), Get_Type (El));
+      end loop;
+      Put (")");
+   end Disp_Iir_Value_Record;
+
+   procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir) is
+      use Ada.Text_IO;
+   begin
+      if Value = null then
+         Put ("!NULL!");
+         return;
+      end if;
+      case Value.Kind is
+         when Iir_Value_I64 =>
+            Put (Ghdl_I64'Image (Value.I64));
+         when Iir_Value_F64 =>
+            Put (Ghdl_F64'Image (Value.F64));
+         when Iir_Value_E32
+           | Iir_Value_B1 =>
+            declare
+               Bt : constant Iir := Get_Base_Type (A_Type);
+               Id : Name_Id;
+               Pos : Integer;
+            begin
+               if Value.Kind = Iir_Value_E32 then
+                  Pos := Ghdl_E32'Pos (Value.E32);
+               else
+                  Pos := Ghdl_B1'Pos (Value.B1);
+               end if;
+               Id := Get_Identifier
+                 (Get_Nth_Element (Get_Enumeration_Literal_List (Bt), Pos));
+               Put (Name_Table.Image (Id));
+            end;
+         when Iir_Value_Access =>
+            if Value.Val_Access = null then
+               Put ("null");
+            else
+               -- FIXME.
+               Put ("*acc*");
+            end if;
+         when Iir_Value_Array =>
+            declare
+               Off : Iir_Index32;
+            begin
+               Off := 1;
+               Disp_Iir_Value_Array (Value, A_Type, 1, Off);
+               pragma Assert (Off = Value.Val_Array.Len + 1);
+            end;
+         when Iir_Value_File =>
+            raise Internal_Error;
+         when Iir_Value_Record =>
+            Disp_Iir_Value_Record (Value, A_Type);
+         when Iir_Value_Range =>
+            -- FIXME.
+            raise Internal_Error;
+         when Iir_Value_Quantity =>
+            Put ("[quantity]");
+         when Iir_Value_Terminal =>
+            Put ("[terminal]");
+         when Iir_Value_Signal =>
+            Put ("[signal]");
+         when Iir_Value_Protected =>
+            Put ("[protected]");
+      end case;
+   end Disp_Iir_Value;
+end Iir_Values;
diff --git a/src/simulate/iir_values.ads b/src/simulate/iir_values.ads
new file mode 100644
index 000000000..699ab883a
--- /dev/null
+++ b/src/simulate/iir_values.ads
@@ -0,0 +1,355 @@
+--  Naive values for interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Text_IO;
+with Types; use Types;
+with Iirs; use Iirs;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with Grt.Files;
+with Areapools; use Areapools;
+-- with System.Debug_Pools;
+
+package Iir_Values is
+   -- During simulation, all values are contained into objects of type
+   -- iir_value_literal.  The annotation pass creates such objects for every
+   -- literal of units.  The elaboration pass creates such objects for
+   -- signals, variables, contants...
+   -- The simulator uses iir_value_literal for intermediate results, for
+   -- computed values...
+
+   -- There is several kinds of iir_value_literal, mainly depending on the
+   -- type of the value:
+   --
+   -- iir_value_e32:
+   --  the value is an enumeration literal.  The enum field contains the
+   --  position of the literal (same as 'pos).
+   --
+   -- iir_value_i64:
+   --  the value is an integer.
+   --
+   -- iir_value_f64:
+   --  the value is a floating point.
+   --
+   -- iir_value_range:
+   --  Boundaries and direction.
+   --
+   -- iir_value_array:
+   --  All the values are contained in the array Val_Array.
+   --  Boundaries of the array are contained in the array BOUNDS, one element
+   --  per dimension, from 1 to number of dimensions.
+   --
+   -- iir_value_signal:
+   --  Special case: the iir_value_literal designates a signal.
+   --
+   -- iir_value_record
+   --  For records.
+   --
+   -- iir_value_access
+   --  for accesses.
+   --
+   -- iir_value_file
+   --  for files.
+
+   --  Memory management:
+   --  The values are always allocated on areapool, which uses a mark/release
+   --  management. A release operation frees all the memory of the areapool
+   --  allocated since the mark. This memory management is very efficient.
+   --
+   --  There is one areapool per processes; there is one mark per instances.
+   --  Objects (variables, signals, constants, iterators, ...) are allocated
+   --  on the per-process pool.  When an activation frame is created (due
+   --  to a call to a subprogram), a mark is saved. When the activation frame
+   --  is removed (due to a return from subprogram), the memory is released to
+   --  the mark. That's simple.
+   --
+   --  Objects for the process is allocated in that areapool, but never
+   --  released (could be if the process is waiting forever if the user don't
+   --  need to inspect values).
+   --
+   --  Signals and constants for blocks/entity/architecture are allocated on
+   --  a global pool.
+   --
+   --  In fact this is not so simple because of functions: they return a
+   --  value.  The current solution is to compute every expressions on a
+   --  expression pool (only one is needed as the computation cannot be
+   --  suspended), use the result (copy in case of assignment or return), and
+   --  release that pool.
+   --
+   --  It is highly recommended to share values as much as possible for
+   --  expressions (for example, alias the values of 'others =>'). Do not
+   --  share values for names, but be sure to keep the original nodes.
+   --  ??? In fact sharing is required to pass actual by references.
+   --  When an object is created, be sure to unshare the values.  This is
+   --  usually achieved by Copy.
+   --
+   --  Finally, a pool is also needed during elaboration (as elaboration is
+   --  not done within the context of a process).
+
+   type Iir_Value_Kind is
+     (Iir_Value_B1, Iir_Value_E32,
+      Iir_Value_I64, Iir_Value_F64,
+      Iir_Value_Access,
+      Iir_Value_File,
+      Iir_Value_Range,
+      Iir_Value_Array, Iir_Value_Record,
+      Iir_Value_Protected,
+      Iir_Value_Signal,
+      Iir_Value_Terminal,
+      Iir_Value_Quantity);
+
+   type Protected_Index_Type is new Natural;
+
+   type Quantity_Index_Type is new Natural;
+   type Terminal_Index_Type is new Natural;
+
+   --  Scalar values.  Only these ones can be signals.
+   subtype Iir_Value_Scalars is
+     Iir_Value_Kind range Iir_Value_B1 .. Iir_Value_F64;
+
+   type Iir_Value_Literal (Kind: Iir_Value_Kind);
+
+   type Iir_Value_Literal_Acc is access Iir_Value_Literal;
+
+   -- Must start at 0.
+   -- Thus, length of the array is val_array'last - 1.
+   type Iir_Value_Literal_Array is array (Iir_Index32 range <>) of
+     Iir_Value_Literal_Acc;
+
+   type Iir_Value_Literal_Array_Acc is access Iir_Value_Literal_Array;
+
+   type Value_Bounds_Array (Nbr_Dims : Iir_Index32) is record
+      D : Iir_Value_Literal_Array (1 .. Nbr_Dims);
+   end record;
+
+   type Value_Bounds_Array_Acc is access Value_Bounds_Array;
+
+   type Value_Array (Len : Iir_Index32) is record
+      V : Iir_Value_Literal_Array (1 .. Len);
+   end record;
+
+   type Value_Array_Acc is access Value_Array;
+
+   type Iir_Value_Literal (Kind: Iir_Value_Kind) is record
+      case Kind is
+         when Iir_Value_B1 =>
+            B1 : Ghdl_B1;
+         when Iir_Value_E32 =>
+            E32 : Ghdl_E32;
+         when Iir_Value_I64 =>
+            I64 : Ghdl_I64;
+         when Iir_Value_F64 =>
+            F64 : Ghdl_F64;
+         when Iir_Value_Access =>
+            Val_Access: Iir_Value_Literal_Acc;
+         when Iir_Value_File =>
+            File: Grt.Files.Ghdl_File_Index;
+         when Iir_Value_Array =>
+            Val_Array: Value_Array_Acc; --  range 1 .. N
+            Bounds : Value_Bounds_Array_Acc;   --  range 1 .. Dim
+         when Iir_Value_Record =>
+            Val_Record: Value_Array_Acc; -- range 1 .. N
+         when Iir_Value_Signal =>
+            Sig : Ghdl_Signal_Ptr;
+         when Iir_Value_Protected =>
+            Prot : Protected_Index_Type;
+         when Iir_Value_Quantity =>
+            Quantity : Quantity_Index_Type;
+         when Iir_Value_Terminal =>
+            Terminal : Terminal_Index_Type;
+         when Iir_Value_Range =>
+            Dir: Iir_Direction;
+            Length : Iir_Index32;
+            Left: Iir_Value_Literal_Acc;
+            Right: Iir_Value_Literal_Acc;
+      end case;
+   end record;
+
+   -- What is chosen for time.
+   -- Currently only int32 is available, but time should use an int64.
+   subtype Iir_Value_Time is Ghdl_I64;
+
+   Global_Pool : aliased Areapool;
+   Expr_Pool : aliased Areapool;
+
+   --  Areapool used by Create_*_Value
+   Current_Pool : Areapool_Acc := Expr_Pool'Access;
+
+   --  Pool for objects allocated in the current instance.
+   Instance_Pool : Areapool_Acc;
+
+   function Create_Signal_Value (Sig : Ghdl_Signal_Ptr)
+     return Iir_Value_Literal_Acc;
+
+   function Create_Terminal_Value (Terminal : Terminal_Index_Type)
+                                  return Iir_Value_Literal_Acc;
+
+   function Create_Quantity_Value (Quantity : Quantity_Index_Type)
+                                  return Iir_Value_Literal_Acc;
+
+   function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc;
+
+   function Create_E32_Value (Val : Ghdl_E32) return Iir_Value_Literal_Acc;
+
+   -- Return an iir_value_literal_acc (iir_value_int64).
+   function Create_I64_Value (Val : Ghdl_I64) return Iir_Value_Literal_Acc;
+
+   --  Return an iir_value_literal_acc (iir_value_fp64)
+   function Create_F64_Value (Val : Ghdl_F64) return Iir_Value_Literal_Acc;
+
+   function Create_Access_Value (Val : Iir_Value_Literal_Acc)
+                                return Iir_Value_Literal_Acc;
+
+   function Create_File_Value (Val : Grt.Files.Ghdl_File_Index)
+                              return Iir_Value_Literal_Acc;
+
+   function Create_Protected_Value (Prot : Protected_Index_Type)
+                                   return Iir_Value_Literal_Acc;
+
+   -- Return an iir_value_literal (iir_value_record) of NBR elements.
+   function Create_Record_Value
+     (Nbr : Iir_Index32; Pool : Areapool_Acc := Current_Pool)
+     return Iir_Value_Literal_Acc;
+
+   --  Allocate array and the dimension vector (but bounds and values aren't
+   --  allocated).
+   function Create_Array_Value (Dim : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool)
+                               return Iir_Value_Literal_Acc;
+
+   --  Allocate the Val_Array vector.
+   procedure Create_Array_Data (Arr : Iir_Value_Literal_Acc;
+                                Len : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool);
+
+   -- Return an array of length LENGTH and DIM bounds.
+   -- If DIM is 0, then the bounds array is not allocated.
+   function Create_Array_Value (Length: Iir_Index32;
+                                Dim : Iir_Index32;
+                                Pool : Areapool_Acc := Current_Pool)
+                               return Iir_Value_Literal_Acc;
+
+   --  Create a range_value of life LIFE.
+   function Create_Range_Value
+     (Left, Right : Iir_Value_Literal_Acc;
+      Dir : Iir_Direction;
+      Length : Iir_Index32)
+     return Iir_Value_Literal_Acc;
+
+   --  Create a range_value (compute the length)
+   function Create_Range_Value
+     (Left, Right : Iir_Value_Literal_Acc;
+      Dir : Iir_Direction)
+      return Iir_Value_Literal_Acc;
+
+   -- Return true if the value of LEFT and RIGHT are equal.
+   -- Return false if they are not equal.
+   -- Raise constraint_error if the types differes.
+   -- Value or sub-value must not be indirect.
+   function Is_Equal (Left, Right: Iir_Value_Literal_Acc) return Boolean;
+
+   --  Return TRUE iif ARANGE is a nul range.
+   function Is_Nul_Range (Arange : Iir_Value_Literal_Acc) return Boolean;
+
+   -- Get order of LEFT with RIGHT.
+   -- Must be discrete kind (enum, int, fp, physical) or array (uni dim).
+   type Order is (Less, Equal, Greater);
+   function Compare_Value (Left, Right : Iir_Value_Literal_Acc)
+                           return Order;
+
+   --  Check that SRC has the same structure as DEST.  Report an error at
+   --  LOC if not.
+   procedure Check_Bounds (Dest : Iir_Value_Literal_Acc;
+                           Src : Iir_Value_Literal_Acc;
+                           Loc : Iir);
+
+   -- Store (by copy) SRC into DEST.
+   -- The type must be equal (otherwise  constraint_error is raised).
+   -- Life of DEST must be Target, otherwise program_error is raised.
+   -- Value or sub-value must not be indirect.
+   procedure Store (Dest : Iir_Value_Literal_Acc; Src : Iir_Value_Literal_Acc);
+
+   --  Create a copy of SRC allocated in POOL.
+   function Unshare (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
+                    return Iir_Value_Literal_Acc;
+
+   --  If SRC is an array, just copy the bounds in POOL and return it.
+   --  Otherwise return SRC.  Values are always kept, so that this could
+   --  be used by alias declarations.
+   function Unshare_Bounds (Src : Iir_Value_Literal_Acc; Pool : Areapool_Acc)
+                           return Iir_Value_Literal_Acc;
+
+   --  Create a copy of SRC on the heap.
+   function Unshare_Heap (Src : Iir_Value_Literal_Acc)
+                         return Iir_Value_Literal_Acc;
+
+   --  Deallocate value accessed by ACC.
+   procedure Free_Heap_Value (Acc : Iir_Value_Literal_Acc);
+
+   --  Increment.
+   --  VAL must be of kind integer or enumeration.
+   --  VAL must be of life temporary.
+   procedure Increment (Val : Iir_Value_Literal_Acc);
+
+   --  Copy BOUNDS of SRC with a specified life.
+   --  Note: val_array is allocated but not filled.
+   function Copy_Array_Bound (Src : Iir_Value_Literal_Acc)
+                             return Iir_Value_Literal_Acc;
+
+   --  Copy the bounds (well the array containing the values) of SRC.
+   --  Val_record is allocated but not filled.
+   function Copy_Record (Src : Iir_Value_Literal_Acc)
+                        return Iir_Value_Literal_Acc;
+
+   --  Return the number of scalars elements in VALS.
+   function Get_Nbr_Of_Scalars (Val : Iir_Value_Literal_Acc) return Natural;
+
+   --  Return the position of an enumerated type value.
+   function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural;
+
+   -- Well known values.
+   -- Boolean_to_lit can be used to convert a boolean value from Ada to a
+   -- boolean value for vhdl.
+   type Lit_Enum_Type is array (Boolean) of Iir_Value_Literal_Acc;
+   Lit_Enum_0 : constant Iir_Value_Literal_Acc :=
+     new Iir_Value_Literal'(Kind => Iir_Value_B1,
+                            B1 => False);
+   Lit_Enum_1 : constant Iir_Value_Literal_Acc :=
+     new Iir_Value_Literal'(Kind => Iir_Value_B1,
+                            B1 => True);
+   Boolean_To_Lit: constant Lit_Enum_Type :=
+     (False => Lit_Enum_0, True => Lit_Enum_1);
+   Lit_Boolean_False: Iir_Value_Literal_Acc
+     renames Boolean_To_Lit (False);
+   Lit_Boolean_True: Iir_Value_Literal_Acc
+     renames Boolean_To_Lit (True);
+
+   -- Literal NULL.
+   Null_Lit: constant Iir_Value_Literal_Acc :=
+     new Iir_Value_Literal'(Kind => Iir_Value_Access,
+                            Val_Access => null);
+
+   -- Disp a value_literal in raw form.
+   procedure Disp_Value (Value: Iir_Value_Literal_Acc);
+   procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc;
+                             Tab: Ada.Text_IO.Count);
+
+   -- Disp a value_literal in readable form.
+   procedure Disp_Iir_Value (Value: Iir_Value_Literal_Acc; A_Type: Iir);
+end Iir_Values;
+
diff --git a/src/simulate/sim_be.adb b/src/simulate/sim_be.adb
new file mode 100644
index 000000000..49a146879
--- /dev/null
+++ b/src/simulate/sim_be.adb
@@ -0,0 +1,117 @@
+--  Interpreter back-end
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Text_IO;
+with Sem;
+with Canon;
+with Annotations;
+with Disp_Tree;
+with Errorout; use Errorout;
+with Flags;
+with Disp_Vhdl;
+with Post_Sems;
+
+package body Sim_Be is
+   procedure Finish_Compilation (Unit: Iir_Design_Unit; Main: Boolean := False)
+   is
+      use Ada.Text_IO;
+      Lib_Unit : Iir;
+   begin
+      Lib_Unit := Get_Library_Unit (Unit);
+      -- Semantic analysis.
+      if Flags.Verbose then
+         Put_Line ("semantize " & Disp_Node (Lib_Unit));
+      end if;
+      Sem.Semantic (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Sem then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Sem then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      --  Post checks
+      ----------------
+
+      Post_Sems.Post_Sem_Checks (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+
+      -- Canonicalisation.
+      ------------------
+      if Flags.Verbose then
+         Put_Line ("canonicalize " & Disp_Node (Lib_Unit));
+      end if;
+
+      Canon.Canonicalize (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Canon then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      if Flags.Flag_Elaborate then
+         if Get_Kind (Lib_Unit) = Iir_Kind_Architecture_Body then
+            declare
+               Config : Iir_Design_Unit;
+            begin
+               Config := Canon.Create_Default_Configuration_Declaration
+                 (Lib_Unit);
+               Set_Default_Configuration_Declaration (Lib_Unit, Config);
+               if (Main or Flags.Dump_All) and then Flags.Dump_Canon then
+                  Disp_Tree.Disp_Tree (Config);
+               end if;
+               if (Main or Flags.List_All) and then Flags.List_Canon then
+                  Disp_Vhdl.Disp_Vhdl (Config);
+               end if;
+            end;
+         end if;
+      end if;
+
+      -- Annotation.
+      -------------
+      if Flags.Verbose then
+         Put_Line ("annotate " & Disp_Node (Lib_Unit));
+      end if;
+
+      Annotations.Annotate (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Annotate then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+      if (Main or Flags.Dump_All) and then Flags.Dump_Annotate then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+   end Finish_Compilation;
+end Sim_Be;
diff --git a/src/simulate/sim_be.ads b/src/simulate/sim_be.ads
new file mode 100644
index 000000000..9256c4b68
--- /dev/null
+++ b/src/simulate/sim_be.ads
@@ -0,0 +1,25 @@
+--  Interpreter back-end
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Iirs; use Iirs;
+
+package Sim_Be is
+   procedure Finish_Compilation
+     (Unit: Iir_Design_Unit; Main: Boolean := False);
+end Sim_Be;
+
diff --git a/src/simulate/simulation-ams-debugger.adb b/src/simulate/simulation-ams-debugger.adb
new file mode 100644
index 000000000..9cdbc75b2
--- /dev/null
+++ b/src/simulate/simulation-ams-debugger.adb
@@ -0,0 +1,87 @@
+--  Interpreter AMS simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Debugger; use Debugger;
+with Iirs_Utils; use Iirs_Utils;
+with Ada.Text_IO; use Ada.Text_IO;
+with Disp_Vhdl;
+
+package body Simulation.AMS.Debugger is
+   procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type)
+   is
+      Obj : Scalar_Quantity renames Scalar_Quantities.Table (Quantity);
+   begin
+      Disp_Instance_Name (Obj.Instance, True);
+      Put ('.');
+      Put (Image_Identifier (Obj.Decl));
+      if Obj.Kind = Quantity_Reference then
+         Put ("'Ref");
+      end if;
+   end Disp_Quantity_Name;
+
+   procedure Disp_Term (Term : Ams_Term_Acc) is
+   begin
+      case Term.Sign is
+         when Op_Plus =>
+            Put (" + ");
+         when Op_Minus =>
+            Put (" - ");
+      end case;
+
+      case Term.Op is
+         when Op_Quantity =>
+            Disp_Quantity_Name (Term.Quantity);
+         when Op_Vhdl_Expr =>
+            Disp_Vhdl.Disp_Expression (Term.Vhdl_Expr);
+      end case;
+   end Disp_Term;
+
+   procedure Disp_Characteristic_Expression
+     (Ce : Characteristic_Expressions_Index)
+   is
+      Obj : Characteristic_Expr renames
+        Characteristic_Expressions.Table (Ce);
+      Expr : Ams_Term_Acc := Obj.Expr;
+   begin
+      case Obj.Kind is
+         when Explicit =>
+            Put ("Explic:");
+         when Contribution =>
+            Put ("Contri:");
+         when Structural =>
+            Put ("Struct:");
+      end case;
+
+      while Expr /= null loop
+         Disp_Term (Expr);
+         Expr := Expr.Next;
+      end loop;
+      New_Line;
+   end Disp_Characteristic_Expression;
+
+   procedure Disp_Characteristic_Expressions is
+   begin
+      Put_Line ("Characteristic expressions:");
+      for I in Characteristic_Expressions.First
+        .. Characteristic_Expressions.Last
+      loop
+         Disp_Characteristic_Expression (I);
+      end loop;
+   end Disp_Characteristic_Expressions;
+end Simulation.AMS.Debugger;
+
diff --git a/src/simulate/simulation-ams-debugger.ads b/src/simulate/simulation-ams-debugger.ads
new file mode 100644
index 000000000..0cfcdedc7
--- /dev/null
+++ b/src/simulate/simulation-ams-debugger.ads
@@ -0,0 +1,27 @@
+--  Interpreter AMS simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Simulation.AMS.Debugger is
+   procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type);
+
+   procedure Disp_Characteristic_Expression
+     (Ce : Characteristic_Expressions_Index);
+
+   procedure Disp_Characteristic_Expressions;
+end Simulation.AMS.Debugger;
+
diff --git a/src/simulate/simulation-ams.adb b/src/simulate/simulation-ams.adb
new file mode 100644
index 000000000..31dd43e0e
--- /dev/null
+++ b/src/simulate/simulation-ams.adb
@@ -0,0 +1,201 @@
+--  Interpreter AMS simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Errorout; use Errorout;
+
+package body Simulation.AMS is
+   function Create_Characteristic_Expression
+     (Kind : Characteristic_Expr_Kind)
+     return Characteristic_Expressions_Index
+   is
+   begin
+      case Kind is
+         when Contribution =>
+            Characteristic_Expressions.Append
+              ((Kind => Contribution,
+                Expr => null,
+                Tolerance => 0,
+                Dependencies => null));
+         when others =>
+            raise Program_Error;
+      end case;
+      return Characteristic_Expressions.Last;
+   end Create_Characteristic_Expression;
+
+   function Create_Scalar_Quantity (Kind : Quantity_Kind;
+                                    Decl : Iir;
+                                    Instance : Block_Instance_Acc)
+                                   return Quantity_Index_Type
+   is
+   begin
+      case Kind is
+         when Quantity_Reference =>
+            Scalar_Quantities.Append
+              ((Kind => Quantity_Reference,
+                Value => 0.0,
+                Decl => Decl,
+                Instance => Instance,
+                Contribution =>
+                  Create_Characteristic_Expression (Contribution)));
+         when Quantity_Across =>
+            Scalar_Quantities.Append
+              ((Kind => Quantity_Across,
+                Value => 0.0,
+                Decl => Decl,
+                Instance => Instance));
+         when Quantity_Through =>
+            Scalar_Quantities.Append
+              ((Kind => Quantity_Through,
+                Value => 0.0,
+                Decl => Decl,
+                Instance => Instance));
+         when others =>
+            raise Program_Error;
+      end case;
+      return Scalar_Quantities.Last;
+   end Create_Scalar_Quantity;
+
+   function Create_Scalar_Terminal (Decl : Iir;
+                                    Instance : Block_Instance_Acc)
+                                   return Terminal_Index_Type
+   is
+   begin
+      --  Simply create the reference quantity for a terminal
+      return Terminal_Index_Type
+        (Create_Scalar_Quantity (Quantity_Reference, Decl, Instance));
+   end Create_Scalar_Terminal;
+
+   function Get_Terminal_Reference (Terminal : Terminal_Index_Type)
+                                   return Quantity_Index_Type is
+   begin
+      return Quantity_Index_Type (Terminal);
+   end Get_Terminal_Reference;
+
+   procedure Add_Characteristic_Expression
+     (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc)
+   is
+   begin
+      Characteristic_Expressions.Append
+        ((Kind => Kind,
+          Expr => Expr,
+          Tolerance => Default_Tolerance_Index,
+          Dependencies => null));
+   end Add_Characteristic_Expression;
+
+   procedure Compute_Dependencies (Idx : Characteristic_Expressions_Index)
+   is
+      package Quantity_Table is new GNAT.Table
+        (Table_Component_Type => Quantity_Index_Type,
+         Table_Index_Type => Natural,
+         Table_Low_Bound => 1,
+         Table_Initial => 16,
+         Table_Increment => 100);
+
+      El : Characteristic_Expr renames Characteristic_Expressions.Table (Idx);
+      Res : Quantity_Dependency_Acc := null;
+
+      procedure Add_Dependency (Block : Block_Instance_Acc; N : Iir)
+      is
+         Q : Iir_Value_Literal_Acc;
+      begin
+         case Get_Kind (N) is
+            when Iir_Kinds_Branch_Quantity_Declaration =>
+               Q := Execute_Name (Block, N, True);
+               Quantity_Table.Append (Q.Quantity);
+            when Iir_Kind_Simple_Name =>
+               Add_Dependency (Block, Get_Named_Entity (N));
+            when Iir_Kinds_Dyadic_Operator =>
+               Add_Dependency (Block, Get_Left (N));
+               Add_Dependency (Block, Get_Right (N));
+            when Iir_Kinds_Literal =>
+               null;
+            when others =>
+               Error_Kind ("compute_dependencies", N);
+         end case;
+      end Add_Dependency;
+
+      Term : Ams_Term_Acc := El.Expr;
+   begin
+      pragma Assert (El.Dependencies = null);
+
+      while Term /= null loop
+         case Term.Op is
+            when Op_Quantity =>
+               Quantity_Table.Append (Term.Quantity);
+            when Op_Vhdl_Expr =>
+               Add_Dependency (Term.Vhdl_Instance, Term.Vhdl_Expr);
+         end case;
+         Term := Term.Next;
+      end loop;
+      Res := new Quantity_Dependency_Type (Nbr => Quantity_Table.Last);
+      for I in Quantity_Table.First .. Quantity_Table.Last loop
+         Res.Quantities (I) := Quantity_Table.Table (I);
+      end loop;
+      Quantity_Table.Free;
+      El.Dependencies := Res;
+   end Compute_Dependencies;
+
+   function Build (Op : Ams_Sign;
+                   Val : Quantity_Index_Type;
+                   Right : Ams_Term_Acc := null)
+                  return Ams_Term_Acc
+   is
+   begin
+      return new Ams_Term'(Op => Op_Quantity,
+                           Sign => Op,
+                           Next => Right,
+                           Quantity => Val);
+   end Build;
+
+   function Build (Op : Ams_Sign;
+                   Instance : Block_Instance_Acc;
+                   Expr : Iir;
+                   Right : Ams_Term_Acc := null)
+                  return Ams_Term_Acc
+   is
+   begin
+      return new Ams_Term'
+        (Op => Op_Vhdl_Expr,
+         Sign => Op,
+         Vhdl_Expr => Expr,
+         Vhdl_Instance => Instance,
+         Next => Right);
+   end Build;
+
+   procedure Append_Characteristic_Expression
+     (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc)
+   is
+      Ref : constant Quantity_Index_Type := Get_Terminal_Reference (Terminal);
+      Ce : constant Characteristic_Expressions_Index :=
+        Scalar_Quantities.Table (Ref).Contribution;
+   begin
+      pragma Assert (Expr.Next = null);
+      Expr.Next := Characteristic_Expressions.Table (Ce).Expr;
+      Characteristic_Expressions.Table (Ce).Expr := Expr;
+   end Append_Characteristic_Expression;
+
+   procedure Create_Tables is
+   begin
+      for I in Characteristic_Expressions.First
+        .. Characteristic_Expressions.Last
+      loop
+         Compute_Dependencies (I);
+      end loop;
+   end Create_Tables;
+end Simulation.AMS;
+
diff --git a/src/simulate/simulation-ams.ads b/src/simulate/simulation-ams.ads
new file mode 100644
index 000000000..8ca513652
--- /dev/null
+++ b/src/simulate/simulation-ams.ads
@@ -0,0 +1,165 @@
+--  Interpreter AMS simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with GNAT.Table;
+
+package Simulation.AMS is
+   --  AMS expressions
+   --
+   --  At many places during elaboration, the LRM defines characteristic
+   --  expressions that aren't present in source code:
+   --  * contribution expression (12.3.1.4)
+   --  * characteristic expression for an across quantity declaration
+   --    (12.3.1.4)
+   --  * characteristic expression for simple simultaneous statement (the
+   --    expression is in the source in that case) (15.1)
+   --
+   --  They are represented using a list of Ams_Expression elements.  The value
+   --  is the sum of each element, using the + or - sign.
+
+   type Ams_Sign is (Op_Plus, Op_Minus);
+   --  Sign for the operand
+
+   type Ams_Operand is (Op_Quantity, Op_Vhdl_Expr);
+   --  The operand is one of:
+   --  Op_Quantity: a quantity
+   --  Op_Vhdl_Expr: an expression from the design. This expression may contain
+   --   quantities
+
+   type Ams_Term (<>) is private;
+   type Ams_Term_Acc is access Ams_Term;
+   --  A term of a characteristic expression
+
+   type Characteristic_Expr_Kind is
+     (Explicit,
+      Contribution,
+      Structural);
+
+   type Tolerance_Index_Type is new Natural;
+   Default_Tolerance_Index : constant Tolerance_Index_Type := 0;
+   --  Tolerance
+
+   type Characteristic_Expressions_Index is new Natural;
+
+   type Quantity_Kind is
+     (Quantity_Reference,
+      --  The potential of a terminal. This is an across quantity between the
+      --  terminal and the reference terminal of the nature.
+
+      Quantity_Across,
+      Quantity_Through,
+      Quantity_Free
+      --  Explicitly declared quantities
+     );
+
+   function Create_Scalar_Quantity (Kind : Quantity_Kind;
+                                    Decl : Iir;
+                                    Instance : Block_Instance_Acc)
+                                   return Quantity_Index_Type;
+   --  Create a new scalar quantity
+
+   function Create_Scalar_Terminal (Decl : Iir;
+                                    Instance : Block_Instance_Acc)
+                                   return Terminal_Index_Type;
+   --  Create a new scalar terminal
+
+   function Get_Terminal_Reference (Terminal : Terminal_Index_Type)
+                                   return Quantity_Index_Type;
+   --  Get the reference quantity of a terminal
+
+   procedure Add_Characteristic_Expression
+     (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc);
+   --  Add a new characteristic expression
+
+   function Build (Op : Ams_Sign;
+                   Val : Quantity_Index_Type;
+                   Right : Ams_Term_Acc := null)
+                  return Ams_Term_Acc;
+   function Build (Op : Ams_Sign;
+                   Instance : Block_Instance_Acc;
+                   Expr : Iir;
+                   Right : Ams_Term_Acc := null)
+                  return Ams_Term_Acc;
+   --  Build a term of a characteristic expression
+
+   procedure Append_Characteristic_Expression
+     (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc);
+   --  Append an expression to the contribution of a terminal
+
+   procedure Create_Tables;
+private
+   type Quantity_Index_Array is array (Positive range <>)
+     of Quantity_Index_Type;
+
+   type Quantity_Dependency_Type (Nbr : Natural);
+   type Quantity_Dependency_Acc is access Quantity_Dependency_Type;
+
+   type Quantity_Dependency_Type (Nbr : Natural) is record
+      Quantities : Quantity_Index_Array (1 .. Nbr);
+   end record;
+
+   type Ams_Term (Op : Ams_Operand) is record
+      Sign : Ams_Sign;
+      Next : Ams_Term_Acc;
+
+      case Op is
+         when Op_Quantity =>
+            Quantity : Quantity_Index_Type;
+         when Op_Vhdl_Expr =>
+            Vhdl_Expr : Iir;
+            Vhdl_Instance : Block_Instance_Acc;
+      end case;
+   end record;
+
+   type Characteristic_Expr is record
+      Kind : Characteristic_Expr_Kind;
+      Expr : Ams_Term_Acc;
+      Tolerance : Tolerance_Index_Type;
+      Dependencies : Quantity_Dependency_Acc;
+   end record;
+
+   package Characteristic_Expressions is new Gnat.Table
+     (Table_Index_Type => Characteristic_Expressions_Index,
+      Table_Component_Type => Characteristic_Expr,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   type Scalar_Quantity (Kind : Quantity_Kind := Quantity_Reference) is record
+      Value : Ghdl_F64;
+      --  The value of the quantity
+
+      Decl : Iir;
+      Instance : Block_Instance_Acc;
+      --  Declaration for the quantity
+
+      case Kind is
+         when Quantity_Reference =>
+            Contribution : Characteristic_Expressions_Index;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   package Scalar_Quantities is new Gnat.Table
+     (Table_Index_Type => Quantity_Index_Type,
+      Table_Component_Type => Scalar_Quantity,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+end Simulation.AMS;
diff --git a/src/simulate/simulation.adb b/src/simulate/simulation.adb
new file mode 100644
index 000000000..3f3f8715b
--- /dev/null
+++ b/src/simulate/simulation.adb
@@ -0,0 +1,1669 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Conversion;
+with Ada.Text_IO; use Ada.Text_IO;
+with Errorout; use Errorout;
+with Iirs_Utils; use Iirs_Utils;
+with Trans_Analyzes;
+with Types; use Types;
+with Debugger; use Debugger;
+with Simulation.AMS.Debugger;
+with Areapools; use Areapools;
+with Grt.Stacks;
+with Grt.Signals;
+with Grt.Processes;
+with Grt.Main;
+with Grt.Errors;
+with Grt.Rtis;
+
+package body Simulation is
+
+   function Value_To_Iir_Value (Mode : Mode_Type; Val : Value_Union)
+                               return Iir_Value_Literal_Acc is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            return Create_B1_Value (Val.B1);
+         when Mode_E32 =>
+            return Create_E32_Value (Val.E32);
+         when Mode_I64 =>
+            return Create_I64_Value (Val.I64);
+         when Mode_F64 =>
+            return Create_F64_Value (Val.F64);
+         when others =>
+            raise Internal_Error;  -- FIXME
+      end case;
+   end Value_To_Iir_Value;
+
+   procedure Iir_Value_To_Value (Src : Iir_Value_Literal_Acc;
+                                 Dst : out Value_Union) is
+   begin
+      case Src.Kind is
+         when Iir_Value_B1 =>
+            Dst.B1 := Src.B1;
+         when Iir_Value_E32 =>
+            Dst.E32 := Src.E32;
+         when Iir_Value_I64 =>
+            Dst.I64 := Src.I64;
+         when Iir_Value_F64 =>
+            Dst.F64 := Src.F64;
+         when others =>
+            raise Internal_Error;  -- FIXME
+      end case;
+   end Iir_Value_To_Value;
+
+   type Read_Signal_Flag_Enum is
+     (Read_Signal_Event,
+      Read_Signal_Active,
+      --  In order to reuse the same code (that returns immediately if the
+      --  attribute is true), we use not driving.
+      Read_Signal_Not_Driving);
+
+   function Read_Signal_Flag (Lit: Iir_Value_Literal_Acc;
+                              Kind : Read_Signal_Flag_Enum)
+                             return Boolean
+   is
+   begin
+      case Lit.Kind is
+         when Iir_Value_Array =>
+            for I in Lit.Val_Array.V'Range loop
+               if Read_Signal_Flag (Lit.Val_Array.V (I), Kind) then
+                  return True;
+               end if;
+            end loop;
+            return False;
+         when Iir_Value_Record =>
+            for I in Lit.Val_Record.V'Range loop
+               if Read_Signal_Flag (Lit.Val_Record.V (I), Kind) then
+                  return True;
+               end if;
+            end loop;
+            return False;
+         when Iir_Value_Signal =>
+            case Kind is
+               when Read_Signal_Event =>
+                  return Lit.Sig.Event;
+               when Read_Signal_Active =>
+                  return Lit.Sig.Active;
+               when Read_Signal_Not_Driving =>
+                  if Grt.Signals.Ghdl_Signal_Driving (Lit.Sig) = True then
+                     return False;
+                  else
+                     return True;
+                  end if;
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Read_Signal_Flag;
+
+   function Execute_Event_Attribute (Lit: Iir_Value_Literal_Acc)
+                                    return Boolean is
+   begin
+      return Read_Signal_Flag (Lit, Read_Signal_Event);
+   end Execute_Event_Attribute;
+
+   function Execute_Active_Attribute (Lit: Iir_Value_Literal_Acc)
+                                     return Boolean is
+   begin
+      return Read_Signal_Flag (Lit, Read_Signal_Active);
+   end Execute_Active_Attribute;
+
+   function Execute_Driving_Attribute (Lit: Iir_Value_Literal_Acc)
+                                      return Boolean is
+   begin
+      return not Read_Signal_Flag (Lit, Read_Signal_Not_Driving);
+   end Execute_Driving_Attribute;
+
+   type Read_Signal_Value_Enum is
+     (Read_Signal_Last_Value,
+
+      --  For conversion functions.
+      Read_Signal_Driving_Value,
+      Read_Signal_Effective_Value,
+
+      --  'Driving_Value
+      Read_Signal_Driver_Value);
+
+   function Execute_Read_Signal_Value (Sig: Iir_Value_Literal_Acc;
+                                       Attr : Read_Signal_Value_Enum)
+     return Iir_Value_Literal_Acc
+   is
+      Res: Iir_Value_Literal_Acc;
+   begin
+      case Sig.Kind is
+         when Iir_Value_Array =>
+            Res := Copy_Array_Bound (Sig);
+            for I in Sig.Val_Array.V'Range loop
+               Res.Val_Array.V (I) :=
+                 Execute_Read_Signal_Value (Sig.Val_Array.V (I), Attr);
+            end loop;
+            return Res;
+         when Iir_Value_Record =>
+            Res := Create_Record_Value (Sig.Val_Record.Len);
+            for I in Sig.Val_Record.V'Range loop
+               Res.Val_Record.V (I) :=
+                 Execute_Read_Signal_Value (Sig.Val_Record.V (I), Attr);
+            end loop;
+            return Res;
+         when Iir_Value_Signal =>
+            case Attr is
+               when Read_Signal_Last_Value =>
+                  return Value_To_Iir_Value
+                    (Sig.Sig.Mode, Sig.Sig.Last_Value);
+               when Read_Signal_Driver_Value =>
+                  case Sig.Sig.Mode is
+                     when Mode_F64 =>
+                        return Create_F64_Value
+                          (Grt.Signals.Ghdl_Signal_Driving_Value_F64
+                             (Sig.Sig));
+                     when Mode_I64 =>
+                        return Create_I64_Value
+                          (Grt.Signals.Ghdl_Signal_Driving_Value_I64
+                             (Sig.Sig));
+                     when Mode_E32 =>
+                        return Create_E32_Value
+                          (Grt.Signals.Ghdl_Signal_Driving_Value_E32
+                             (Sig.Sig));
+                     when Mode_B1 =>
+                        return Create_B1_Value
+                          (Grt.Signals.Ghdl_Signal_Driving_Value_B1
+                             (Sig.Sig));
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               when Read_Signal_Effective_Value =>
+                  return Value_To_Iir_Value
+                    (Sig.Sig.Mode, Sig.Sig.Value);
+               when Read_Signal_Driving_Value =>
+                  return Value_To_Iir_Value
+                    (Sig.Sig.Mode, Sig.Sig.Driving_Value);
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Execute_Read_Signal_Value;
+
+   type Write_Signal_Enum is
+     (Write_Signal_Driving_Value,
+      Write_Signal_Effective_Value);
+
+   procedure Execute_Write_Signal (Sig: Iir_Value_Literal_Acc;
+                                   Val : Iir_Value_Literal_Acc;
+                                   Attr : Write_Signal_Enum) is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Array =>
+            pragma Assert (Val.Kind = Iir_Value_Array);
+            pragma Assert (Sig.Val_Array.Len = Val.Val_Array.Len);
+            for I in Sig.Val_Array.V'Range loop
+               Execute_Write_Signal
+                 (Sig.Val_Array.V (I), Val.Val_Array.V (I), Attr);
+            end loop;
+         when Iir_Value_Record =>
+            pragma Assert (Val.Kind = Iir_Value_Record);
+            pragma Assert (Sig.Val_Record.Len = Val.Val_Record.Len);
+            for I in Sig.Val_Record.V'Range loop
+               Execute_Write_Signal
+                 (Sig.Val_Record.V (I), Val.Val_Record.V (I), Attr);
+            end loop;
+         when Iir_Value_Signal =>
+            pragma Assert (Val.Kind in Iir_Value_Scalars);
+            case Attr is
+               when Write_Signal_Driving_Value =>
+                  Iir_Value_To_Value (Val, Sig.Sig.Driving_Value);
+               when Write_Signal_Effective_Value =>
+                  Iir_Value_To_Value (Val, Sig.Sig.Value);
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Execute_Write_Signal;
+
+   function Execute_Last_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
+     return Iir_Value_Literal_Acc is
+   begin
+      return Execute_Read_Signal_Value (Indirect, Read_Signal_Last_Value);
+   end Execute_Last_Value_Attribute;
+
+   function Execute_Driving_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                            return Iir_Value_Literal_Acc is
+   begin
+      return Execute_Read_Signal_Value (Indirect, Read_Signal_Driver_Value);
+   end Execute_Driving_Value_Attribute;
+
+   type Signal_Read_Last_Type is
+     (Read_Last_Event,
+      Read_Last_Active);
+
+   --  Return the Last_Event absolute time.
+   function Execute_Read_Signal_Last (Indirect: Iir_Value_Literal_Acc;
+                                      Kind : Signal_Read_Last_Type)
+                                     return Ghdl_I64
+   is
+      Res: Ghdl_I64;
+   begin
+      case Indirect.Kind is
+         when Iir_Value_Array =>
+            Res := Ghdl_I64'First;
+            for I in Indirect.Val_Array.V'Range loop
+               Res := Ghdl_I64'Max
+                 (Res, Execute_Read_Signal_Last (Indirect.Val_Array.V (I),
+                                                 Kind));
+            end loop;
+            return Res;
+         when Iir_Value_Signal =>
+            case Kind is
+               when Read_Last_Event =>
+                  return Ghdl_I64 (Indirect.Sig.Last_Event);
+               when Read_Last_Active =>
+                  return Ghdl_I64 (Indirect.Sig.Last_Active);
+            end case;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Execute_Read_Signal_Last;
+
+   function Execute_Last_Event_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                         return Ghdl_I64 is
+   begin
+      return Execute_Read_Signal_Last (Indirect, Read_Last_Event);
+   end Execute_Last_Event_Attribute;
+
+   function Execute_Last_Active_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                          return Ghdl_I64 is
+   begin
+      return Execute_Read_Signal_Last (Indirect, Read_Last_Active);
+   end Execute_Last_Active_Attribute;
+
+   function Execute_Signal_Value (Indirect: Iir_Value_Literal_Acc)
+     return Iir_Value_Literal_Acc
+   is
+      Res: Iir_Value_Literal_Acc;
+   begin
+      case Indirect.Kind is
+         when Iir_Value_Array =>
+            Res := Copy_Array_Bound (Indirect);
+            for I in Indirect.Val_Array.V'Range loop
+               Res.Val_Array.V (I) :=
+                 Execute_Signal_Value (Indirect.Val_Array.V (I));
+            end loop;
+            return Res;
+         when Iir_Value_Record =>
+            Res := Create_Record_Value (Indirect.Val_Record.Len);
+            for I in Indirect.Val_Record.V'Range loop
+               Res.Val_Record.V (I) :=
+                 Execute_Signal_Value (Indirect.Val_Record.V (I));
+            end loop;
+            return Res;
+         when Iir_Value_Signal =>
+            return Value_To_Iir_Value (Indirect.Sig.Mode, Indirect.Sig.Value);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Execute_Signal_Value;
+
+   procedure Assign_Value_To_Array_Signal
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Transactions: Transaction_Type)
+   is
+      Sub_Trans : Transaction_Type (Transactions.Len);
+   begin
+      Sub_Trans.Stmt := Transactions.Stmt;
+      Sub_Trans.Reject := Transactions.Reject;
+
+      for J in Target.Val_Array.V'Range loop
+         for K in Transactions.Els'Range loop
+            declare
+               T : Transaction_El_Type renames Transactions.Els (K);
+               S : Transaction_El_Type renames Sub_Trans.Els (K);
+            begin
+               S.After := T.After;
+
+               if T.Value = null then
+                  S.Value := null;
+               else
+                  S.Value := T.Value.Val_Array.V (J);
+               end if;
+            end;
+         end loop;
+
+         Assign_Value_To_Signal
+           (Instance, Target.Val_Array.V (J), Sub_Trans);
+      end loop;
+   end Assign_Value_To_Array_Signal;
+
+   procedure Assign_Value_To_Record_Signal
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Transactions: Transaction_Type)
+   is
+      Sub_Trans : Transaction_Type (Transactions.Len);
+   begin
+      Sub_Trans.Stmt := Transactions.Stmt;
+      Sub_Trans.Reject := Transactions.Reject;
+
+      for J in Target.Val_Record.V'Range loop
+         for K in Transactions.Els'Range loop
+            declare
+               T : Transaction_El_Type renames Transactions.Els (K);
+               S : Transaction_El_Type renames Sub_Trans.Els (K);
+            begin
+               S.After := T.After;
+
+               if T.Value = null then
+                  S.Value := null;
+               else
+                  S.Value := T.Value.Val_Record.V (J);
+               end if;
+            end;
+         end loop;
+
+         Assign_Value_To_Signal
+           (Instance, Target.Val_Record.V (J), Sub_Trans);
+      end loop;
+   end Assign_Value_To_Record_Signal;
+
+   procedure Assign_Value_To_Scalar_Signal
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Transactions: Transaction_Type)
+   is
+      pragma Unreferenced (Instance);
+      use Grt.Signals;
+   begin
+      declare
+         El : Transaction_El_Type renames Transactions.Els (1);
+      begin
+         if El.Value = null then
+            Ghdl_Signal_Start_Assign_Null
+              (Target.Sig, Transactions.Reject, El.After);
+            if Transactions.Els'Last /= 1 then
+               raise Internal_Error;
+            end if;
+            return;
+         end if;
+
+         --  FIXME: null transaction, check constraints.
+         case Iir_Value_Scalars (El.Value.Kind) is
+            when Iir_Value_B1 =>
+               Ghdl_Signal_Start_Assign_B1
+                 (Target.Sig, Transactions.Reject, El.Value.B1, El.After);
+            when Iir_Value_E32 =>
+               Ghdl_Signal_Start_Assign_E32
+                 (Target.Sig, Transactions.Reject, El.Value.E32, El.After);
+            when Iir_Value_I64 =>
+               Ghdl_Signal_Start_Assign_I64
+                 (Target.Sig, Transactions.Reject, El.Value.I64, El.After);
+            when Iir_Value_F64 =>
+               Ghdl_Signal_Start_Assign_F64
+                 (Target.Sig, Transactions.Reject, El.Value.F64, El.After);
+         end case;
+      end;
+
+      for I in 2 .. Transactions.Els'Last loop
+         declare
+            El : Transaction_El_Type renames Transactions.Els (I);
+         begin
+            case Iir_Value_Scalars (El.Value.Kind) is
+               when Iir_Value_B1 =>
+                  Ghdl_Signal_Next_Assign_B1
+                    (Target.Sig, El.Value.B1, El.After);
+               when Iir_Value_E32 =>
+                  Ghdl_Signal_Next_Assign_E32
+                    (Target.Sig, El.Value.E32, El.After);
+               when Iir_Value_I64 =>
+                  Ghdl_Signal_Next_Assign_I64
+                    (Target.Sig, El.Value.I64, El.After);
+               when Iir_Value_F64 =>
+                  Ghdl_Signal_Next_Assign_F64
+                    (Target.Sig, El.Value.F64, El.After);
+            end case;
+         end;
+      end loop;
+   end Assign_Value_To_Scalar_Signal;
+
+   procedure Assign_Value_To_Signal
+     (Instance: Block_Instance_Acc;
+      Target: Iir_Value_Literal_Acc;
+      Transaction: Transaction_Type)
+   is
+   begin
+      case Target.Kind is
+         when Iir_Value_Array =>
+            Assign_Value_To_Array_Signal
+              (Instance, Target, Transaction);
+         when Iir_Value_Record =>
+            Assign_Value_To_Record_Signal
+              (Instance, Target, Transaction);
+         when Iir_Value_Signal =>
+            Assign_Value_To_Scalar_Signal
+              (Instance, Target, Transaction);
+         when Iir_Value_Scalars
+           | Iir_Value_Range
+           | Iir_Value_File
+           | Iir_Value_Access
+           | Iir_Value_Protected
+           | Iir_Value_Quantity
+           | Iir_Value_Terminal =>
+            raise Internal_Error;
+      end case;
+   end Assign_Value_To_Signal;
+
+   procedure Disconnect_Signal (Sig : Iir_Value_Literal_Acc) is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Array =>
+            for I in Sig.Val_Array.V'Range loop
+               Disconnect_Signal (Sig.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            for I in Sig.Val_Array.V'Range loop
+               Disconnect_Signal (Sig.Val_Record.V (I));
+            end loop;
+         when Iir_Value_Signal =>
+            Grt.Signals.Ghdl_Signal_Disconnect (Sig.Sig);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Disconnect_Signal;
+
+   --  Call Ghdl_Process_Wait_Add_Sensitivity for each scalar subelement of
+   --  SIG.
+   procedure Wait_Add_Sensitivity (Sig: Iir_Value_Literal_Acc)
+   is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Signal =>
+            Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity (Sig.Sig);
+         when Iir_Value_Array =>
+            for I in Sig.Val_Array.V'Range loop
+               Wait_Add_Sensitivity (Sig.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            for I in Sig.Val_Record.V'Range loop
+               Wait_Add_Sensitivity (Sig.Val_Record.V (I));
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Wait_Add_Sensitivity;
+
+   -- Return true if the process should be suspended.
+   function Execute_Wait_Statement (Instance : Block_Instance_Acc;
+                                    Stmt: Iir_Wait_Statement)
+                                   return Boolean
+   is
+      Expr: Iir;
+      El : Iir;
+      List: Iir_List;
+      Res: Iir_Value_Literal_Acc;
+      Status : Boolean;
+      Marker : Mark_Type;
+   begin
+      if not Instance.In_Wait_Flag then
+         Mark (Marker, Expr_Pool);
+
+         -- LRM93 8.1
+         -- The execution of a wait statement causes the time expression to
+         -- be evaluated to determine the timeout interval.
+         Expr := Get_Timeout_Clause (Stmt);
+         if Expr /= Null_Iir then
+            Res := Execute_Expression (Instance, Expr);
+            Grt.Processes.Ghdl_Process_Wait_Set_Timeout (Std_Time (Res.I64));
+         end if;
+
+         -- LRM93 8.1
+         -- The suspended process may also resume as a result of an event
+         -- occuring on any signal in the sensitivity set of the wait
+         -- statement.
+         List := Get_Sensitivity_List (Stmt);
+         if List /= Null_Iir_List then
+            for J in Natural loop
+               El := Get_Nth_Element (List, J);
+               exit when El = Null_Iir;
+               Wait_Add_Sensitivity (Execute_Name (Instance, El, True));
+            end loop;
+         end if;
+
+         --  LRM93 8.1
+         --  It also causes the execution of the corresponding process
+         --  statement to be suspended.
+         Grt.Processes.Ghdl_Process_Wait_Wait;
+         Instance.In_Wait_Flag := True;
+         Release (Marker, Expr_Pool);
+         return True;
+      else
+         --  LRM93 8.1
+         --  The suspended process will resume, at the latest, immediately
+         --  after the timeout interval has expired.
+         if not Grt.Processes.Ghdl_Process_Wait_Has_Timeout then
+            --  Compute the condition clause only if the timeout has not
+            --  expired.
+
+            -- LRM93 8.1
+            -- If such an event occurs, the condition in the condition clause
+            -- is evaluated.
+            --
+            -- if no condition clause appears, the condition clause until true
+            -- is assumed.
+            Status :=
+              Execute_Condition (Instance, Get_Condition_Clause (Stmt));
+            if not Status then
+               -- LRM93 8.1
+               -- If the value of the condition is FALSE, the process will
+               -- re-suspend.
+               -- Such re-suspension does not involve the recalculation of
+               -- the timeout interval.
+               Grt.Processes.Ghdl_Process_Wait_Wait;
+               return True;
+            end if;
+         end if;
+
+         -- LRM93 8.1
+         --   If the value of the condition is TRUE, the process will resume.
+         -- next statement.
+         Grt.Processes.Ghdl_Process_Wait_Close;
+
+         Instance.In_Wait_Flag := False;
+         return False;
+      end if;
+   end Execute_Wait_Statement;
+
+   function To_Instance_Acc is new Ada.Unchecked_Conversion
+     (System.Address, Grt.Stacks.Instance_Acc);
+
+   procedure Process_Executer (Self : Grt.Stacks.Instance_Acc);
+   pragma Convention (C, Process_Executer);
+
+   procedure Process_Executer (Self : Grt.Stacks.Instance_Acc)
+   is
+      function To_Process_State_Acc is new Ada.Unchecked_Conversion
+        (Grt.Stacks.Instance_Acc, Process_State_Acc);
+
+      Process : Process_State_Acc renames
+        To_Process_State_Acc (Self);
+   begin
+      --  For debugger
+      Current_Process := Process;
+
+      Instance_Pool := Process.Pool'Access;
+
+      if Trace_Simulation then
+         Put (" run process: ");
+         Disp_Instance_Name (Process.Top_Instance);
+         Put_Line (" (" & Disp_Location (Process.Proc) & ")");
+      end if;
+
+      Execute_Sequential_Statements (Process);
+
+      --  Sanity checks.
+      if not Is_Empty (Expr_Pool) then
+         raise Internal_Error;
+      end if;
+
+      case Get_Kind (Process.Proc) is
+         when Iir_Kind_Sensitized_Process_Statement =>
+            if Process.Instance.In_Wait_Flag then
+               raise Internal_Error;
+            end if;
+            if Process.Instance.Stmt = Null_Iir then
+               Process.Instance.Stmt :=
+                 Get_Sequential_Statement_Chain (Process.Proc);
+            end if;
+         when Iir_Kind_Process_Statement =>
+            if not Process.Instance.In_Wait_Flag then
+               raise Internal_Error;
+            end if;
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      Instance_Pool := null;
+      Current_Process := null;
+   end Process_Executer;
+
+   type Resolver_Read_Mode is (Read_Port, Read_Driver);
+
+   function Resolver_Read_Value (Sig : Iir_Value_Literal_Acc;
+                                 Mode : Resolver_Read_Mode;
+                                 Index : Ghdl_Index_Type)
+                                return Iir_Value_Literal_Acc
+   is
+      use Grt.Signals;
+      Val : Ghdl_Value_Ptr;
+      Res : Iir_Value_Literal_Acc;
+   begin
+      case Sig.Kind is
+         when Iir_Value_Array =>
+            Res := Copy_Array_Bound (Sig);
+            for I in Sig.Val_Array.V'Range loop
+               Res.Val_Array.V (I) :=
+                 Resolver_Read_Value (Sig.Val_Array.V (I), Mode, Index);
+            end loop;
+         when Iir_Value_Record =>
+            Res := Create_Record_Value (Sig.Val_Record.Len);
+            for I in Sig.Val_Record.V'Range loop
+               Res.Val_Record.V (I) :=
+                 Resolver_Read_Value (Sig.Val_Record.V (I), Mode, Index);
+            end loop;
+         when Iir_Value_Signal =>
+            case Mode is
+               when Read_Port =>
+                  Val := Ghdl_Signal_Read_Port (Sig.Sig, Index);
+               when Read_Driver =>
+                  Val := Ghdl_Signal_Read_Driver (Sig.Sig, Index);
+            end case;
+            Res := Value_To_Iir_Value (Sig.Sig.Mode, Val.all);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Resolver_Read_Value;
+
+   procedure Resolution_Proc (Instance_Addr : System.Address;
+                              Val : System.Address;
+                              Bool_Vec : System.Address;
+                              Vec_Len : Ghdl_Index_Type;
+                              Nbr_Drv : Ghdl_Index_Type;
+                              Nbr_Ports : Ghdl_Index_Type)
+   is
+      pragma Unreferenced (Val);
+
+      Instance : Resolv_Instance_Type;
+      pragma Import (Ada, Instance);
+      for Instance'Address use Instance_Addr;
+
+      type Bool_Array is array (1 .. Nbr_Drv) of Boolean;
+      Vec : Bool_Array;
+      pragma Import (Ada, Vec);
+      for Vec'Address use Bool_Vec;
+      Off : Iir_Index32;
+
+      Arr : Iir_Value_Literal_Acc;
+      Arr_Type : constant Iir :=
+        Get_Type (Get_Interface_Declaration_Chain (Instance.Func));
+
+      Res : Iir_Value_Literal_Acc;
+
+      Len : constant Iir_Index32 := Iir_Index32 (Vec_Len + Nbr_Ports);
+      Instance_Mark, Expr_Mark : Mark_Type;
+   begin
+      pragma Assert (Instance_Pool = null);
+      Instance_Pool := Global_Pool'Access;
+      Mark (Instance_Mark, Instance_Pool.all);
+      Mark (Expr_Mark, Expr_Pool);
+      Current_Process := No_Process;
+
+      Arr := Create_Array_Value (Len, 1);
+      Arr.Bounds.D (1) := Create_Bounds_From_Length
+        (Instance.Block,
+         Get_First_Element (Get_Index_Subtype_List (Arr_Type)),
+         Len);
+
+      --  First ports
+      for I in 1 .. Nbr_Ports loop
+         Arr.Val_Array.V (Iir_Index32 (I)) := Resolver_Read_Value
+           (Instance.Sig, Read_Port, I - 1);
+      end loop;
+
+      --  Then drivers.
+      Off := Iir_Index32 (Nbr_Ports) + 1;
+      for I in 1 .. Nbr_Drv loop
+         if Vec (I) then
+            Arr.Val_Array.V (Off) := Resolver_Read_Value
+              (Instance.Sig, Read_Driver, I - 1);
+            Off := Off + 1;
+         end if;
+      end loop;
+
+      --  Call resolution function.
+      Res := Execute_Resolution_Function (Instance.Block, Instance.Func, Arr);
+
+      --  Set driving value.
+      Execute_Write_Signal (Instance.Sig, Res, Write_Signal_Driving_Value);
+
+      Release (Instance_Mark, Instance_Pool.all);
+      Release (Expr_Mark, Expr_Pool);
+      Instance_Pool := null;
+   end Resolution_Proc;
+
+   type Convert_Mode is (Convert_In, Convert_Out);
+
+   type Convert_Instance_Type is record
+      Mode : Convert_Mode;
+      Instance : Block_Instance_Acc;
+      Func : Iir;
+      Src : Iir_Value_Literal_Acc;
+      Dst : Iir_Value_Literal_Acc;
+   end record;
+
+   type Convert_Instance_Acc is access Convert_Instance_Type;
+
+   procedure Conversion_Proc (Data : System.Address) is
+      Conv : Convert_Instance_Type;
+      pragma Import (Ada, Conv);
+      for Conv'Address use Data;
+
+      Src : Iir_Value_Literal_Acc;
+      Dst : Iir_Value_Literal_Acc;
+
+      Expr_Mark : Mark_Type;
+   begin
+      pragma Assert (Instance_Pool = null);
+      Instance_Pool := Global_Pool'Access;
+      Mark (Expr_Mark, Expr_Pool);
+      Current_Process := No_Process;
+
+      case Conv.Mode is
+         when Convert_In =>
+            Src := Execute_Read_Signal_Value
+              (Conv.Src, Read_Signal_Effective_Value);
+         when Convert_Out =>
+            Src := Execute_Read_Signal_Value
+              (Conv.Src, Read_Signal_Driving_Value);
+      end case;
+
+      Dst := Execute_Assoc_Conversion (Conv.Instance, Conv.Func, Src);
+
+      Check_Bounds (Conv.Dst, Dst, Conv.Func);
+
+      case Conv.Mode is
+         when Convert_In =>
+            Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Effective_Value);
+         when Convert_Out =>
+            Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Driving_Value);
+      end case;
+
+      Release (Expr_Mark, Expr_Pool);
+      Instance_Pool := null;
+   end Conversion_Proc;
+
+   function Guard_Func (Data : System.Address) return Ghdl_B1
+   is
+      Guard : Guard_Instance_Type;
+      pragma Import (Ada, Guard);
+      for Guard'Address use Data;
+
+      Val : Boolean;
+
+      Prev_Instance_Pool : Areapool_Acc;
+   begin
+      pragma Assert (Instance_Pool = null
+                       or else Instance_Pool = Global_Pool'Access);
+      Prev_Instance_Pool := Instance_Pool;
+
+      Instance_Pool := Global_Pool'Access;
+      Current_Process := No_Process;
+
+      Val := Execute_Condition
+        (Guard.Instance, Get_Guard_Expression (Guard.Guard));
+
+      Instance_Pool := Prev_Instance_Pool;
+
+      return Ghdl_B1'Val (Boolean'Pos (Val));
+   end Guard_Func;
+
+   -- Add a driver for signal designed by VAL (via index field) for instance
+   -- INSTANCE of process PROC.
+   -- FIXME: default value.
+   procedure Add_Source
+     (Instance: Block_Instance_Acc; Val: Iir_Value_Literal_Acc; Proc: Iir)
+   is
+   begin
+      case Val.Kind is
+         when Iir_Value_Signal =>
+            if Proc = Null_Iir then
+               -- Can this happen ?
+               raise Internal_Error;
+            end if;
+            Grt.Signals.Ghdl_Process_Add_Driver (Val.Sig);
+         when Iir_Value_Array =>
+            for I in Val.Val_Array.V'Range loop
+               Add_Source (Instance, Val.Val_Array.V (I), Proc);
+            end loop;
+         when Iir_Value_Record =>
+            for I in Val.Val_Record.V'Range loop
+               Add_Source (Instance, Val.Val_Record.V (I), Proc);
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Add_Source;
+
+   --  Add drivers for process PROC.
+   --  Note: this is done recursively on the callees of PROC.
+   procedure Elaborate_Drivers (Instance: Block_Instance_Acc; Proc: Iir)
+   is
+      Driver_List: Iir_List;
+      El: Iir;
+      Val: Iir_Value_Literal_Acc;
+      Marker : Mark_Type;
+   begin
+      if Trace_Drivers then
+         Ada.Text_IO.Put ("Drivers for ");
+         Disp_Instance_Name (Instance);
+         Ada.Text_IO.Put_Line (": " & Disp_Node (Proc));
+      end if;
+
+      Driver_List := Trans_Analyzes.Extract_Drivers (Proc);
+
+      -- Some processes have no driver list (assertion).
+      if Driver_List = Null_Iir_List then
+         return;
+      end if;
+
+      for I in Natural loop
+         El := Get_Nth_Element (Driver_List, I);
+         exit when El = Null_Iir;
+         if Trace_Drivers then
+            Put_Line (' ' & Disp_Node (El));
+         end if;
+
+         Mark (Marker, Expr_Pool);
+         Val := Execute_Name (Instance, El, True);
+         Add_Source (Instance, Val, Proc);
+         Release (Marker, Expr_Pool);
+      end loop;
+   end Elaborate_Drivers;
+
+   --  Call Ghdl_Process_Add_Sensitivity for each scalar subelement of
+   --  SIG.
+   procedure Process_Add_Sensitivity (Sig: Iir_Value_Literal_Acc) is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Signal =>
+            Grt.Processes.Ghdl_Process_Add_Sensitivity (Sig.Sig);
+         when Iir_Value_Array =>
+            for I in Sig.Val_Array.V'Range loop
+               Process_Add_Sensitivity (Sig.Val_Array.V (I));
+            end loop;
+         when Iir_Value_Record =>
+            for I in Sig.Val_Record.V'Range loop
+               Process_Add_Sensitivity (Sig.Val_Record.V (I));
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Process_Add_Sensitivity;
+
+   procedure Create_Processes
+   is
+      use Grt.Processes;
+      El : Iir;
+      Instance : Block_Instance_Acc;
+      Instance_Grt : Grt.Stacks.Instance_Acc;
+   begin
+      Processes_State := new Process_State_Array (1 .. Processes_Table.Last);
+
+      for I in Processes_Table.First .. Processes_Table.Last loop
+         Instance := Processes_Table.Table (I);
+         El := Instance.Label;
+
+         Instance_Pool := Processes_State (I).Pool'Access;
+         Instance.Stmt := Get_Sequential_Statement_Chain (El);
+
+         Processes_State (I).Top_Instance := Instance;
+         Processes_State (I).Proc := El;
+         Processes_State (I).Instance := Instance;
+
+         Current_Process := Processes_State (I)'Access;
+         Instance_Grt := To_Instance_Acc (Processes_State (I)'Address);
+         case Get_Kind (El) is
+            when Iir_Kind_Sensitized_Process_Statement =>
+               if Get_Postponed_Flag (El) then
+                  Ghdl_Postponed_Sensitized_Process_Register
+                    (Instance_Grt,
+                     Process_Executer'Access,
+                     null, System.Null_Address);
+               else
+                  Ghdl_Sensitized_Process_Register
+                    (Instance_Grt,
+                     Process_Executer'Access,
+                     null, System.Null_Address);
+               end if;
+
+               --  Register sensitivity.
+               declare
+                  Sig_List : Iir_List;
+                  Sig : Iir;
+                  Marker : Mark_Type;
+               begin
+                  Sig_List := Get_Sensitivity_List (El);
+                  for J in Natural loop
+                     Sig := Get_Nth_Element (Sig_List, J);
+                     exit when Sig = Null_Iir;
+                     Mark (Marker, Expr_Pool);
+                     Process_Add_Sensitivity
+                       (Execute_Name (Instance, Sig, True));
+                     Release (Marker, Expr_Pool);
+                  end loop;
+               end;
+
+            when Iir_Kind_Process_Statement =>
+               if Get_Postponed_Flag (El) then
+                  Ghdl_Postponed_Process_Register
+                    (Instance_Grt,
+                     Process_Executer'Access,
+                     null, System.Null_Address);
+               else
+                  Ghdl_Process_Register
+                    (Instance_Grt,
+                     Process_Executer'Access,
+                     null, System.Null_Address);
+               end if;
+
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --  LRM93 §12.4.4  Other Concurrent Statements
+         --  All other concurrent statements are either process
+         --  statements or are statements for which there is an
+         --  equivalent process statement.
+         --  Elaboration of a process statement proceeds as follows:
+         --  1.  The process declarative part is elaborated.
+         Elaborate_Declarative_Part
+           (Instance, Get_Declaration_Chain (El));
+
+         --  2.  The drivers required by the process statement
+         --      are created.
+         --  3.  The initial transaction defined by the default value
+         --      associated with each scalar signal driven by the
+         --      process statement is inserted into the corresponding
+         --      driver.
+         --  FIXME: do it for drivers in called subprograms too.
+         Elaborate_Drivers (Instance, El);
+
+         if not Is_Empty (Expr_Pool) then
+            raise Internal_Error;
+         end if;
+
+         --  Elaboration of all concurrent signal assignment
+         --  statements and concurrent assertion statements consists
+         --  of the construction of the equivalent process statement
+         --  followed by the elaboration of the equivalent process
+         --  statement.
+         --  [GHDL:  this is done by canonicalize.  ]
+
+         --  FIXME: check passive statements,
+         --  check no wait statement in sensitized processes.
+
+         Instance_Pool := null;
+      end loop;
+
+      if Trace_Simulation then
+         Disp_Signals_Value;
+      end if;
+   end Create_Processes;
+
+   --  Configuration for the whole design
+   Top_Config : Iir_Design_Unit;
+
+   --  Elaborate the design
+   procedure Ghdl_Elaborate;
+   pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   procedure Set_Disconnection (Val : Iir_Value_Literal_Acc;
+                                Time : Iir_Value_Time)
+   is
+   begin
+      case Val.Kind is
+         when Iir_Value_Signal =>
+            Grt.Signals.Ghdl_Signal_Set_Disconnect (Val.Sig, Std_Time (Time));
+         when Iir_Value_Record =>
+            for I in Val.Val_Record.V'Range loop
+               Set_Disconnection (Val.Val_Record.V (I), Time);
+            end loop;
+         when Iir_Value_Array =>
+            for I in Val.Val_Array.V'Range loop
+               Set_Disconnection (Val.Val_Array.V (I), Time);
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Set_Disconnection;
+
+   procedure Create_Disconnections is
+   begin
+      for I in Disconnection_Table.First .. Disconnection_Table.Last loop
+         declare
+            E : Disconnection_Entry renames Disconnection_Table.Table (I);
+         begin
+            Set_Disconnection (E.Sig, E.Time);
+         end;
+      end loop;
+   end Create_Disconnections;
+
+   type Connect_Mode is (Connect_Source, Connect_Effective);
+
+   -- Add a driving value PORT to signal SIG, ie: PORT is a source for SIG.
+   -- As a side effect, this connect the signal SIG with the port PORT.
+   -- PORT is the formal, while SIG is the actual.
+   procedure Connect (Sig: Iir_Value_Literal_Acc;
+                      Port: Iir_Value_Literal_Acc;
+                      Mode : Connect_Mode)
+   is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Array =>
+            if Port.Kind /= Sig.Kind then
+               raise Internal_Error;
+            end if;
+
+            if Sig.Val_Array.Len /= Port.Val_Array.Len then
+               raise Internal_Error;
+            end if;
+            for I in Sig.Val_Array.V'Range loop
+               Connect (Sig.Val_Array.V (I), Port.Val_Array.V (I), Mode);
+            end loop;
+            return;
+         when Iir_Value_Record =>
+            if Port.Kind /= Sig.Kind then
+               raise Internal_Error;
+            end if;
+            if Sig.Val_Record.Len /= Port.Val_Record.Len then
+               raise Internal_Error;
+            end if;
+            for I in Sig.Val_Record.V'Range loop
+               Connect (Sig.Val_Record.V (I), Port.Val_Record.V (I), Mode);
+            end loop;
+            return;
+         when Iir_Value_Signal =>
+            case Port.Kind is
+               when Iir_Value_Signal =>
+                  -- Here, SIG and PORT are simple signals (not composite).
+                  -- PORT is a source for SIG.
+                  case Mode is
+                     when Connect_Source =>
+                        Grt.Signals.Ghdl_Signal_Add_Source
+                          (Sig.Sig, Port.Sig);
+                     when Connect_Effective =>
+                        Grt.Signals.Ghdl_Signal_Effective_Value
+                          (Port.Sig, Sig.Sig);
+                  end case;
+               when Iir_Value_Access
+                 | Iir_Value_File
+                 | Iir_Value_Range
+                 | Iir_Value_Scalars --  FIXME: by value
+                 | Iir_Value_Record
+                 | Iir_Value_Array
+                 | Iir_Value_Protected
+                 | Iir_Value_Quantity
+                 | Iir_Value_Terminal =>
+                  --  These cannot be driving value for a signal.
+                  raise Internal_Error;
+            end case;
+         when Iir_Value_E32 =>
+            if Mode = Connect_Source then
+               raise Internal_Error;
+            end if;
+            Grt.Signals.Ghdl_Signal_Associate_E32 (Port.Sig, Sig.E32);
+         when Iir_Value_I64 =>
+            if Mode = Connect_Source then
+               raise Internal_Error;
+            end if;
+            Grt.Signals.Ghdl_Signal_Associate_I64 (Port.Sig, Sig.I64);
+         when Iir_Value_B1 =>
+            if Mode = Connect_Source then
+               raise Internal_Error;
+            end if;
+            Grt.Signals.Ghdl_Signal_Associate_B1 (Port.Sig, Sig.B1);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Connect;
+
+   function Get_Leftest_Signal (Val : Iir_Value_Literal_Acc)
+                               return Iir_Value_Literal_Acc is
+   begin
+      case Val.Kind is
+         when Iir_Value_Signal =>
+            return Val;
+         when Iir_Value_Array =>
+            return Get_Leftest_Signal (Val.Val_Array.V (1));
+         when Iir_Value_Record =>
+            return Get_Leftest_Signal (Val.Val_Record.V (1));
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_Leftest_Signal;
+
+   procedure Add_Conversion (Conv : Convert_Instance_Acc)
+   is
+      Src_Left : Grt.Signals.Ghdl_Signal_Ptr;
+      Src_Len : Ghdl_Index_Type;
+      Dst_Left : Grt.Signals.Ghdl_Signal_Ptr;
+      Dst_Len : Ghdl_Index_Type;
+   begin
+      Conv.Src := Unshare_Bounds (Conv.Src, Instance_Pool);
+      Conv.Dst := Unshare_Bounds (Conv.Dst, Instance_Pool);
+
+      Src_Left := Get_Leftest_Signal (Conv.Src).Sig;
+      Src_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Src));
+
+      Dst_Left := Get_Leftest_Signal (Conv.Dst).Sig;
+      Dst_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Dst));
+
+      case Conv.Mode is
+         when Convert_In =>
+            Grt.Signals.Ghdl_Signal_In_Conversion (Conversion_Proc'Address,
+                                                   Conv.all'Address,
+                                                   Src_Left, Src_Len,
+                                                   Dst_Left, Dst_Len);
+         when Convert_Out =>
+            Grt.Signals.Ghdl_Signal_Out_Conversion (Conversion_Proc'Address,
+                                                    Conv.all'Address,
+                                                    Src_Left, Src_Len,
+                                                    Dst_Left, Dst_Len);
+      end case;
+   end Add_Conversion;
+
+   function Create_Shadow_Signal (Sig : Iir_Value_Literal_Acc)
+                                 return Iir_Value_Literal_Acc
+   is
+   begin
+      case Sig.Kind is
+         when Iir_Value_Signal =>
+            case Sig.Sig.Mode is
+               when Mode_I64 =>
+                  return Create_Signal_Value
+                    (Grt.Signals.Ghdl_Create_Signal_I64
+                       (0, null, System.Null_Address));
+               when Mode_B1 =>
+                  return Create_Signal_Value
+                    (Grt.Signals.Ghdl_Create_Signal_B1
+                       (False, null, System.Null_Address));
+               when Mode_E32 =>
+                  return Create_Signal_Value
+                    (Grt.Signals.Ghdl_Create_Signal_E32
+                       (0, null, System.Null_Address));
+               when Mode_F64 =>
+                  return Create_Signal_Value
+                    (Grt.Signals.Ghdl_Create_Signal_F64
+                       (0.0, null, System.Null_Address));
+               when Mode_E8
+                 | Mode_I32 =>
+                  raise Internal_Error;
+            end case;
+         when Iir_Value_Array =>
+            declare
+               Res : Iir_Value_Literal_Acc;
+            begin
+               Res := Unshare_Bounds (Sig, Instance_Pool);
+               for I in Res.Val_Array.V'Range loop
+                  Res.Val_Array.V (I) :=
+                    Create_Shadow_Signal (Sig.Val_Array.V (I));
+               end loop;
+               return Res;
+            end;
+         when Iir_Value_Record =>
+            declare
+               Res : Iir_Value_Literal_Acc;
+            begin
+               Res := Create_Record_Value
+                 (Sig.Val_Record.Len, Instance_Pool);
+               for I in Res.Val_Record.V'Range loop
+                  Res.Val_Record.V (I) :=
+                    Create_Shadow_Signal (Sig.Val_Record.V (I));
+               end loop;
+               return Res;
+            end;
+         when Iir_Value_Scalars
+           | Iir_Value_Access
+           | Iir_Value_Range
+           | Iir_Value_Protected
+           | Iir_Value_Terminal
+           | Iir_Value_Quantity
+           | Iir_Value_File =>
+            raise Internal_Error;
+      end case;
+   end Create_Shadow_Signal;
+
+   procedure Set_Connect
+     (Formal_Instance : Block_Instance_Acc;
+      Formal_Expr : Iir_Value_Literal_Acc;
+      Local_Instance : Block_Instance_Acc;
+      Local_Expr : Iir_Value_Literal_Acc;
+      Assoc : Iir_Association_Element_By_Expression)
+   is
+      pragma Unreferenced (Formal_Instance);
+      Formal : constant Iir := Get_Formal (Assoc);
+      Inter : constant Iir := Get_Association_Interface (Assoc);
+   begin
+      if False and Trace_Elaboration then
+         Put ("connect formal ");
+         Put (Iir_Mode'Image (Get_Mode (Inter)));
+         Put (" ");
+         Disp_Iir_Value (Formal_Expr, Get_Type (Formal));
+         Put (" with actual ");
+         Disp_Iir_Value (Local_Expr, Get_Type (Get_Actual (Assoc)));
+         New_Line;
+      end if;
+
+      case Get_Mode (Inter) is
+         when Iir_Out_Mode
+           | Iir_Inout_Mode
+           | Iir_Buffer_Mode
+           | Iir_Linkage_Mode =>
+            --  FORMAL_EXPR is a source for LOCAL_EXPR.
+            declare
+               Out_Conv : constant Iir := Get_Out_Conversion (Assoc);
+               Src : Iir_Value_Literal_Acc;
+            begin
+               if Out_Conv /= Null_Iir then
+                  Src := Create_Shadow_Signal (Local_Expr);
+                  Add_Conversion
+                    (new Convert_Instance_Type'
+                       (Mode => Convert_Out,
+                        Instance => Local_Instance,
+                        Func => Out_Conv,
+                        Src => Formal_Expr,
+                        Dst => Src));
+               else
+                  Src := Formal_Expr;
+               end if;
+               --  LRM93 §12.6.2
+               --  A signal is said to be active [...] if one of its source
+               --  is active.
+               Connect (Local_Expr, Src, Connect_Source);
+            end;
+
+         when Iir_In_Mode =>
+            null;
+         when Iir_Unknown_Mode =>
+            raise Internal_Error;
+      end case;
+
+      case Get_Mode (Inter) is
+         when Iir_In_Mode
+           | Iir_Inout_Mode
+           | Iir_Buffer_Mode
+           | Iir_Linkage_Mode =>
+            declare
+               In_Conv : constant Iir := Get_In_Conversion (Assoc);
+               Src : Iir_Value_Literal_Acc;
+            begin
+               if In_Conv /= Null_Iir then
+                  Src := Create_Shadow_Signal (Formal_Expr);
+                  Add_Conversion
+                    (new Convert_Instance_Type'
+                       (Mode => Convert_In,
+                        Instance => Local_Instance,
+                        Func => Get_Implementation (In_Conv),
+                        Src => Local_Expr,
+                        Dst => Src));
+               else
+                  Src := Local_Expr;
+               end if;
+               Connect (Src, Formal_Expr, Connect_Effective);
+            end;
+         when Iir_Out_Mode =>
+            null;
+         when Iir_Unknown_Mode =>
+            raise Internal_Error;
+      end case;
+   end Set_Connect;
+
+   procedure Create_Connects is
+   begin
+      --  New signals may be created (because of conversions).
+      Instance_Pool := Global_Pool'Access;
+
+      for I in Connect_Table.First .. Connect_Table.Last loop
+         declare
+            E : Connect_Entry renames Connect_Table.Table (I);
+         begin
+            Set_Connect (E.Formal_Instance, E.Formal,
+                         E.Actual_Instance, E.Actual,
+                         E.Assoc);
+         end;
+      end loop;
+
+      Instance_Pool := null;
+   end Create_Connects;
+
+   procedure Create_Guard_Signal
+     (Instance : Block_Instance_Acc;
+      Sig_Guard : Iir_Value_Literal_Acc;
+      Guard : Iir)
+   is
+      procedure Add_Guard_Sensitivity (Sig : Iir_Value_Literal_Acc) is
+      begin
+         case Sig.Kind is
+            when Iir_Value_Signal =>
+               Grt.Signals.Ghdl_Signal_Guard_Dependence (Sig.Sig);
+            when Iir_Value_Array =>
+               for I in Sig.Val_Array.V'Range loop
+                  Add_Guard_Sensitivity (Sig.Val_Array.V (I));
+               end loop;
+            when Iir_Value_Record =>
+               for I in Sig.Val_Record.V'Range loop
+                  Add_Guard_Sensitivity (Sig.Val_Record.V (I));
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Add_Guard_Sensitivity;
+
+      Dep_List : Iir_List;
+      Dep : Iir;
+      Data : Guard_Instance_Acc;
+   begin
+      Data := new Guard_Instance_Type'(Instance => Instance,
+                                       Guard => Guard);
+      Sig_Guard.Sig := Grt.Signals.Ghdl_Signal_Create_Guard
+        (Data.all'Address, Guard_Func'Access);
+      Dep_List := Get_Guard_Sensitivity_List (Guard);
+      for I in Natural loop
+         Dep := Get_Nth_Element (Dep_List, I);
+         exit when Dep = Null_Iir;
+         Add_Guard_Sensitivity (Execute_Name (Instance, Dep, True));
+      end loop;
+
+      --  FIXME: free mem
+   end Create_Guard_Signal;
+
+   procedure Create_Implicit_Signal (Sig : Iir_Value_Literal_Acc;
+                                     Time : Ghdl_I64;
+                                     Prefix : Iir_Value_Literal_Acc;
+                                     Kind : Signal_Type_Kind)
+   is
+      procedure Register_Prefix (Pfx : Iir_Value_Literal_Acc) is
+      begin
+         case Pfx.Kind is
+            when Iir_Value_Signal =>
+               Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix (Pfx.Sig);
+            when Iir_Value_Array =>
+               for I in Pfx.Val_Array.V'Range loop
+                  Register_Prefix (Pfx.Val_Array.V (I));
+               end loop;
+            when Iir_Value_Record =>
+               for I in Pfx.Val_Record.V'Range loop
+                  Register_Prefix (Pfx.Val_Record.V (I));
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Register_Prefix;
+   begin
+      case Kind is
+         when Implicit_Stable =>
+            Sig.Sig := Grt.Signals.Ghdl_Create_Stable_Signal (Std_Time (Time));
+         when Implicit_Quiet =>
+            Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal (Std_Time (Time));
+         when Implicit_Transaction =>
+            Sig.Sig := Grt.Signals.Ghdl_Create_Transaction_Signal;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Register_Prefix (Prefix);
+   end Create_Implicit_Signal;
+
+   procedure Create_Delayed_Signal
+     (Sig : Iir_Value_Literal_Acc; Pfx : Iir_Value_Literal_Acc; Val : Std_Time)
+   is
+   begin
+      case Pfx.Kind is
+            when Iir_Value_Array =>
+               for I in Sig.Val_Array.V'Range loop
+                  Create_Delayed_Signal
+                    (Sig.Val_Array.V (I), Pfx.Val_Array.V (I), Val);
+               end loop;
+            when Iir_Value_Record =>
+               for I in Pfx.Val_Record.V'Range loop
+                  Create_Delayed_Signal
+                    (Sig.Val_Record.V (I), Pfx.Val_Array.V (I), Val);
+               end loop;
+         when Iir_Value_Signal =>
+            Sig.Sig := Grt.Signals.Ghdl_Create_Delayed_Signal (Pfx.Sig, Val);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Create_Delayed_Signal;
+
+   -- Create a new signal, using DEFAULT as initial value.
+   -- Set its number.
+   procedure Create_User_Signal (Block: Block_Instance_Acc;
+                                 Signal: Iir;
+                                 Sig : Iir_Value_Literal_Acc;
+                                 Default : Iir_Value_Literal_Acc)
+   is
+      use Grt.Rtis;
+
+      procedure Create_Signal (Lit: Iir_Value_Literal_Acc;
+                               Sig : Iir_Value_Literal_Acc;
+                               Sig_Type: Iir;
+                               Already_Resolved : Boolean)
+      is
+         Sub_Resolved : Boolean := Already_Resolved;
+         Resolv_Func : Iir;
+         Resolv_Instance : Resolv_Instance_Acc;
+      begin
+         if not Already_Resolved
+           and then Get_Kind (Sig_Type) in Iir_Kinds_Subtype_Definition
+         then
+            Resolv_Func := Get_Resolution_Function (Sig_Type);
+         else
+            Resolv_Func := Null_Iir;
+         end if;
+         if Resolv_Func /= Null_Iir then
+            Sub_Resolved := True;
+            Resolv_Instance := new Resolv_Instance_Type'
+              (Func => Get_Named_Entity (Resolv_Func),
+               Block => Block,
+               Sig => Sig);
+            Grt.Signals.Ghdl_Signal_Create_Resolution
+              (Resolution_Proc'Access,
+               Resolv_Instance.all'Address,
+               System.Null_Address,
+               Ghdl_Index_Type (Get_Nbr_Of_Scalars (Lit)));
+         end if;
+         case Lit.Kind is
+            when Iir_Value_Array =>
+               declare
+                  Sig_El_Type : constant Iir :=
+                    Get_Element_Subtype (Get_Base_Type (Sig_Type));
+               begin
+                  for I in Lit.Val_Array.V'Range loop
+                     Create_Signal (Lit.Val_Array.V (I), Sig.Val_Array.V (I),
+                                    Sig_El_Type, Sub_Resolved);
+                  end loop;
+               end;
+            when Iir_Value_Record =>
+               declare
+                  El : Iir_Element_Declaration;
+                  List : Iir_List;
+               begin
+                  List := Get_Elements_Declaration_List
+                    (Get_Base_Type (Sig_Type));
+                  for I in Lit.Val_Record.V'Range loop
+                     El := Get_Nth_Element (List, Natural (I - 1));
+                     Create_Signal (Lit.Val_Record.V (I), Sig.Val_Record.V (I),
+                                    Get_Type (El), Sub_Resolved);
+                  end loop;
+               end;
+
+            when Iir_Value_I64 =>
+               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_I64
+                 (Lit.I64, null, System.Null_Address);
+            when Iir_Value_B1 =>
+               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_B1
+                 (Lit.B1, null, System.Null_Address);
+            when Iir_Value_E32 =>
+               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E32
+                 (Lit.E32, null, System.Null_Address);
+            when Iir_Value_F64 =>
+               Sig.Sig := Grt.Signals.Ghdl_Create_Signal_F64
+                 (Lit.F64, null, System.Null_Address);
+
+            when Iir_Value_Signal
+              | Iir_Value_Range
+              | Iir_Value_File
+              | Iir_Value_Access
+              | Iir_Value_Protected
+              | Iir_Value_Quantity
+              | Iir_Value_Terminal =>
+               raise Internal_Error;
+         end case;
+      end Create_Signal;
+
+      Sig_Type: constant Iir := Get_Type (Signal);
+      Mode : Mode_Signal_Type;
+      Kind : Kind_Signal_Type;
+
+      type Iir_Mode_To_Mode_Signal_Type is
+        array (Iir_Mode) of Mode_Signal_Type;
+      Iir_Mode_To_Mode_Signal : constant Iir_Mode_To_Mode_Signal_Type :=
+        (Iir_Unknown_Mode => Mode_Signal,
+         Iir_Linkage_Mode => Mode_Linkage,
+         Iir_Buffer_Mode => Mode_Buffer,
+         Iir_Out_Mode => Mode_Out,
+         Iir_Inout_Mode => Mode_Inout,
+         Iir_In_Mode => Mode_In);
+
+      type Iir_Kind_To_Kind_Signal_Type is
+        array (Iir_Signal_Kind) of Kind_Signal_Type;
+      Iir_Kind_To_Kind_Signal : constant Iir_Kind_To_Kind_Signal_Type :=
+        (Iir_No_Signal_Kind => Kind_Signal_No,
+         Iir_Register_Kind  => Kind_Signal_Register,
+         Iir_Bus_Kind       => Kind_Signal_Bus);
+   begin
+      case Get_Kind (Signal) is
+         when Iir_Kind_Signal_Interface_Declaration =>
+            Mode := Iir_Mode_To_Mode_Signal (Get_Mode (Signal));
+         when Iir_Kind_Signal_Declaration =>
+            Mode := Mode_Signal;
+         when others =>
+            Error_Kind ("elaborate_signal", Signal);
+      end case;
+
+      Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal));
+
+      Grt.Signals.Ghdl_Signal_Set_Mode (Mode, Kind, True);
+
+      Create_Signal (Default, Sig, Sig_Type, False);
+   end Create_User_Signal;
+
+   procedure Create_Signals is
+   begin
+      for I in Signals_Table.First .. Signals_Table.Last loop
+         declare
+            E : Signal_Entry renames Signals_Table.Table (I);
+         begin
+            case E.Kind is
+               when Guard_Signal =>
+                  Create_Guard_Signal (E.Instance, E.Sig, E.Decl);
+               when Implicit_Stable | Implicit_Quiet | Implicit_Transaction =>
+                  Create_Implicit_Signal (E.Sig, E.Time, E.Prefix, E.Kind);
+               when Implicit_Delayed =>
+                  Create_Delayed_Signal (E.Sig, E.Prefix, Std_Time (E.Time));
+               when User_Signal =>
+                  Create_User_Signal (E.Instance, E.Decl, E.Sig, E.Init);
+            end case;
+         end;
+      end loop;
+   end Create_Signals;
+
+   procedure Ghdl_Elaborate
+   is
+      Entity: Iir_Entity_Declaration;
+
+      -- Number of input ports of the top entity.
+      In_Signals: Natural;
+      El : Iir;
+   begin
+      Instance_Pool := Global_Pool'Access;
+
+      Elaboration.Elaborate_Design (Top_Config);
+      Entity := Iirs_Utils.Get_Entity (Get_Library_Unit (Top_Config));
+
+      if not Is_Empty (Expr_Pool) then
+         raise Internal_Error;
+      end if;
+
+      Instance_Pool := null;
+
+      -- Be sure there is no IN ports in the top entity.
+      El := Get_Port_Chain (Entity);
+      In_Signals := 0;
+      while El /= Null_Iir loop
+         if Get_Mode (El) = Iir_In_Mode then
+            In_Signals := In_Signals + 1;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+
+      if In_Signals /= 0 then
+         Error_Msg ("top entity should not have inputs signals");
+         -- raise Simulation_Error;
+      end if;
+
+      if Disp_Stats then
+         Disp_Design_Stats;
+      end if;
+
+      if Disp_Ams then
+         Simulation.AMS.Debugger.Disp_Characteristic_Expressions;
+      end if;
+
+      -- There is no inputs.
+      -- All the simulation is done via time, so it must be displayed.
+      Disp_Time_Before_Values := True;
+
+      -- Initialisation.
+      if Trace_Simulation then
+         Put_Line ("Initialisation:");
+      end if;
+
+      Create_Signals;
+      Create_Connects;
+      Create_Disconnections;
+      Create_Processes;
+
+      if Disp_Tree then
+         Debugger.Disp_Instances_Tree;
+      end if;
+
+      if Flag_Interractive then
+         Debug (Reason_Elab);
+      end if;
+   end Ghdl_Elaborate;
+
+   procedure Simulation_Entity (Top_Conf : Iir_Design_Unit) is
+   begin
+      Top_Config := Top_Conf;
+      Grt.Processes.One_Stack := True;
+
+      Grt.Errors.Error_Hook := Debug_Error'Access;
+
+      if Flag_Interractive then
+         Debug (Reason_Start);
+      end if;
+
+      Grt.Main.Run;
+   exception
+      when Debugger_Quit =>
+         null;
+      when Simulation_Finished =>
+         null;
+   end Simulation_Entity;
+
+end Simulation;
diff --git a/src/simulate/simulation.ads b/src/simulate/simulation.ads
new file mode 100644
index 000000000..b910b4306
--- /dev/null
+++ b/src/simulate/simulation.ads
@@ -0,0 +1,128 @@
+--  Interpreted simulation
+--  Copyright (C) 2014 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 GHDL; 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 Grt.Types; use Grt.Types;
+with Iirs; use Iirs;
+with Iir_Values; use Iir_Values;
+with Elaboration; use Elaboration;
+with Execution; use Execution;
+
+package Simulation is
+   Trace_Simulation : Boolean := False;
+   Disp_Tree : Boolean := False;
+   Disp_Stats : Boolean := False;
+   Disp_Ams : Boolean := False;
+   Flag_Debugger : Boolean := False;
+   Flag_Interractive : Boolean := False;
+
+   type Resolv_Instance_Type is record
+      Func : Iir;
+      Block : Block_Instance_Acc;
+      Sig : Iir_Value_Literal_Acc;
+   end record;
+   type Resolv_Instance_Acc is access Resolv_Instance_Type;
+
+   --  The resolution procedure for GRT.
+   procedure Resolution_Proc (Instance_Addr : System.Address;
+                              Val : System.Address;
+                              Bool_Vec : System.Address;
+                              Vec_Len : Ghdl_Index_Type;
+                              Nbr_Drv : Ghdl_Index_Type;
+                              Nbr_Ports : Ghdl_Index_Type);
+   pragma Convention (C, Resolution_Proc);
+
+   type Guard_Instance_Type is record
+      Instance : Block_Instance_Acc;
+      Guard : Iir;
+   end record;
+
+   type Guard_Instance_Acc is access Guard_Instance_Type;
+
+   function Guard_Func (Data : System.Address) return Ghdl_B1;
+   pragma Convention (C, Guard_Func);
+
+   --  The entry point of the simulator.
+   procedure Simulation_Entity (Top_Conf : Iir_Design_Unit);
+
+   type Process_State_Array is
+      array (Process_Index_Type range <>) of aliased Process_State_Type;
+   type Process_State_Array_Acc is access Process_State_Array;
+
+   --  Array containing all processes.
+   Processes_State: Process_State_Array_Acc;
+
+   function Execute_Signal_Value (Indirect: Iir_Value_Literal_Acc)
+                                 return Iir_Value_Literal_Acc;
+
+   function Execute_Event_Attribute (Lit: Iir_Value_Literal_Acc)
+                                    return Boolean;
+
+   function Execute_Active_Attribute (Lit: Iir_Value_Literal_Acc)
+                                     return Boolean;
+   function Execute_Driving_Attribute (Lit: Iir_Value_Literal_Acc)
+                                      return Boolean;
+
+   function Execute_Last_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                         return Iir_Value_Literal_Acc;
+   function Execute_Driving_Value_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                            return Iir_Value_Literal_Acc;
+
+   --  Return the Last_Event absolute time.
+   function Execute_Last_Event_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                         return Ghdl_I64;
+   function Execute_Last_Active_Attribute (Indirect: Iir_Value_Literal_Acc)
+                                          return Ghdl_I64;
+
+   -- Type for a transaction: it contains the value, the absolute time at which
+   -- the transaction should occur and a pointer to the next transaction.
+   -- This constitute a simple linked list, the elements must be ordered
+   -- according to time.
+   type Transaction_El_Type is record
+      -- The value of the waveform element.
+      -- Can't be an array.
+      -- Life must be target.
+      Value: Iir_Value_Literal_Acc;
+
+      -- After time at which the transaction should occur.
+      After : Grt.Types.Std_Time;
+   end record;
+
+   type Transaction_Array is array (Natural range <>) of Transaction_El_Type;
+
+   type Transaction_Type (Len : Natural) is record
+      -- Statement that created this transaction.  Used to disp location
+      -- in case of error (constraint error).
+      Stmt: Iir;
+
+      Reject : Std_Time;
+
+      Els : Transaction_Array (1 .. Len);
+   end record;
+
+   procedure Assign_Value_To_Signal (Instance: Block_Instance_Acc;
+                                     Target: Iir_Value_Literal_Acc;
+                                     Transaction: Transaction_Type);
+
+   procedure Disconnect_Signal (Sig : Iir_Value_Literal_Acc);
+
+   -- Return true if the process should be suspended.
+   function Execute_Wait_Statement (Instance : Block_Instance_Acc;
+                                    Stmt: Iir_Wait_Statement)
+                                   return Boolean;
+end Simulation;
diff --git a/src/std_names.adb b/src/std_names.adb
new file mode 100644
index 000000000..98b4f062c
--- /dev/null
+++ b/src/std_names.adb
@@ -0,0 +1,482 @@
+--  Well known name table entries.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Name_Table;
+with Tokens; use Tokens;
+with Ada.Exceptions;
+
+package body Std_Names is
+   procedure Std_Names_Initialize is
+      procedure Def (S : String; Id : Name_Id) is
+      begin
+         if Name_Table.Get_Identifier (S) /= Id then
+            Ada.Exceptions.Raise_Exception
+              (Program_Error'Identity, "wrong name_id for " & S);
+         end if;
+      end Def;
+   begin
+      Name_Table.Initialize;
+
+      -- Create reserved words.
+      for I in Tok_Mod .. Tok_Tolerance loop
+         Def (Image (I),
+              Name_First_Keyword +
+                Token_Type'Pos (I) - Token_Type'Pos (Tok_First_Keyword));
+      end loop;
+
+      -- Create operators.
+      Def ("=",  Name_Op_Equality);
+      Def ("/=", Name_Op_Inequality);
+      Def ("<",  Name_Op_Less);
+      Def ("<=", Name_Op_Less_Equal);
+      Def (">",  Name_Op_Greater);
+      Def (">=", Name_Op_Greater_Equal);
+      Def ("+",  Name_Op_Plus);
+      Def ("-",  Name_Op_Minus);
+      Def ("*",  Name_Op_Mul);
+      Def ("/",  Name_Op_Div);
+      Def ("**", Name_Op_Exp);
+      Def ("&",  Name_Op_Concatenation);
+      Def ("??", Name_Op_Condition);
+      Def ("?=", Name_Op_Match_Equality);
+      Def ("?/=", Name_Op_Match_Inequality);
+      Def ("?<",  Name_Op_Match_Less);
+      Def ("?<=", Name_Op_Match_Less_Equal);
+      Def ("?>",  Name_Op_Match_Greater);
+      Def ("?>=", Name_Op_Match_Greater_Equal);
+
+      -- Create Attributes.
+      Def ("base",          Name_Base);
+      Def ("left",          Name_Left);
+      Def ("right",         Name_Right);
+      Def ("high",          Name_High);
+      Def ("low",           Name_Low);
+      Def ("pos",           Name_Pos);
+      Def ("val",           Name_Val);
+      Def ("succ",          Name_Succ);
+      Def ("pred",          Name_Pred);
+      Def ("leftof",        Name_Leftof);
+      Def ("rightof",       Name_Rightof);
+      Def ("reverse_range", Name_Reverse_Range);
+      Def ("length",        Name_Length);
+      Def ("delayed",       Name_Delayed);
+      Def ("stable",        Name_Stable);
+      Def ("quiet",         Name_Quiet);
+      Def ("transaction",   Name_Transaction);
+      Def ("event",         Name_Event);
+      Def ("active",        Name_Active);
+      Def ("last_event",    Name_Last_Event);
+      Def ("last_active",   Name_Last_Active);
+      Def ("last_value",    Name_Last_Value);
+
+      Def ("behavior",      Name_Behavior);
+      Def ("structure",     Name_Structure);
+
+      Def ("ascending",     Name_Ascending);
+      Def ("image",         Name_Image);
+      Def ("value",         Name_Value);
+      Def ("driving",       Name_Driving);
+      Def ("driving_value", Name_Driving_Value);
+      Def ("simple_name",   Name_Simple_Name);
+      Def ("instance_name", Name_Instance_Name);
+      Def ("path_name",     Name_Path_Name);
+
+      Def ("contribution",  Name_Contribution);
+      Def ("dot",           Name_Dot);
+      Def ("integ",         Name_Integ);
+      Def ("above",         Name_Above);
+      Def ("zoh",           Name_ZOH);
+      Def ("ltf",           Name_LTF);
+      Def ("ztf",           Name_ZTF);
+      Def ("ramp",          Name_Ramp);
+      Def ("slew",          Name_Slew);
+
+      --  Create standard.
+      Def ("std",                 Name_Std);
+      Def ("standard",            Name_Standard);
+      Def ("boolean",             Name_Boolean);
+      Def ("false",               Name_False);
+      Def ("true",                Name_True);
+      Def ("bit",                 Name_Bit);
+      Def ("character",           Name_Character);
+      Def ("severity_level",      Name_Severity_Level);
+      Def ("note",                Name_Note);
+      Def ("warning",             Name_Warning);
+      Def ("error",               Name_Error);
+      Def ("failure",             Name_Failure);
+      Def ("UNIVERSAL_INTEGER",   Name_Universal_Integer);
+      Def ("UNIVERSAL_REAL",      Name_Universal_Real);
+      Def ("CONVERTIBLE_INTEGER", Name_Convertible_Integer);
+      Def ("CONVERTIBLE_REAL",    Name_Convertible_Real);
+      Def ("integer",             Name_Integer);
+      Def ("real",                Name_Real);
+      Def ("time",                Name_Time);
+      Def ("fs",                  Name_Fs);
+      Def ("ps",                  Name_Ps);
+      Def ("ns",                  Name_Ns);
+      Def ("us",                  Name_Us);
+      Def ("ms",                  Name_Ms);
+      Def ("sec",                 Name_Sec);
+      Def ("min",                 Name_Min);
+      Def ("hr",                  Name_Hr);
+      Def ("delay_length",        Name_Delay_Length);
+      Def ("now",                 Name_Now);
+      Def ("natural",             Name_Natural);
+      Def ("positive",            Name_Positive);
+      Def ("string",              Name_String);
+      Def ("bit_vector",          Name_Bit_Vector);
+      Def ("file_open_kind",      Name_File_Open_Kind);
+      Def ("read_mode",           Name_Read_Mode);
+      Def ("write_mode",          Name_Write_Mode);
+      Def ("append_mode",         Name_Append_Mode);
+      Def ("file_open_status",    Name_File_Open_Status);
+      Def ("open_ok",             Name_Open_Ok);
+      Def ("status_error",        Name_Status_Error);
+      Def ("name_error",          Name_Name_Error);
+      Def ("mode_error",          Name_Mode_Error);
+      Def ("foreign",             Name_Foreign);
+
+      Def ("boolean_vector",      Name_Boolean_Vector);
+      Def ("to_bstring",          Name_To_Bstring);
+      Def ("to_binary_string",    Name_To_Binary_String);
+      Def ("to_ostring",          Name_To_Ostring);
+      Def ("to_octal_string",     Name_To_Octal_String);
+      Def ("to_hstring",          Name_To_Hstring);
+      Def ("to_hex_string",       Name_To_Hex_String);
+      Def ("integer_vector",      Name_Integer_Vector);
+      Def ("real_vector",         Name_Real_Vector);
+      Def ("time_vector",         Name_Time_Vector);
+      Def ("digits",              Name_Digits);
+      Def ("format",              Name_Format);
+      Def ("unit",                Name_Unit);
+
+      Def ("domain_type",         Name_Domain_Type);
+      Def ("quiescent_domain",    Name_Quiescent_Domain);
+      Def ("time_domain",         Name_Time_Domain);
+      Def ("frequency_domain",    Name_Frequency_Domain);
+      Def ("domain",              Name_Domain);
+      Def ("frequency",           Name_Frequency);
+      Def ("real_vector",         Name_Real_Vector);
+
+      Def ("nul", Name_Nul);
+      Def ("soh", Name_Soh);
+      Def ("stx", Name_Stx);
+      Def ("etx", Name_Etx);
+      Def ("eot", Name_Eot);
+      Def ("enq", Name_Enq);
+      Def ("ack", Name_Ack);
+      Def ("bel", Name_Bel);
+      Def ("bs",  Name_Bs);
+      Def ("ht",  Name_Ht);
+      Def ("lf",  Name_Lf);
+      Def ("vt",  Name_Vt);
+      Def ("ff",  Name_Ff);
+      Def ("cr",  Name_Cr);
+      Def ("so",  Name_So);
+      Def ("si",  Name_Si);
+      Def ("dle", Name_Dle);
+      Def ("dc1", Name_Dc1);
+      Def ("dc2", Name_Dc2);
+      Def ("dc3", Name_Dc3);
+      Def ("dc4", Name_Dc4);
+      Def ("nak", Name_Nak);
+      Def ("syn", Name_Syn);
+      Def ("etb", Name_Etb);
+      Def ("can", Name_Can);
+      Def ("em",  Name_Em);
+      Def ("sub", Name_Sub);
+      Def ("esc", Name_Esc);
+      Def ("fsp", Name_Fsp);
+      Def ("gsp", Name_Gsp);
+      Def ("rsp", Name_Rsp);
+      Def ("usp", Name_Usp);
+      Def ("del", Name_Del);
+
+      Def ("c128", Name_C128);
+      Def ("c129", Name_C129);
+      Def ("c130", Name_C130);
+      Def ("c131", Name_C131);
+      Def ("c132", Name_C132);
+      Def ("c133", Name_C133);
+      Def ("c134", Name_C134);
+      Def ("c135", Name_C135);
+      Def ("c136", Name_C136);
+      Def ("c137", Name_C137);
+      Def ("c138", Name_C138);
+      Def ("c139", Name_C139);
+      Def ("c140", Name_C140);
+      Def ("c141", Name_C141);
+      Def ("c142", Name_C142);
+      Def ("c143", Name_C143);
+      Def ("c144", Name_C144);
+      Def ("c145", Name_C145);
+      Def ("c146", Name_C146);
+      Def ("c147", Name_C147);
+      Def ("c148", Name_C148);
+      Def ("c149", Name_C149);
+      Def ("c150", Name_C150);
+      Def ("c151", Name_C151);
+      Def ("c152", Name_C152);
+      Def ("c153", Name_C153);
+      Def ("c154", Name_C154);
+      Def ("c155", Name_C155);
+      Def ("c156", Name_C156);
+      Def ("c157", Name_C157);
+      Def ("c158", Name_C158);
+      Def ("c159", Name_C159);
+
+      -- Create misc.
+      Def ("guard",                 Name_Guard);
+      Def ("deallocate",            Name_Deallocate);
+      Def ("file_open",             Name_File_Open);
+      Def ("file_close",            Name_File_Close);
+      Def ("read",                  Name_Read);
+      Def ("write",                 Name_Write);
+      Def ("flush",                 Name_Flush);
+      Def ("endfile",               Name_Endfile);
+      Def ("p",                     Name_P);
+      Def ("f",                     Name_F);
+      Def ("l",                     Name_L);
+      Def ("r",                     Name_R);
+      Def ("s",                     Name_S);
+      Def ("external_name",         Name_External_Name);
+      Def ("open_kind",             Name_Open_Kind);
+      Def ("status",                Name_Status);
+      Def ("first",                 Name_First);
+      Def ("last",                  Name_Last);
+      Def ("textio",                Name_Textio);
+      Def ("work",                  Name_Work);
+      Def ("text",                  Name_Text);
+      Def ("to_string",             Name_To_String);
+      Def ("minimum",               Name_Minimum);
+      Def ("maximum",               Name_Maximum);
+      Def ("untruncated_text_read", Name_Untruncated_Text_Read);
+      Def ("get_resolution_limit",  Name_Get_Resolution_Limit);
+      Def ("control_simulation",    Name_Control_Simulation);
+
+      Def ("ieee",              Name_Ieee);
+      Def ("std_logic_1164",    Name_Std_Logic_1164);
+      Def ("std_ulogic",        Name_Std_Ulogic);
+      Def ("std_ulogic_vector", Name_Std_Ulogic_Vector);
+      Def ("std_logic",         Name_Std_Logic);
+      Def ("std_logic_vector",  Name_Std_Logic_Vector);
+      Def ("rising_edge",       Name_Rising_Edge);
+      Def ("falling_edge",      Name_Falling_Edge);
+      Def ("vital_timing",      Name_VITAL_Timing);
+      Def ("vital_level0",      Name_VITAL_Level0);
+      Def ("vital_level1",      Name_VITAL_Level1);
+
+      --  Verilog keywords
+      Def ("always",       Name_Always);
+      Def ("assign",       Name_Assign);
+      Def ("buf",          Name_Buf);
+      Def ("bufif0",       Name_Bufif0);
+      Def ("bufif1",       Name_Bufif1);
+      Def ("casex",        Name_Casex);
+      Def ("casez",        Name_Casez);
+      Def ("cmos",         Name_Cmos);
+      Def ("deassign",     Name_Deassign);
+      Def ("default",      Name_Default);
+      Def ("defparam",     Name_Defparam);
+      Def ("disable",      Name_Disable);
+      Def ("endcase",      Name_Endcase);
+      Def ("endfunction",  Name_Endfunction);
+      Def ("endmodule",    Name_Endmodule);
+      Def ("endprimitive", Name_Endprimitive);
+      Def ("endspecify",   Name_Endspecify);
+      Def ("endtable",     Name_Endtable);
+      Def ("endtask",      Name_Endtask);
+      Def ("forever",      Name_Forever);
+      Def ("fork",         Name_Fork);
+      Def ("highz0",       Name_Highz0);
+      Def ("highz1",       Name_Highz1);
+      Def ("initial",      Name_Initial);
+      Def ("input",        Name_Input);
+      Def ("join",         Name_Join);
+      Def ("large",        Name_Large);
+      Def ("medium",       Name_Medium);
+      Def ("module",       Name_Module);
+      Def ("negedge",      Name_Negedge);
+      Def ("nmos",         Name_Nmos);
+      Def ("notif0",       Name_Notif0);
+      Def ("notif1",       Name_Notif1);
+      Def ("output",       Name_Output);
+      Def ("parameter",    Name_Parameter);
+      Def ("pmos",         Name_Pmos);
+      Def ("posedge",      Name_Posedge);
+      Def ("primitive",    Name_Primitive);
+      Def ("pull0",        Name_Pull0);
+      Def ("pull1",        Name_Pull1);
+      Def ("pulldown",     Name_Pulldown);
+      Def ("pullup",       Name_Pullup);
+      Def ("reg",          Name_Reg);
+      Def ("repeat",       Name_Repeat);
+      Def ("rcmos",        Name_Rcmos);
+      Def ("rnmos",        Name_Rnmos);
+      Def ("rpmos",        Name_Rpmos);
+      Def ("rtran",        Name_Rtran);
+      Def ("rtranif0",     Name_Rtranif0);
+      Def ("rtranif1",     Name_Rtranif1);
+      Def ("small",        Name_Small);
+      Def ("specify",      Name_Specify);
+      Def ("specparam",    Name_Specparam);
+      Def ("strong0",      Name_Strong0);
+      Def ("strong1",      Name_Strong1);
+      Def ("supply0",      Name_Supply0);
+      Def ("supply1",      Name_Supply1);
+      Def ("table",        Name_Tablex);
+      Def ("task",         Name_Task);
+      Def ("tran",         Name_Tran);
+      Def ("tranif0",      Name_Tranif0);
+      Def ("tranif1",      Name_Tranif1);
+      Def ("tri",          Name_Tri);
+      Def ("tri0",         Name_Tri0);
+      Def ("tri1",         Name_Tri1);
+      Def ("trireg",       Name_Trireg);
+      Def ("wand",         Name_Wand);
+      Def ("weak0",        Name_Weak0);
+      Def ("weak1",        Name_Weak1);
+      Def ("wire",         Name_Wire);
+      Def ("wor",          Name_Wor);
+
+      Def ("define",       Name_Define);
+      Def ("endif",        Name_Endif);
+      Def ("ifdef",        Name_Ifdef);
+      Def ("include",      Name_Include);
+      Def ("timescale",    Name_Timescale);
+      Def ("undef",        Name_Undef);
+
+      --  Verilog system tasks
+      Def ("display", Name_Display);
+      Def ("finish",  Name_Finish);
+
+      --  BSV keywords
+      Def ("Action",         Name_uAction);
+      Def ("ActionValue",    Name_uActionValue);
+      Def ("BVI",            Name_BVI);
+      Def ("C",              Name_uC);
+      Def ("CF",             Name_uCF);
+      Def ("E",              Name_uE);
+      Def ("SB",             Name_uSB);
+      Def ("SBR",            Name_uSBR);
+      Def ("action",         Name_Action);
+      Def ("endaction",      Name_Endaction);
+      Def ("actionvalue",    Name_Actionvalue);
+      Def ("endactionvalue", Name_Endactionvalue);
+      Def ("ancestor",       Name_Ancestor);
+      Def ("clocked_by",     Name_Clocked_By);
+      Def ("continue",       Name_Continue);
+      Def ("default_clock",  Name_Default_Clock);
+      Def ("default_reset",  Name_Default_Reset);
+      Def ("dependencies",   Name_Dependencies);
+      Def ("deriving",       Name_Deriving);
+      Def ("determines",     Name_Determines);
+      Def ("enable",         Name_Enable);
+      Def ("enum",           Name_Enum);
+      Def ("export",         Name_Export);
+      Def ("ifc_inout",      Name_Ifc_Inout);
+      Def ("import",         Name_Import);
+      Def ("input_clock",    Name_Input_Clock);
+      Def ("input_reset",    Name_Input_Reset);
+      Def ("instance",       Name_Instance);
+      Def ("endinstance",    Name_Endinstance);
+      Def ("interface",      Name_Interface);
+      Def ("endinterface",   Name_Endinterface);
+      Def ("let",            Name_Let);
+      Def ("match",          Name_Match);
+      Def ("matches",        Name_Matches);
+      Def ("method",         Name_Method);
+      Def ("endmethod",      Name_Endmethod);
+      Def ("numeric",        Name_Numeric);
+      Def ("output_clock",   Name_Output_Clock);
+      Def ("output_reset",   Name_Output_Reset);
+      Def ("endpackage",     Name_Endpackage);
+      Def ("par",            Name_Par);
+      Def ("endpar",         Name_Endpar);
+      Def ("path",           Name_Path);
+      Def ("provisos",       Name_Provisos);
+      Def ("ready",          Name_Ready);
+      Def ("reset_by",       Name_Reset_By);
+      Def ("rule",           Name_Rule);
+      Def ("endrule",        Name_Endrule);
+      Def ("rules",          Name_Rules);
+      Def ("endrules",       Name_Endrules);
+      Def ("same_family",    Name_Same_Family);
+      Def ("schedule",       Name_Schedule);
+      Def ("seq",            Name_Seq);
+      Def ("endseq",         Name_Endseq);
+      Def ("struct",         Name_Struct);
+      Def ("tagged",         Name_Tagged);
+      Def ("typeclass",      Name_Typeclass);
+      Def ("endtypeclass",   Name_Endtypeclass);
+      Def ("typedef",        Name_Typedef);
+      Def ("union",          Name_Union);
+      Def ("valueof",        Name_Valueof);
+      Def ("valueOf",        Name_uValueof);
+      Def ("void",           Name_Void);
+
+      --  VHDL special comments
+      Def ("psl",    Name_Psl);
+      Def ("pragma", Name_Pragma);
+
+      --  PSL keywords
+      Def ("a",                  Name_A);
+      Def ("af",                 Name_Af);
+      Def ("ag",                 Name_Ag);
+      Def ("ax",                 Name_Ax);
+      Def ("abort",              Name_Abort);
+      Def ("assume",             Name_Assume);
+      Def ("assume_guarantee",   Name_Assume_Guarantee);
+      Def ("before",             Name_Before);
+      Def ("clock",              Name_Clock);
+      Def ("const",              Name_Const);
+      Def ("cover",              Name_Cover);
+      Def ("e",                  Name_E);
+      Def ("ef",                 Name_Ef);
+      Def ("eg",                 Name_Eg);
+      Def ("ex",                 Name_Ex);
+      Def ("endpoint",           Name_Endpoint);
+      Def ("eventually",         Name_Eventually);
+      Def ("fairness",           Name_Fairness);
+      Def ("fell ",              Name_Fell);
+      Def ("forall",             Name_Forall);
+      Def ("g",                  Name_G);
+      Def ("inf",                Name_Inf);
+      Def ("inherit",            Name_Inherit);
+      Def ("never",              Name_Never);
+      Def ("next_a",             Name_Next_A);
+      Def ("next_e",             Name_Next_E);
+      Def ("next_event",         Name_Next_Event);
+      Def ("next_event_a",       Name_Next_Event_A);
+      Def ("next_event_e",       Name_Next_Event_E);
+      Def ("property",           Name_Property);
+      Def ("prev",               Name_Prev);
+      Def ("restrict",           Name_Restrict);
+      Def ("restrict_guarantee", Name_Restrict_Guarantee);
+      Def ("rose",               Name_Rose);
+      Def ("sequence",           Name_Sequence);
+      Def ("strong",             Name_Strong);
+      Def ("union",              Name_Union);
+      Def ("vmode",              Name_Vmode);
+      Def ("vprop",              Name_Vprop);
+      Def ("vunit",              Name_Vunit);
+      Def ("w",                  Name_W);
+      Def ("whilenot",           Name_Whilenot);
+      Def ("within",             Name_Within);
+      Def ("x",                  Name_X);
+   end Std_Names_Initialize;
+end Std_Names;
diff --git a/src/std_names.ads b/src/std_names.ads
new file mode 100644
index 000000000..0a44c91c0
--- /dev/null
+++ b/src/std_names.ads
@@ -0,0 +1,727 @@
+--  Well known name table entries.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+
+-- Note: since all identifiers declared in this package begins with either
+-- std_names or name, this package is expected to be use'd.
+
+package Std_Names is
+   -- Predefined names.
+   Name_First_Character : constant Name_Id := 1;
+   Name_Last_Character : constant Name_Id :=
+     Name_First_Character + Character'Pos (Character'Last)
+     - Character'Pos (Character'First);
+   subtype Name_Characters is Name_Id
+     range Name_First_Character .. Name_Last_Character;
+
+   Name_First_Keyword : constant Name_Id := Name_Last_Character + 1;
+
+   --  Word operators.
+   Name_Mod :            constant Name_Id := Name_First_Keyword + 000;
+   Name_Rem :            constant Name_Id := Name_First_Keyword + 001;
+
+   Name_And :            constant Name_Id := Name_First_Keyword + 002;
+   Name_Or :             constant Name_Id := Name_First_Keyword + 003;
+   Name_Xor :            constant Name_Id := Name_First_Keyword + 004;
+   Name_Nand :           constant Name_Id := Name_First_Keyword + 005;
+   Name_Nor :            constant Name_Id := Name_First_Keyword + 006;
+
+   Name_Abs :            constant Name_Id := Name_First_Keyword + 007;
+   Name_Not :            constant Name_Id := Name_First_Keyword + 008;
+
+   subtype Name_Logical_Operators is Name_Id range Name_And .. Name_Nor;
+   subtype Name_Word_Operators is Name_Id range Name_Mod .. Name_Not;
+
+   Name_Access :         constant Name_Id := Name_First_Keyword + 009;
+   Name_After :          constant Name_Id := Name_First_Keyword + 010;
+   Name_Alias :          constant Name_Id := Name_First_Keyword + 011;
+   Name_All :            constant Name_Id := Name_First_Keyword + 012;
+   Name_Architecture :   constant Name_Id := Name_First_Keyword + 013;
+   Name_Array :          constant Name_Id := Name_First_Keyword + 014;
+   Name_Assert :         constant Name_Id := Name_First_Keyword + 015;
+   Name_Attribute :      constant Name_Id := Name_First_Keyword + 016;
+
+   Name_Begin :          constant Name_Id := Name_First_Keyword + 017;
+   Name_Block :          constant Name_Id := Name_First_Keyword + 018;
+   Name_Body :           constant Name_Id := Name_First_Keyword + 019;
+   Name_Buffer :         constant Name_Id := Name_First_Keyword + 020;
+   Name_Bus :            constant Name_Id := Name_First_Keyword + 021;
+
+   Name_Case :           constant Name_Id := Name_First_Keyword + 022;
+   Name_Component :      constant Name_Id := Name_First_Keyword + 023;
+   Name_Configuration :  constant Name_Id := Name_First_Keyword + 024;
+   Name_Constant :       constant Name_Id := Name_First_Keyword + 025;
+
+   Name_Disconnect :     constant Name_Id := Name_First_Keyword + 026;
+   Name_Downto :         constant Name_Id := Name_First_Keyword + 027;
+
+   Name_Else :           constant Name_Id := Name_First_Keyword + 028;
+   Name_Elsif :          constant Name_Id := Name_First_Keyword + 029;
+   Name_End :            constant Name_Id := Name_First_Keyword + 030;
+   Name_Entity :         constant Name_Id := Name_First_Keyword + 031;
+   Name_Exit :           constant Name_Id := Name_First_Keyword + 032;
+
+   Name_File :           constant Name_Id := Name_First_Keyword + 033;
+   Name_For :            constant Name_Id := Name_First_Keyword + 034;
+   Name_Function :       constant Name_Id := Name_First_Keyword + 035;
+
+   Name_Generate :       constant Name_Id := Name_First_Keyword + 036;
+   Name_Generic :        constant Name_Id := Name_First_Keyword + 037;
+   Name_Guarded :        constant Name_Id := Name_First_Keyword + 038;
+
+   Name_If :             constant Name_Id := Name_First_Keyword + 039;
+   Name_In :             constant Name_Id := Name_First_Keyword + 040;
+   Name_Inout :          constant Name_Id := Name_First_Keyword + 041;
+   Name_Is :             constant Name_Id := Name_First_Keyword + 042;
+
+   Name_Label :          constant Name_Id := Name_First_Keyword + 043;
+   Name_Library :        constant Name_Id := Name_First_Keyword + 044;
+   Name_Linkage :        constant Name_Id := Name_First_Keyword + 045;
+   Name_Loop :           constant Name_Id := Name_First_Keyword + 046;
+
+   Name_Map :            constant Name_Id := Name_First_Keyword + 047;
+
+   Name_New :            constant Name_Id := Name_First_Keyword + 048;
+   Name_Next :           constant Name_Id := Name_First_Keyword + 049;
+   Name_Null :           constant Name_Id := Name_First_Keyword + 050;
+
+   Name_Of :             constant Name_Id := Name_First_Keyword + 051;
+   Name_On :             constant Name_Id := Name_First_Keyword + 052;
+   Name_Open :           constant Name_Id := Name_First_Keyword + 053;
+   Name_Others :         constant Name_Id := Name_First_Keyword + 054;
+   Name_Out :            constant Name_Id := Name_First_Keyword + 055;
+
+   Name_Package :        constant Name_Id := Name_First_Keyword + 056;
+   Name_Port :           constant Name_Id := Name_First_Keyword + 057;
+   Name_Procedure :      constant Name_Id := Name_First_Keyword + 058;
+   Name_Process :        constant Name_Id := Name_First_Keyword + 059;
+
+   Name_Range :          constant Name_Id := Name_First_Keyword + 060;
+   Name_Record :         constant Name_Id := Name_First_Keyword + 061;
+   Name_Register :       constant Name_Id := Name_First_Keyword + 062;
+   Name_Report :         constant Name_Id := Name_First_Keyword + 063;
+   Name_Return :         constant Name_Id := Name_First_Keyword + 064;
+
+   Name_Select :         constant Name_Id := Name_First_Keyword + 065;
+   Name_Severity :       constant Name_Id := Name_First_Keyword + 066;
+   Name_Signal :         constant Name_Id := Name_First_Keyword + 067;
+   Name_Subtype :        constant Name_Id := Name_First_Keyword + 068;
+
+   Name_Then :           constant Name_Id := Name_First_Keyword + 069;
+   Name_To :             constant Name_Id := Name_First_Keyword + 070;
+   Name_Transport :      constant Name_Id := Name_First_Keyword + 071;
+   Name_Type :           constant Name_Id := Name_First_Keyword + 072;
+
+   Name_Units :          constant Name_Id := Name_First_Keyword + 073;
+   Name_Until :          constant Name_Id := Name_First_Keyword + 074;
+   Name_Use :            constant Name_Id := Name_First_Keyword + 075;
+
+   Name_Variable :       constant Name_Id := Name_First_Keyword + 076;
+
+   Name_Wait :           constant Name_Id := Name_First_Keyword + 077;
+   Name_When :           constant Name_Id := Name_First_Keyword + 078;
+   Name_While :          constant Name_Id := Name_First_Keyword + 079;
+   Name_With :           constant Name_Id := Name_First_Keyword + 080;
+
+   Name_Last_Vhdl87 :    constant Name_Id := Name_With;
+   subtype Name_Id_Vhdl87_Reserved_Words is
+     Name_Id range Name_First_Keyword .. Name_With;
+
+   -- VHDL93 reserved words.
+   Name_Xnor :           constant Name_Id := Name_First_Keyword + 081;
+   Name_Group :          constant Name_Id := Name_First_Keyword + 082;
+   Name_Impure :         constant Name_Id := Name_First_Keyword + 083;
+   Name_Inertial :       constant Name_Id := Name_First_Keyword + 084;
+   Name_Literal :        constant Name_Id := Name_First_Keyword + 085;
+   Name_Postponed :      constant Name_Id := Name_First_Keyword + 086;
+   Name_Pure :           constant Name_Id := Name_First_Keyword + 087;
+   Name_Reject :         constant Name_Id := Name_First_Keyword + 088;
+   Name_Shared :         constant Name_Id := Name_First_Keyword + 089;
+   Name_Unaffected :     constant Name_Id := Name_First_Keyword + 090;
+
+   Name_Sll :            constant Name_Id := Name_First_Keyword + 091;
+   Name_Sla :            constant Name_Id := Name_First_Keyword + 092;
+   Name_Sra :            constant Name_Id := Name_First_Keyword + 093;
+   Name_Srl :            constant Name_Id := Name_First_Keyword + 094;
+   Name_Rol :            constant Name_Id := Name_First_Keyword + 095;
+   Name_Ror :            constant Name_Id := Name_First_Keyword + 096;
+   subtype Name_Shift_Operators is Name_Id range Name_Sll .. Name_Ror;
+
+   Name_Last_Vhdl93 :    constant Name_Id := Name_Ror;
+   subtype Name_Id_Vhdl93_Reserved_Words is
+     Name_Id range Name_Xnor .. Name_Ror;
+
+   Name_Protected :      constant Name_Id := Name_First_Keyword + 097;
+
+   Name_Last_Vhdl00 :    constant Name_Id := Name_Protected;
+   subtype Name_Id_Vhdl00_Reserved_Words is
+     Name_Id range Name_Protected .. Name_Protected;
+
+   Name_Across :         constant Name_Id := Name_First_Keyword + 098;
+   Name_Break :          constant Name_Id := Name_First_Keyword + 099;
+   Name_Limit :          constant Name_Id := Name_First_Keyword + 100;
+   Name_Nature :         constant Name_Id := Name_First_Keyword + 101;
+   Name_Noise :          constant Name_Id := Name_First_Keyword + 102;
+   Name_Procedural :     constant Name_Id := Name_First_Keyword + 103;
+   Name_Quantity :       constant Name_Id := Name_First_Keyword + 104;
+   Name_Reference :      constant Name_Id := Name_First_Keyword + 105;
+   Name_Spectrum :       constant Name_Id := Name_First_Keyword + 106;
+   Name_Subnature :      constant Name_Id := Name_First_Keyword + 107;
+   Name_Terminal :       constant Name_Id := Name_First_Keyword + 108;
+   Name_Through :        constant Name_Id := Name_First_Keyword + 109;
+   Name_Tolerance :      constant Name_Id := Name_First_Keyword + 110;
+
+   Name_Last_AMS_Vhdl :  constant Name_Id := Name_Tolerance;
+
+   subtype Name_Id_AMS_Reserved_Words is
+     Name_Id range Name_Across .. Name_Tolerance;
+
+   Name_Last_Keyword :   constant Name_Id := Name_Tolerance;
+
+   subtype Name_Id_Keywords is
+     Name_Id range Name_First_Keyword .. Name_Last_Keyword;
+
+   Name_First_Operator :   constant Name_Id := Name_Last_Keyword + 1;
+   Name_Op_Equality :      constant Name_Id := Name_First_Operator + 000;
+   Name_Op_Inequality :    constant Name_Id := Name_First_Operator + 001;
+   Name_Op_Less :          constant Name_Id := Name_First_Operator + 002;
+   Name_Op_Less_Equal :    constant Name_Id := Name_First_Operator + 003;
+   Name_Op_Greater :       constant Name_Id := Name_First_Operator + 004;
+   Name_Op_Greater_Equal : constant Name_Id := Name_First_Operator + 5;
+   Name_Op_Plus :          constant Name_Id := Name_First_Operator + 006;
+   Name_Op_Minus :         constant Name_Id := Name_First_Operator + 007;
+   Name_Op_Mul :           constant Name_Id := Name_First_Operator + 008;
+   Name_Op_Div :           constant Name_Id := Name_First_Operator + 009;
+   Name_Op_Exp :           constant Name_Id := Name_First_Operator + 010;
+   Name_Op_Concatenation : constant Name_Id := Name_First_Operator + 011;
+   Name_Op_Condition :     constant Name_Id := Name_First_Operator + 012;
+   Name_Op_Match_Equality :      constant Name_Id := Name_First_Operator + 013;
+   Name_Op_Match_Inequality :    constant Name_Id := Name_First_Operator + 014;
+   Name_Op_Match_Less :          constant Name_Id := Name_First_Operator + 015;
+   Name_Op_Match_Less_Equal :    constant Name_Id := Name_First_Operator + 016;
+   Name_Op_Match_Greater :       constant Name_Id := Name_First_Operator + 017;
+   Name_Op_Match_Greater_Equal : constant Name_Id := Name_First_Operator + 018;
+   Name_Last_Operator :  constant Name_Id := Name_Op_Match_Greater_Equal;
+
+   subtype Name_Relational_Operators is Name_Id
+     range Name_Op_Equality .. Name_Op_Greater_Equal;
+
+   --  List of symbolic operators (available as string).
+   subtype Name_Id_Operators is Name_Id
+     range Name_First_Operator .. Name_Last_Operator;
+
+   Name_First_Attribute : constant Name_Id := Name_Last_Operator + 1;
+   Name_Base :           constant Name_Id := Name_First_Attribute + 000;
+   Name_Left :           constant Name_Id := Name_First_Attribute + 001;
+   Name_Right :          constant Name_Id := Name_First_Attribute + 002;
+   Name_High :           constant Name_Id := Name_First_Attribute + 003;
+   Name_Low :            constant Name_Id := Name_First_Attribute + 004;
+   Name_Pos :            constant Name_Id := Name_First_Attribute + 005;
+   Name_Val :            constant Name_Id := Name_First_Attribute + 006;
+   Name_Succ :           constant Name_Id := Name_First_Attribute + 007;
+   Name_Pred :           constant Name_Id := Name_First_Attribute + 008;
+   Name_Leftof :         constant Name_Id := Name_First_Attribute + 009;
+   Name_Rightof :        constant Name_Id := Name_First_Attribute + 010;
+   Name_Reverse_Range :  constant Name_Id := Name_First_Attribute + 011;
+   Name_Length :         constant Name_Id := Name_First_Attribute + 012;
+   Name_Delayed :        constant Name_Id := Name_First_Attribute + 013;
+   Name_Stable :         constant Name_Id := Name_First_Attribute + 014;
+   Name_Quiet :          constant Name_Id := Name_First_Attribute + 015;
+   Name_Transaction :    constant Name_Id := Name_First_Attribute + 016;
+   Name_Event :          constant Name_Id := Name_First_Attribute + 017;
+   Name_Active :         constant Name_Id := Name_First_Attribute + 018;
+   Name_Last_Event :     constant Name_Id := Name_First_Attribute + 019;
+   Name_Last_Active :    constant Name_Id := Name_First_Attribute + 020;
+   Name_Last_Value :     constant Name_Id := Name_First_Attribute + 021;
+   Name_Last_Attribute : constant Name_Id := Name_Last_Value;
+
+   subtype Name_Id_Attributes is Name_Id
+     range Name_First_Attribute ..Name_Last_Attribute;
+
+   Name_First_Vhdl87_Attribute : constant Name_Id := Name_Last_Value + 1;
+   Name_Behavior :       constant Name_Id := Name_First_Attribute + 022;
+   Name_Structure :      constant Name_Id := Name_First_Attribute + 023;
+   Name_Last_Vhdl87_Attribute : constant Name_Id := Name_Structure;
+
+   subtype Name_Id_Vhdl87_Attributes is Name_Id
+     range Name_First_Vhdl87_Attribute ..Name_Last_Vhdl87_Attribute;
+
+   Name_First_Vhdl93_Attribute : constant Name_Id := Name_Structure + 1;
+   Name_Ascending :      constant Name_Id := Name_First_Attribute + 024;
+   Name_Image :          constant Name_Id := Name_First_Attribute + 025;
+   Name_Value :          constant Name_Id := Name_First_Attribute + 026;
+   Name_Driving :        constant Name_Id := Name_First_Attribute + 027;
+   Name_Driving_Value :  constant Name_Id := Name_First_Attribute + 028;
+   Name_Simple_Name :    constant Name_Id := Name_First_Attribute + 029;
+   Name_Instance_Name :  constant Name_Id := Name_First_Attribute + 030;
+   Name_Path_Name :      constant Name_Id := Name_First_Attribute + 031;
+   Name_Last_Vhdl93_Attribute : constant Name_Id := Name_Path_Name;
+
+   subtype Name_Id_Vhdl93_Attributes is Name_Id
+     range Name_First_Vhdl93_Attribute ..Name_Last_Vhdl93_Attribute;
+
+   Name_First_AMS_Attribute : constant Name_Id :=
+     Name_Last_Vhdl93_Attribute + 1;
+   Name_Contribution :   constant Name_Id := Name_First_AMS_Attribute + 000;
+   Name_Dot :            constant Name_Id := Name_First_AMS_Attribute + 001;
+   Name_Integ :          constant Name_Id := Name_First_AMS_Attribute + 002;
+   Name_Above :          constant Name_Id := Name_First_AMS_Attribute + 003;
+   Name_ZOH :            constant Name_Id := Name_First_AMS_Attribute + 004;
+   Name_LTF :            constant Name_Id := Name_First_AMS_Attribute + 005;
+   Name_ZTF :            constant Name_Id := Name_First_AMS_Attribute + 006;
+   Name_Ramp :           constant Name_Id := Name_First_AMS_Attribute + 007;
+   Name_Slew :           constant Name_Id := Name_First_AMS_Attribute + 008;
+   Name_Last_AMS_Attribute : constant Name_Id := Name_Slew;
+
+   subtype Name_Id_Name_Attributes is Name_Id
+     range Name_Simple_Name .. Name_Path_Name;
+
+   --  Names used in std.standard package.
+   Name_First_Standard : constant Name_Id := Name_Last_AMS_Attribute + 1;
+   Name_Std :            constant Name_Id := Name_First_Standard + 000;
+   Name_Standard :       constant Name_Id := Name_First_Standard + 001;
+   Name_Boolean :        constant Name_Id := Name_First_Standard + 002;
+   Name_False :          constant Name_Id := Name_First_Standard + 003;
+   Name_True :           constant Name_Id := Name_First_Standard + 004;
+   Name_Bit :            constant Name_Id := Name_First_Standard + 005;
+   Name_Character :      constant Name_Id := Name_First_Standard + 006;
+   Name_Severity_Level : constant Name_Id := Name_First_Standard + 007;
+   Name_Note :           constant Name_Id := Name_First_Standard + 008;
+   Name_Warning :        constant Name_Id := Name_First_Standard + 009;
+   Name_Error :          constant Name_Id := Name_First_Standard + 010;
+   Name_Failure :        constant Name_Id := Name_First_Standard + 011;
+   Name_Universal_Integer : constant Name_Id := Name_First_Standard + 012;
+   Name_Universal_Real : constant Name_Id := Name_First_Standard + 013;
+   Name_Convertible_Integer : constant Name_Id := Name_First_Standard + 014;
+   Name_Convertible_Real : constant Name_Id := Name_First_Standard + 015;
+   Name_Integer :        constant Name_Id := Name_First_Standard + 016;
+   Name_Real :           constant Name_Id := Name_First_Standard + 017;
+   Name_Time :           constant Name_Id := Name_First_Standard + 018;
+   Name_Fs :             constant Name_Id := Name_First_Standard + 019;
+   Name_Ps :             constant Name_Id := Name_First_Standard + 020;
+   Name_Ns :             constant Name_Id := Name_First_Standard + 021;
+   Name_Us :             constant Name_Id := Name_First_Standard + 022;
+   Name_Ms :             constant Name_Id := Name_First_Standard + 023;
+   Name_Sec :            constant Name_Id := Name_First_Standard + 024;
+   Name_Min :            constant Name_Id := Name_First_Standard + 025;
+   Name_Hr :             constant Name_Id := Name_First_Standard + 026;
+   Name_Delay_Length :   constant Name_Id := Name_First_Standard + 027;
+   Name_Now :            constant Name_Id := Name_First_Standard + 028;
+   Name_Natural :        constant Name_Id := Name_First_Standard + 029;
+   Name_Positive :       constant Name_Id := Name_First_Standard + 030;
+   Name_String :         constant Name_Id := Name_First_Standard + 031;
+   Name_Bit_Vector :     constant Name_Id := Name_First_Standard + 032;
+   Name_File_Open_Kind : constant Name_Id := Name_First_Standard + 033;
+   Name_Read_Mode :      constant Name_Id := Name_First_Standard + 034;
+   Name_Write_Mode :     constant Name_Id := Name_First_Standard + 035;
+   Name_Append_Mode :    constant Name_Id := Name_First_Standard + 036;
+   Name_File_Open_Status : constant Name_Id := Name_First_Standard + 037;
+   Name_Open_Ok :        constant Name_Id := Name_First_Standard + 038;
+   Name_Status_Error :   constant Name_Id := Name_First_Standard + 039;
+   Name_Name_Error :     constant Name_Id := Name_First_Standard + 040;
+   Name_Mode_Error :     constant Name_Id := Name_First_Standard + 041;
+   Name_Foreign :        constant Name_Id := Name_First_Standard + 042;
+
+   --  Added by VHDL 08
+   Name_Boolean_Vector :   constant Name_Id := Name_First_Standard + 043;
+   Name_To_Bstring :       constant Name_Id := Name_First_Standard + 044;
+   Name_To_Binary_String : constant Name_Id := Name_First_Standard + 045;
+   Name_To_Ostring :       constant Name_Id := Name_First_Standard + 046;
+   Name_To_Octal_String :  constant Name_Id := Name_First_Standard + 047;
+   Name_To_Hstring :       constant Name_Id := Name_First_Standard + 048;
+   Name_To_Hex_String :    constant Name_Id := Name_First_Standard + 049;
+   Name_Integer_Vector :   constant Name_Id := Name_First_Standard + 050;
+   Name_Real_Vector :      constant Name_Id := Name_First_Standard + 051;
+   Name_Time_Vector :      constant Name_Id := Name_First_Standard + 052;
+   Name_Digits      :      constant Name_Id := Name_First_Standard + 053;
+   Name_Format      :      constant Name_Id := Name_First_Standard + 054;
+   Name_Unit        :      constant Name_Id := Name_First_Standard + 055;
+
+   --  Added by AMS vhdl.
+   Name_Domain_Type :      constant Name_Id := Name_First_Standard + 056;
+   Name_Quiescent_Domain : constant Name_Id := Name_First_Standard + 057;
+   Name_Time_Domain :      constant Name_Id := Name_First_Standard + 058;
+   Name_Frequency_Domain : constant Name_Id := Name_First_Standard + 059;
+   Name_Domain :           constant Name_Id := Name_First_Standard + 060;
+   Name_Frequency :        constant Name_Id := Name_First_Standard + 061;
+
+   Name_Last_Standard :  constant Name_Id := Name_Frequency;
+
+   Name_First_Charname : constant Name_Id := Name_Last_Standard + 1;
+   Name_Nul :            constant Name_Id := Name_First_Charname + 00;
+   Name_Soh :            constant Name_Id := Name_First_Charname + 01;
+   Name_Stx :            constant Name_Id := Name_First_Charname + 02;
+   Name_Etx :            constant Name_Id := Name_First_Charname + 03;
+   Name_Eot :            constant Name_Id := Name_First_Charname + 04;
+   Name_Enq :            constant Name_Id := Name_First_Charname + 05;
+   Name_Ack :            constant Name_Id := Name_First_Charname + 06;
+   Name_Bel :            constant Name_Id := Name_First_Charname + 07;
+   Name_Bs :             constant Name_Id := Name_First_Charname + 08;
+   Name_Ht :             constant Name_Id := Name_First_Charname + 09;
+   Name_Lf :             constant Name_Id := Name_First_Charname + 10;
+   Name_Vt :             constant Name_Id := Name_First_Charname + 11;
+   Name_Ff :             constant Name_Id := Name_First_Charname + 12;
+   Name_Cr :             constant Name_Id := Name_First_Charname + 13;
+   Name_So :             constant Name_Id := Name_First_Charname + 14;
+   Name_Si :             constant Name_Id := Name_First_Charname + 15;
+   Name_Dle :            constant Name_Id := Name_First_Charname + 16;
+   Name_Dc1 :            constant Name_Id := Name_First_Charname + 17;
+   Name_Dc2 :            constant Name_Id := Name_First_Charname + 18;
+   Name_Dc3 :            constant Name_Id := Name_First_Charname + 19;
+   Name_Dc4 :            constant Name_Id := Name_First_Charname + 20;
+   Name_Nak :            constant Name_Id := Name_First_Charname + 21;
+   Name_Syn :            constant Name_Id := Name_First_Charname + 22;
+   Name_Etb :            constant Name_Id := Name_First_Charname + 23;
+   Name_Can :            constant Name_Id := Name_First_Charname + 24;
+   Name_Em :             constant Name_Id := Name_First_Charname + 25;
+   Name_Sub :            constant Name_Id := Name_First_Charname + 26;
+   Name_Esc :            constant Name_Id := Name_First_Charname + 27;
+   Name_Fsp :            constant Name_Id := Name_First_Charname + 28;
+   Name_Gsp :            constant Name_Id := Name_First_Charname + 29;
+   Name_Rsp :            constant Name_Id := Name_First_Charname + 30;
+   Name_Usp :            constant Name_Id := Name_First_Charname + 31;
+
+   Name_Del :            constant Name_Id := Name_First_Charname + 32;
+
+   Name_C128 :           constant Name_Id := Name_First_Charname + 33;
+   Name_C129 :           constant Name_Id := Name_First_Charname + 34;
+   Name_C130 :           constant Name_Id := Name_First_Charname + 35;
+   Name_C131 :           constant Name_Id := Name_First_Charname + 36;
+   Name_C132 :           constant Name_Id := Name_First_Charname + 37;
+   Name_C133 :           constant Name_Id := Name_First_Charname + 38;
+   Name_C134 :           constant Name_Id := Name_First_Charname + 39;
+   Name_C135 :           constant Name_Id := Name_First_Charname + 40;
+   Name_C136 :           constant Name_Id := Name_First_Charname + 41;
+   Name_C137 :           constant Name_Id := Name_First_Charname + 42;
+   Name_C138 :           constant Name_Id := Name_First_Charname + 43;
+   Name_C139 :           constant Name_Id := Name_First_Charname + 44;
+   Name_C140 :           constant Name_Id := Name_First_Charname + 45;
+   Name_C141 :           constant Name_Id := Name_First_Charname + 46;
+   Name_C142 :           constant Name_Id := Name_First_Charname + 47;
+   Name_C143 :           constant Name_Id := Name_First_Charname + 48;
+   Name_C144 :           constant Name_Id := Name_First_Charname + 49;
+   Name_C145 :           constant Name_Id := Name_First_Charname + 50;
+   Name_C146 :           constant Name_Id := Name_First_Charname + 51;
+   Name_C147 :           constant Name_Id := Name_First_Charname + 52;
+   Name_C148 :           constant Name_Id := Name_First_Charname + 53;
+   Name_C149 :           constant Name_Id := Name_First_Charname + 54;
+   Name_C150 :           constant Name_Id := Name_First_Charname + 55;
+   Name_C151 :           constant Name_Id := Name_First_Charname + 56;
+   Name_C152 :           constant Name_Id := Name_First_Charname + 57;
+   Name_C153 :           constant Name_Id := Name_First_Charname + 58;
+   Name_C154 :           constant Name_Id := Name_First_Charname + 59;
+   Name_C155 :           constant Name_Id := Name_First_Charname + 60;
+   Name_C156 :           constant Name_Id := Name_First_Charname + 61;
+   Name_C157 :           constant Name_Id := Name_First_Charname + 62;
+   Name_C158 :           constant Name_Id := Name_First_Charname + 63;
+   Name_C159 :           constant Name_Id := Name_First_Charname + 64;
+   Name_Last_Charname :  constant Name_Id := Name_C159;
+
+   Name_First_Misc : constant Name_Id := Name_Last_Charname + 1;
+   Name_Guard :          constant Name_Id := Name_First_Misc + 000;
+   Name_Deallocate :     constant Name_Id := Name_First_Misc + 001;
+   Name_File_Open :      constant Name_Id := Name_First_Misc + 002;
+   Name_File_Close :     constant Name_Id := Name_First_Misc + 003;
+   Name_Read :           constant Name_Id := Name_First_Misc + 004;
+   Name_Write :          constant Name_Id := Name_First_Misc + 005;
+   Name_Flush :          constant Name_Id := Name_First_Misc + 006;
+   Name_Endfile :        constant Name_Id := Name_First_Misc + 007;
+   Name_P :              constant Name_Id := Name_First_Misc + 008;
+   Name_F :              constant Name_Id := Name_First_Misc + 009;
+   Name_L :              constant Name_Id := Name_First_Misc + 010;
+   Name_R :              constant Name_Id := Name_First_Misc + 011;
+   Name_S :              constant Name_Id := Name_First_Misc + 012;
+   Name_External_Name :  constant Name_Id := Name_First_Misc + 013;
+   Name_Open_Kind :      constant Name_Id := Name_First_Misc + 014;
+   Name_Status :         constant Name_Id := Name_First_Misc + 015;
+   Name_First :          constant Name_Id := Name_First_Misc + 016;
+   Name_Last :           constant Name_Id := Name_First_Misc + 017;
+   Name_Textio :         constant Name_Id := Name_First_Misc + 018;
+   Name_Work :           constant Name_Id := Name_First_Misc + 019;
+   Name_Text :           constant Name_Id := Name_First_Misc + 020;
+   Name_To_String :      constant Name_Id := Name_First_Misc + 021;
+   Name_Minimum :        constant Name_Id := Name_First_Misc + 022;
+   Name_Maximum :        constant Name_Id := Name_First_Misc + 023;
+   Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 024;
+   Name_Get_Resolution_Limit :  constant Name_Id := Name_First_Misc + 025;
+   Name_Control_Simulation :    constant Name_Id := Name_First_Misc + 026;
+   Name_Last_Misc :      constant Name_Id := Name_Control_Simulation;
+
+   Name_First_Ieee :     constant Name_Id := Name_Last_Misc + 1;
+   Name_Ieee :           constant Name_Id := Name_First_Ieee + 000;
+   Name_Std_Logic_1164 : constant Name_Id := Name_First_Ieee + 001;
+   Name_Std_Ulogic :     constant Name_Id := Name_First_Ieee + 002;
+   Name_Std_Ulogic_Vector : constant Name_Id := Name_First_Ieee + 003;
+   Name_Std_Logic :      constant Name_Id := Name_First_Ieee + 004;
+   Name_Std_Logic_Vector : constant Name_Id := Name_First_Ieee + 005;
+   Name_Rising_Edge :    constant Name_Id := Name_First_Ieee + 006;
+   Name_Falling_Edge :   constant Name_Id := Name_First_Ieee + 007;
+   Name_VITAL_Timing :   constant Name_Id := Name_First_Ieee + 008;
+   Name_VITAL_Level0 :   constant Name_Id := Name_First_Ieee + 009;
+   Name_VITAL_Level1 :   constant Name_Id := Name_First_Ieee + 010;
+   Name_Last_Ieee :      constant Name_Id := Name_VITAL_Level1;
+
+   --  Verilog keywords.
+   Name_First_Verilog :  constant Name_Id := Name_Last_Ieee + 1;
+   Name_Always :         constant Name_Id := Name_First_Verilog + 00;
+   Name_Assign :         constant Name_Id := Name_First_Verilog + 01;
+   Name_Buf :            constant Name_Id := Name_First_Verilog + 02;
+   Name_Bufif0 :         constant Name_Id := Name_First_Verilog + 03;
+   Name_Bufif1 :         constant Name_Id := Name_First_Verilog + 04;
+   Name_Casex :          constant Name_Id := Name_First_Verilog + 05;
+   Name_Casez :          constant Name_Id := Name_First_Verilog + 06;
+   Name_Cmos :           constant Name_Id := Name_First_Verilog + 07;
+   Name_Deassign :       constant Name_Id := Name_First_Verilog + 08;
+   Name_Default :        constant Name_Id := Name_First_Verilog + 09;
+   Name_Defparam :       constant Name_Id := Name_First_Verilog + 10;
+   Name_Disable :        constant Name_Id := Name_First_Verilog + 11;
+   Name_Endcase :        constant Name_Id := Name_First_Verilog + 12;
+   Name_Endfunction :    constant Name_Id := Name_First_Verilog + 13;
+   Name_Endmodule :      constant Name_Id := Name_First_Verilog + 14;
+   Name_Endprimitive :   constant Name_Id := Name_First_Verilog + 15;
+   Name_Endspecify :     constant Name_Id := Name_First_Verilog + 16;
+   Name_Endtable :       constant Name_Id := Name_First_Verilog + 17;
+   Name_Endtask :        constant Name_Id := Name_First_Verilog + 18;
+   Name_Forever :        constant Name_Id := Name_First_Verilog + 19;
+   Name_Fork :           constant Name_Id := Name_First_Verilog + 20;
+   Name_Highz0 :         constant Name_Id := Name_First_Verilog + 21;
+   Name_Highz1 :         constant Name_Id := Name_First_Verilog + 22;
+   Name_Initial :        constant Name_Id := Name_First_Verilog + 23;
+   Name_Input :          constant Name_Id := Name_First_Verilog + 24;
+   Name_Join :           constant Name_Id := Name_First_Verilog + 25;
+   Name_Large :          constant Name_Id := Name_First_Verilog + 26;
+   Name_Medium :         constant Name_Id := Name_First_Verilog + 27;
+   Name_Module :         constant Name_Id := Name_First_Verilog + 28;
+   Name_Negedge :        constant Name_Id := Name_First_Verilog + 29;
+   Name_Nmos :           constant Name_Id := Name_First_Verilog + 30;
+   Name_Notif0 :         constant Name_Id := Name_First_Verilog + 31;
+   Name_Notif1 :         constant Name_Id := Name_First_Verilog + 32;
+   Name_Output :         constant Name_Id := Name_First_Verilog + 33;
+   Name_Parameter :      constant Name_Id := Name_First_Verilog + 34;
+   Name_Pmos :           constant Name_Id := Name_First_Verilog + 35;
+   Name_Posedge :        constant Name_Id := Name_First_Verilog + 36;
+   Name_Primitive :      constant Name_Id := Name_First_Verilog + 37;
+   Name_Pull0 :          constant Name_Id := Name_First_Verilog + 38;
+   Name_Pull1 :          constant Name_Id := Name_First_Verilog + 39;
+   Name_Pulldown :       constant Name_Id := Name_First_Verilog + 40;
+   Name_Pullup :         constant Name_Id := Name_First_Verilog + 41;
+   Name_Reg :            constant Name_Id := Name_First_Verilog + 42;
+   Name_Repeat :         constant Name_Id := Name_First_Verilog + 43;
+   Name_Rcmos :          constant Name_Id := Name_First_Verilog + 44;
+   Name_Rnmos :          constant Name_Id := Name_First_Verilog + 45;
+   Name_Rpmos :          constant Name_Id := Name_First_Verilog + 46;
+   Name_Rtran :          constant Name_Id := Name_First_Verilog + 47;
+   Name_Rtranif0 :       constant Name_Id := Name_First_Verilog + 48;
+   Name_Rtranif1 :       constant Name_Id := Name_First_Verilog + 49;
+   Name_Small :          constant Name_Id := Name_First_Verilog + 50;
+   Name_Specify :        constant Name_Id := Name_First_Verilog + 51;
+   Name_Specparam :      constant Name_Id := Name_First_Verilog + 52;
+   Name_Strong0 :        constant Name_Id := Name_First_Verilog + 53;
+   Name_Strong1 :        constant Name_Id := Name_First_Verilog + 54;
+   Name_Supply0 :        constant Name_Id := Name_First_Verilog + 55;
+   Name_Supply1 :        constant Name_Id := Name_First_Verilog + 56;
+   Name_Tablex :         constant Name_Id := Name_First_Verilog + 57;
+   Name_Task :           constant Name_Id := Name_First_Verilog + 58;
+   Name_Tran :           constant Name_Id := Name_First_Verilog + 59;
+   Name_Tranif0 :        constant Name_Id := Name_First_Verilog + 60;
+   Name_Tranif1 :        constant Name_Id := Name_First_Verilog + 61;
+   Name_Tri :            constant Name_Id := Name_First_Verilog + 62;
+   Name_Tri0 :           constant Name_Id := Name_First_Verilog + 63;
+   Name_Tri1 :           constant Name_Id := Name_First_Verilog + 64;
+   Name_Trireg :         constant Name_Id := Name_First_Verilog + 65;
+   Name_Wand :           constant Name_Id := Name_First_Verilog + 66;
+   Name_Weak0 :          constant Name_Id := Name_First_Verilog + 67;
+   Name_Weak1 :          constant Name_Id := Name_First_Verilog + 68;
+   Name_Wire :           constant Name_Id := Name_First_Verilog + 69;
+   Name_Wor :            constant Name_Id := Name_First_Verilog + 70;
+   Name_Last_Verilog :   constant Name_Id := Name_Wor;
+
+   --  Verilog Directives.
+   Name_First_Directive : constant Name_Id := Name_Last_Verilog + 1;
+   Name_Define :         constant Name_Id := Name_First_Directive + 00;
+   Name_Endif :          constant Name_Id := Name_First_Directive + 01;
+   Name_Ifdef :          constant Name_Id := Name_First_Directive + 02;
+   Name_Include :        constant Name_Id := Name_First_Directive + 03;
+   Name_Timescale :      constant Name_Id := Name_First_Directive + 04;
+   Name_Undef :          constant Name_Id := Name_First_Directive + 05;
+   Name_Last_Directive : constant Name_Id := Name_Undef;
+
+   --  Verilog system tasks.
+   Name_First_Systask :  constant Name_Id := Name_Last_Directive + 1;
+   Name_Display :        constant Name_Id := Name_First_Systask + 00;
+   Name_Finish :         constant Name_Id := Name_First_Systask + 01;
+   Name_Last_Systask :   constant Name_Id := Name_Finish;
+
+   --  BSV names
+   Name_First_BSV :         constant Name_Id := Name_Last_Systask + 1;
+   Name_uAction :           constant Name_Id := Name_First_BSV + 0;
+   Name_uActionValue :      constant Name_Id := Name_First_BSV + 1;
+   Name_BVI :               constant Name_Id := Name_First_BSV + 2;
+   Name_uC :                constant Name_Id := Name_First_BSV + 3;
+   Name_uCF :               constant Name_Id := Name_First_BSV + 4;
+   Name_uE :                constant Name_Id := Name_First_BSV + 5;
+   Name_uSB :               constant Name_Id := Name_First_BSV + 6;
+   Name_uSBR :              constant Name_Id := Name_First_BSV + 7;
+   Name_Action :            constant Name_Id := Name_First_BSV + 8;
+   Name_Endaction :         constant Name_Id := Name_First_BSV + 9;
+   Name_Actionvalue :       constant Name_Id := Name_First_BSV + 10;
+   Name_Endactionvalue :    constant Name_Id := Name_First_BSV + 11;
+   Name_Ancestor :          constant Name_Id := Name_First_BSV + 12;
+   --   begin
+   --   bit
+   --   case
+   --   endcase
+   Name_Clocked_By :        constant Name_Id := Name_First_BSV + 13;
+   Name_Continue :          constant Name_Id := Name_First_BSV + 14;
+   --   default
+   Name_Default_Clock :     constant Name_Id := Name_First_BSV + 15;
+   Name_Default_Reset :     constant Name_Id := Name_First_BSV + 16;
+   Name_Dependencies  :     constant Name_Id := Name_First_BSV + 17;
+   Name_Deriving :          constant Name_Id := Name_First_BSV + 18;
+   Name_Determines :        constant Name_Id := Name_First_BSV + 19;
+   --   e
+   --   else
+   Name_Enable :            constant Name_Id := Name_First_BSV + 20;
+   --   end
+   Name_Enum :              constant Name_Id := Name_First_BSV + 21;
+   Name_Export :            constant Name_Id := Name_First_BSV + 22;
+   --   for
+   --   function
+   --   endfunction
+   --   if
+   Name_Ifc_Inout :         constant Name_Id := Name_First_BSV + 23;
+   Name_Import :            constant Name_Id := Name_First_BSV + 24;
+   --   inout
+   Name_Input_Clock :       constant Name_Id := Name_First_BSV + 25;
+   Name_Input_Reset :       constant Name_Id := Name_First_BSV + 26;
+   Name_Instance :          constant Name_Id := Name_First_BSV + 27;
+   Name_Endinstance :       constant Name_Id := Name_First_BSV + 28;
+   Name_Interface :         constant Name_Id := Name_First_BSV + 29;
+   Name_Endinterface :      constant Name_Id := Name_First_BSV + 30;
+   Name_Let :               constant Name_Id := Name_First_BSV + 31;
+   Name_Match :             constant Name_Id := Name_First_BSV + 32;
+   Name_Matches :           constant Name_Id := Name_First_BSV + 33;
+   Name_Method :            constant Name_Id := Name_First_BSV + 34;
+   Name_Endmethod :         constant Name_Id := Name_First_BSV + 35;
+   --   module
+   --   endmodule
+   Name_Numeric :           constant Name_Id := Name_First_BSV + 36;
+   Name_Output_Clock :      constant Name_Id := Name_First_BSV + 37;
+   Name_Output_Reset :      constant Name_Id := Name_First_BSV + 38;
+   --   package
+   Name_Endpackage :        constant Name_Id := Name_First_BSV + 39;
+   --   parameter
+   Name_Par :               constant Name_Id := Name_First_BSV + 40;
+   Name_Endpar :            constant Name_Id := Name_First_BSV + 41;
+   Name_Path :              constant Name_Id := Name_First_BSV + 42;
+   --   port
+   Name_Provisos :          constant Name_Id := Name_First_BSV + 43;
+   Name_Ready :             constant Name_Id := Name_First_BSV + 44;
+   Name_Reset_By :          constant Name_Id := Name_First_BSV + 45;
+   --   return
+   Name_Rule :              constant Name_Id := Name_First_BSV + 46;
+   Name_Endrule :           constant Name_Id := Name_First_BSV + 47;
+   Name_Rules :             constant Name_Id := Name_First_BSV + 48;
+   Name_Endrules :          constant Name_Id := Name_First_BSV + 49;
+   Name_Same_Family :       constant Name_Id := Name_First_BSV + 50;
+   Name_Schedule :          constant Name_Id := Name_First_BSV + 51;
+   Name_Seq :               constant Name_Id := Name_First_BSV + 52;
+   Name_Endseq :            constant Name_Id := Name_First_BSV + 53;
+   Name_Struct :            constant Name_Id := Name_First_BSV + 54;
+   Name_Tagged :            constant Name_Id := Name_First_BSV + 55;
+   --   type
+   Name_Typeclass :         constant Name_Id := Name_First_BSV + 56;
+   Name_Endtypeclass :      constant Name_Id := Name_First_BSV + 57;
+   Name_Typedef :           constant Name_Id := Name_First_BSV + 58;
+   Name_Union :             constant Name_Id := Name_First_BSV + 59;
+   Name_Valueof :           constant Name_Id := Name_First_BSV + 60;
+   Name_uValueof :          constant Name_Id := Name_First_BSV + 61;
+   Name_Void :              constant Name_Id := Name_First_BSV + 62;
+   --   while
+   Name_Last_BSV :          constant Name_Id := Name_First_BSV + 62;
+
+   --  VHDL special comments
+   Name_First_Comment :  constant Name_Id := Name_Last_BSV + 1;
+   Name_Psl :            constant Name_Id := Name_First_Comment + 0;
+   Name_Pragma :         constant Name_Id := Name_First_Comment + 1;
+   Name_Last_Comment :   constant Name_Id := Name_First_Comment + 1;
+
+   --  PSL words.
+   Name_First_PSL :          constant Name_Id := Name_Last_Comment + 1;
+   Name_A :                  constant Name_Id := Name_First_PSL + 00;
+   Name_Af :                 constant Name_Id := Name_First_PSL + 01;
+   Name_Ag :                 constant Name_Id := Name_First_PSL + 02;
+   Name_Ax :                 constant Name_Id := Name_First_PSL + 03;
+   Name_Abort :              constant Name_Id := Name_First_PSL + 04;
+   --  Name_Always
+   --  Name_And
+   Name_Assume :             constant Name_Id := Name_First_PSL + 05;
+   Name_Assume_Guarantee :   constant Name_Id := Name_First_PSL + 06;
+   Name_Before :             constant Name_Id := Name_First_PSL + 07;
+   --  Name_Boolean
+   Name_Clock :              constant Name_Id := Name_First_PSL + 08;
+   Name_Const :              constant Name_Id := Name_First_PSL + 09;
+   Name_Cover :              constant Name_Id := Name_First_PSL + 10;
+   --  Name_Default
+   Name_E :                  constant Name_Id := Name_First_PSL + 11;
+   Name_Ef :                 constant Name_Id := Name_First_PSL + 12;
+   Name_Eg :                 constant Name_Id := Name_First_PSL + 13;
+   Name_Ex :                 constant Name_Id := Name_First_PSL + 14;
+   Name_Endpoint  :          constant Name_Id := Name_First_PSL + 15;
+   Name_Eventually :         constant Name_Id := Name_First_PSL + 16;
+   Name_Fairness :           constant Name_Id := Name_First_PSL + 17;
+   Name_Fell  :              constant Name_Id := Name_First_PSL + 18;
+   Name_Forall :             constant Name_Id := Name_First_PSL + 19;
+   Name_G :                  constant Name_Id := Name_First_PSL + 20;
+   --  Name_In
+   Name_Inf :                constant Name_Id := Name_First_PSL + 21;
+   Name_Inherit :            constant Name_Id := Name_First_PSL + 22;
+   --  Name_Is
+   Name_Never :              constant Name_Id := Name_First_PSL + 23;
+   --  Name_Next
+   Name_Next_A :             constant Name_Id := Name_First_PSL + 24;
+   Name_Next_E :             constant Name_Id := Name_First_PSL + 25;
+   Name_Next_Event :         constant Name_Id := Name_First_PSL + 26;
+   Name_Next_Event_A :       constant Name_Id := Name_First_PSL + 27;
+   Name_Next_Event_E :       constant Name_Id := Name_First_PSL + 28;
+   --  Name_Not
+   --  Name_Or
+   Name_Property :           constant Name_Id := Name_First_PSL + 29;
+   Name_Prev :               constant Name_Id := Name_First_PSL + 30;
+   Name_Restrict :           constant Name_Id := Name_First_PSL + 31;
+   Name_Restrict_Guarantee : constant Name_Id := Name_First_PSL + 32;
+   Name_Rose :               constant Name_Id := Name_First_PSL + 33;
+   Name_Sequence :           constant Name_Id := Name_First_PSL + 34;
+   Name_Strong :             constant Name_Id := Name_First_PSL + 35;
+   --   union
+   --   until
+   Name_Vmode :              constant Name_Id := Name_First_PSL + 36;
+   Name_Vprop :              constant Name_Id := Name_First_PSL + 37;
+   Name_Vunit :              constant Name_Id := Name_First_PSL + 38;
+   Name_W :                  constant Name_Id := Name_First_PSL + 39;
+   Name_Whilenot :           constant Name_Id := Name_First_PSL + 40;
+   Name_Within :             constant Name_Id := Name_First_PSL + 41;
+   Name_X :                  constant Name_Id := Name_First_PSL + 42;
+   Name_Last_PSL :           constant Name_Id := Name_First_PSL + 42;
+
+   subtype Name_Id_PSL_Keywords is
+     Name_Id range Name_First_PSL .. Name_Last_PSL;
+
+   -- Initialize the name table with the values defined here.
+   procedure Std_Names_Initialize;
+end Std_Names;
diff --git a/src/std_package.adb b/src/std_package.adb
new file mode 100644
index 000000000..1edfb6cda
--- /dev/null
+++ b/src/std_package.adb
@@ -0,0 +1,1200 @@
+--  std.standard package declarations.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Files_Map;
+with Name_Table;
+with Str_Table;
+with Std_Names; use Std_Names;
+with Flags; use Flags;
+with Iirs_Utils;
+with Sem;
+with Sem_Decls;
+with Iir_Chains;
+
+package body Std_Package is
+   type Bound_Array is array (Boolean) of Iir_Int64;
+   Low_Bound : constant Bound_Array := (False => -(2 ** 31),
+                                        True => -(2 ** 63));
+   High_Bound : constant Bound_Array := (False => (2 ** 31) - 1,
+                                         True => (2 ** 63) - 1);
+
+   Std_Location: Location_Type := Location_Nil;
+   Std_Filename : Name_Id := Null_Identifier;
+
+   function Create_Std_Iir (Kind : Iir_Kind) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Iir (Kind);
+      Set_Location (Res, Std_Location);
+      return Res;
+   end Create_Std_Iir;
+
+   function Create_Std_Decl (Kind : Iir_Kind) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Create_Std_Iir (Kind);
+      Set_Parent (Res, Standard_Package);
+      return Res;
+   end Create_Std_Decl;
+
+   function Create_Std_Type_Mark (Ref : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      Res := Iirs_Utils.Build_Simple_Name (Ref, Std_Location);
+      Set_Type (Res, Get_Type (Ref));
+      return Res;
+   end Create_Std_Type_Mark;
+
+   procedure Create_First_Nodes
+   is
+   begin
+      Std_Filename := Name_Table.Get_Identifier ("*std_standard*");
+      Std_Location := Files_Map.Source_File_To_Location
+        (Files_Map.Create_Virtual_Source_File (Std_Filename));
+
+      if Create_Iir_Error /= Error_Mark then
+         raise Internal_Error;
+      end if;
+      Set_Location (Error_Mark, Std_Location);
+
+      if Create_Std_Iir (Iir_Kind_Integer_Type_Definition)
+        /= Universal_Integer_Type_Definition
+      then
+         raise Internal_Error;
+      end if;
+
+      if Create_Std_Iir (Iir_Kind_Floating_Type_Definition)
+        /= Universal_Real_Type_Definition
+      then
+         raise Internal_Error;
+      end if;
+
+      if Create_Std_Iir (Iir_Kind_Integer_Type_Definition)
+        /= Convertible_Integer_Type_Definition
+      then
+         raise Internal_Error;
+      end if;
+
+      if Create_Std_Iir (Iir_Kind_Floating_Type_Definition)
+        /= Convertible_Real_Type_Definition
+      then
+         raise Internal_Error;
+      end if;
+   end Create_First_Nodes;
+
+   procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration)
+   is
+      function Get_Std_Character (Char: Character) return Name_Id
+        renames Name_Table.Get_Identifier;
+
+      procedure Set_Std_Identifier (Decl : Iir; Name : Name_Id) is
+      begin
+         Set_Identifier (Decl, Name);
+         Set_Visible_Flag (Decl, True);
+      end Set_Std_Identifier;
+
+      function Create_Std_Integer (Val : Iir_Int64; Lit_Type : Iir)
+        return Iir_Integer_Literal
+      is
+         Res : Iir_Integer_Literal;
+      begin
+         Res := Create_Std_Iir (Iir_Kind_Integer_Literal);
+         Set_Value (Res, Val);
+         Set_Type (Res, Lit_Type);
+         Set_Expr_Staticness (Res, Locally);
+         return Res;
+      end Create_Std_Integer;
+
+      function Create_Std_Fp (Val : Iir_Fp64; Lit_Type : Iir)
+        return Iir_Floating_Point_Literal
+      is
+         Res : Iir_Floating_Point_Literal;
+      begin
+         Res := Create_Std_Iir (Iir_Kind_Floating_Point_Literal);
+         Set_Fp_Value (Res, Val);
+         Set_Type (Res, Lit_Type);
+         Set_Expr_Staticness (Res, Locally);
+         return Res;
+      end Create_Std_Fp;
+
+      function Create_Std_Range_Expr (Left, Right : Iir; Rtype : Iir)
+        return Iir
+      is
+         Res : Iir;
+      begin
+         Res := Create_Std_Iir (Iir_Kind_Range_Expression);
+         Set_Left_Limit (Res, Left);
+         Set_Direction (Res, Iir_To);
+         Set_Right_Limit (Res, Right);
+         Set_Expr_Staticness (Res, Locally);
+         Set_Type (Res, Rtype);
+         return Res;
+      end Create_Std_Range_Expr;
+
+      function Create_Std_Literal
+        (Name : Name_Id; Sub_Type : Iir_Enumeration_Type_Definition)
+        return Iir_Enumeration_Literal
+      is
+         Res : Iir_Enumeration_Literal;
+         List : Iir_List;
+      begin
+         Res := Create_Std_Decl (Iir_Kind_Enumeration_Literal);
+         List := Get_Enumeration_Literal_List (Sub_Type);
+         Set_Std_Identifier (Res, Name);
+         Set_Type (Res, Sub_Type);
+         Set_Expr_Staticness (Res, Locally);
+         Set_Name_Staticness (Res, Locally);
+         Set_Enumeration_Decl (Res, Res);
+         Set_Enum_Pos (Res, Iir_Int32 (Get_Nbr_Elements (List)));
+         Sem.Compute_Subprogram_Hash (Res);
+         Append_Element (List, Res);
+         return Res;
+      end Create_Std_Literal;
+
+      --  Append a declaration DECL to Standard_Package.
+      Last_Decl : Iir := Null_Iir;
+      procedure Add_Decl (Decl : Iir) is
+      begin
+         if Last_Decl = Null_Iir then
+            Set_Declaration_Chain (Standard_Package, Decl);
+         else
+            Set_Chain (Last_Decl, Decl);
+         end if;
+         Last_Decl := Decl;
+      end Add_Decl;
+
+      procedure Add_Implicit_Operations (Decl : Iir)
+      is
+         Nxt : Iir;
+      begin
+         Sem_Decls.Create_Implicit_Operations (Decl, True);
+         loop
+            Nxt := Get_Chain (Last_Decl);
+            exit when Nxt = Null_Iir;
+            Last_Decl := Nxt;
+         end loop;
+      end Add_Implicit_Operations;
+
+      procedure Create_Std_Type (Decl : out Iir;
+                                 Def : Iir;
+                                 Name : Name_Id)
+      is
+      begin
+         Decl := Create_Std_Decl (Iir_Kind_Type_Declaration);
+         Set_Std_Identifier (Decl, Name);
+         Set_Type_Definition (Decl, Def);
+         Add_Decl (Decl);
+         Set_Type_Declarator (Def, Decl);
+      end Create_Std_Type;
+
+      procedure Create_Integer_Type (Type_Definition : Iir;
+                                     Type_Decl : out Iir;
+                                     Type_Name : Name_Id)
+      is
+      begin
+         --Integer_Type_Definition :=
+         --  Create_Std_Iir (Iir_Kind_Integer_Type_Definition);
+         Set_Base_Type (Type_Definition, Type_Definition);
+         Set_Type_Staticness (Type_Definition, Locally);
+         Set_Signal_Type_Flag (Type_Definition, True);
+         Set_Has_Signal_Flag (Type_Definition, not Flags.Flag_Whole_Analyze);
+
+         Type_Decl := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Type_Decl, Type_Name);
+         Set_Type_Definition (Type_Decl, Type_Definition);
+         Set_Type_Declarator (Type_Definition, Type_Decl);
+      end Create_Integer_Type;
+
+      procedure Create_Integer_Subtype (Type_Definition : Iir;
+                                        Type_Decl : Iir;
+                                        Subtype_Definition : out Iir;
+                                        Subtype_Decl : out Iir)
+      is
+         Constraint : Iir;
+      begin
+         Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition);
+         Set_Base_Type (Subtype_Definition, Type_Definition);
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Integer (Low_Bound (Flags.Flag_Integer_64),
+                                Universal_Integer_Type_Definition),
+            Create_Std_Integer (High_Bound (Flags.Flag_Integer_64),
+                                Universal_Integer_Type_Definition),
+            Universal_Integer_Type_Definition);
+         Set_Range_Constraint (Subtype_Definition, Constraint);
+         Set_Type_Staticness (Subtype_Definition, Locally);
+         Set_Signal_Type_Flag (Subtype_Definition, True);
+         Set_Has_Signal_Flag (Subtype_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         --  subtype is
+         Subtype_Decl := Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Subtype_Decl, Get_Identifier (Type_Decl));
+         Set_Type (Subtype_Decl, Subtype_Definition);
+         Set_Type_Declarator (Subtype_Definition, Subtype_Decl);
+         Set_Subtype_Definition (Type_Decl, Subtype_Definition);
+      end Create_Integer_Subtype;
+
+      --  Create an array of EL_TYPE, indexed by Natural.
+      procedure Create_Array_Type
+        (Def : out Iir; Decl : out Iir; El_Decl : Iir; Name : Name_Id)
+      is
+         Index_List : Iir_List;
+         Index : Iir;
+         Element : Iir;
+      begin
+         Element := Create_Std_Type_Mark (El_Decl);
+         Index := Create_Std_Type_Mark (Natural_Subtype_Declaration);
+
+         Def := Create_Std_Iir (Iir_Kind_Array_Type_Definition);
+         Set_Base_Type (Def, Def);
+
+         Index_List := Create_Iir_List;
+         Set_Index_Subtype_Definition_List (Def, Index_List);
+         Set_Index_Subtype_List (Def, Index_List);
+         Append_Element (Index_List, Index);
+
+         Set_Element_Subtype_Indication (Def, Element);
+         Set_Element_Subtype (Def, Get_Type (El_Decl));
+         Set_Type_Staticness (Def, None);
+         Set_Signal_Type_Flag (Def, True);
+         Set_Has_Signal_Flag (Def, not Flags.Flag_Whole_Analyze);
+
+         Create_Std_Type (Decl, Def, Name);
+
+         Add_Implicit_Operations (Decl);
+      end Create_Array_Type;
+
+      --  Create:
+      --  function TO_STRING (VALUE: inter_type) return STRING;
+      procedure Create_To_String (Inter_Type : Iir;
+                                  Imp : Iir_Predefined_Functions;
+                                  Name : Name_Id := Std_Names.Name_To_String;
+                                  Inter2_Id : Name_Id := Null_Identifier;
+                                  Inter2_Type : Iir := Null_Iir)
+      is
+         Decl : Iir_Implicit_Function_Declaration;
+         Inter : Iir_Interface_Constant_Declaration;
+         Inter2 : Iir_Interface_Constant_Declaration;
+      begin
+         Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration);
+         Set_Std_Identifier (Decl, Name);
+         Set_Return_Type (Decl, String_Type_Definition);
+         Set_Pure_Flag (Decl, True);
+         Set_Implicit_Definition (Decl, Imp);
+
+         Inter := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+         Set_Identifier (Inter, Std_Names.Name_Value);
+         Set_Type (Inter, Inter_Type);
+         Set_Mode (Inter, Iir_In_Mode);
+         Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+         Set_Interface_Declaration_Chain (Decl, Inter);
+
+         if Inter2_Id /= Null_Identifier then
+            Inter2 := Create_Iir (Iir_Kind_Interface_Constant_Declaration);
+            Set_Identifier (Inter2, Inter2_Id);
+            Set_Type (Inter2, Inter2_Type);
+            Set_Mode (Inter2, Iir_In_Mode);
+            Set_Lexical_Layout (Inter2, Iir_Lexical_Has_Type);
+            Set_Chain (Inter, Inter2);
+         end if;
+
+         Sem.Compute_Subprogram_Hash (Decl);
+         Add_Decl (Decl);
+      end Create_To_String;
+
+      --  Create:
+      --  function NAME (signal S : I inter_type) return BOOLEAN;
+      procedure Create_Edge_Function
+        (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir)
+      is
+         Decl : Iir_Implicit_Function_Declaration;
+         Inter : Iir_Interface_Constant_Declaration;
+      begin
+         Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration);
+         Set_Std_Identifier (Decl, Name);
+         Set_Return_Type (Decl, Boolean_Type_Definition);
+         Set_Pure_Flag (Decl, True);
+         Set_Implicit_Definition (Decl, Func);
+
+         Inter := Create_Iir (Iir_Kind_Interface_Signal_Declaration);
+         Set_Identifier (Inter, Std_Names.Name_S);
+         Set_Type (Inter, Inter_Type);
+         Set_Mode (Inter, Iir_In_Mode);
+         Set_Interface_Declaration_Chain (Decl, Inter);
+         Set_Lexical_Layout (Inter, Iir_Lexical_Has_Type);
+
+         Sem.Compute_Subprogram_Hash (Decl);
+         Add_Decl (Decl);
+      end Create_Edge_Function;
+
+   begin
+      --  Create design file.
+      Std_Standard_File := Create_Std_Iir (Iir_Kind_Design_File);
+      Set_Parent (Std_Standard_File, Parent);
+      Set_Design_File_Filename (Std_Standard_File, Std_Filename);
+
+      declare
+         use Str_Table;
+         Std_Time_Stamp : constant Time_Stamp_String :=
+           "20020601000000.000";
+         Id : Time_Stamp_Id;
+      begin
+         Id := Time_Stamp_Id (Str_Table.Start);
+         for I in Time_Stamp_String'Range loop
+            Str_Table.Append (Std_Time_Stamp (I));
+         end loop;
+         Str_Table.Finish;
+         Set_Analysis_Time_Stamp (Std_Standard_File, Id);
+      end;
+
+      --  Create design unit.
+      Std_Standard_Unit := Create_Std_Iir (Iir_Kind_Design_Unit);
+      Set_Identifier (Std_Standard_Unit, Name_Standard);
+      Set_First_Design_Unit (Std_Standard_File, Std_Standard_Unit);
+      Set_Last_Design_Unit (Std_Standard_File, Std_Standard_Unit);
+      Set_Design_File (Std_Standard_Unit, Std_Standard_File);
+      Set_Date_State (Std_Standard_Unit, Date_Analyze);
+      Set_Dependence_List (Std_Standard_Unit, Create_Iir_List);
+
+      Set_Date (Std_Standard_Unit, Date_Valid'First);
+
+      -- Adding "package STANDARD is"
+      Standard_Package := Create_Std_Iir (Iir_Kind_Package_Declaration);
+      Set_Std_Identifier (Standard_Package, Name_Standard);
+      Set_Need_Body (Standard_Package, False);
+
+      Set_Library_Unit (Std_Standard_Unit, Standard_Package);
+      Set_Design_Unit (Standard_Package, Std_Standard_Unit);
+
+      -- boolean
+      begin
+         -- (false, true)
+         Boolean_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Base_Type (Boolean_Type_Definition, Boolean_Type_Definition);
+         Set_Enumeration_Literal_List
+           (Boolean_Type_Definition, Create_Iir_List);
+         Boolean_False := Create_Std_Literal
+           (Name_False, Boolean_Type_Definition);
+         Boolean_True := Create_Std_Literal
+           (Name_True, Boolean_Type_Definition);
+         Set_Type_Staticness (Boolean_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Boolean_Type_Definition, True);
+         Set_Has_Signal_Flag (Boolean_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         -- type boolean is
+         Create_Std_Type (Boolean_Type_Declaration, Boolean_Type_Definition,
+                          Name_Boolean);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Boolean_Type_Definition);
+         Add_Implicit_Operations (Boolean_Type_Declaration);
+      end;
+
+      if Vhdl_Std >= Vhdl_08 then
+         --  Rising_Edge and Falling_Edge
+         Create_Edge_Function
+           (Std_Names.Name_Rising_Edge, Iir_Predefined_Boolean_Rising_Edge,
+            Boolean_Type_Definition);
+         Create_Edge_Function
+           (Std_Names.Name_Falling_Edge, Iir_Predefined_Boolean_Falling_Edge,
+            Boolean_Type_Definition);
+      end if;
+
+      -- bit.
+      begin
+         -- ('0', '1')
+         Bit_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Enumeration_Literal_List
+           (Bit_Type_Definition, Create_Iir_List);
+         Set_Base_Type (Bit_Type_Definition, Bit_Type_Definition);
+         Bit_0 := Create_Std_Literal
+           (Get_Std_Character ('0'), Bit_Type_Definition);
+         Bit_1 := Create_Std_Literal
+           (Get_Std_Character ('1'), Bit_Type_Definition);
+         Set_Type_Staticness (Bit_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Bit_Type_Definition, True);
+         Set_Has_Signal_Flag (Bit_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+         Set_Only_Characters_Flag (Bit_Type_Definition, True);
+
+         -- type bit is
+         Create_Std_Type (Bit_Type_Declaration, Bit_Type_Definition, Name_Bit);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Bit_Type_Definition);
+         Add_Implicit_Operations (Bit_Type_Declaration);
+      end;
+
+      if Vhdl_Std >= Vhdl_08 then
+         --  Rising_Edge and Falling_Edge
+         Create_Edge_Function
+           (Std_Names.Name_Rising_Edge, Iir_Predefined_Bit_Rising_Edge,
+            Bit_Type_Definition);
+         Create_Edge_Function
+           (Std_Names.Name_Falling_Edge, Iir_Predefined_Bit_Falling_Edge,
+            Bit_Type_Definition);
+      end if;
+
+      -- characters.
+      declare
+         El: Iir;
+         pragma Unreferenced (El);
+      begin
+         Character_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Base_Type (Character_Type_Definition, Character_Type_Definition);
+         Set_Enumeration_Literal_List
+           (Character_Type_Definition, Create_Iir_List);
+
+         for I in Name_Nul .. Name_Usp loop
+            El := Create_Std_Literal (I, Character_Type_Definition);
+         end loop;
+         for I in Character'(' ') .. Character'('~') loop
+            El := Create_Std_Literal
+              (Get_Std_Character (I), Character_Type_Definition);
+         end loop;
+         El := Create_Std_Literal (Name_Del, Character_Type_Definition);
+         if Vhdl_Std /= Vhdl_87 then
+            for I in Name_C128 .. Name_C159 loop
+               El := Create_Std_Literal (I, Character_Type_Definition);
+            end loop;
+            for I in Character'Val (160) .. Character'Val (255) loop
+               El := Create_Std_Literal
+                 (Get_Std_Character (I), Character_Type_Definition);
+            end loop;
+         end if;
+         Set_Type_Staticness (Character_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Character_Type_Definition, True);
+         Set_Has_Signal_Flag (Character_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         -- type character is
+         Create_Std_Type
+           (Character_Type_Declaration, Character_Type_Definition,
+            Name_Character);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Character_Type_Definition);
+         Add_Implicit_Operations (Character_Type_Declaration);
+      end;
+
+      -- severity level.
+      begin
+         -- (note, warning, error, failure)
+         Severity_Level_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Base_Type (Severity_Level_Type_Definition,
+                        Severity_Level_Type_Definition);
+         Set_Enumeration_Literal_List
+           (Severity_Level_Type_Definition, Create_Iir_List);
+
+         Severity_Level_Note := Create_Std_Literal
+           (Name_Note, Severity_Level_Type_Definition);
+         Severity_Level_Warning := Create_Std_Literal
+           (Name_Warning, Severity_Level_Type_Definition);
+         Severity_Level_Error := Create_Std_Literal
+           (Name_Error, Severity_Level_Type_Definition);
+         Severity_Level_Failure := Create_Std_Literal
+           (Name_Failure, Severity_Level_Type_Definition);
+         Set_Type_Staticness (Severity_Level_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Severity_Level_Type_Definition, True);
+         Set_Has_Signal_Flag (Severity_Level_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         -- type severity_level is
+         Create_Std_Type
+           (Severity_Level_Type_Declaration, Severity_Level_Type_Definition,
+            Name_Severity_Level);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (Severity_Level_Type_Definition);
+         Add_Implicit_Operations (Severity_Level_Type_Declaration);
+      end;
+
+      -- universal integer
+      begin
+         Create_Integer_Type (Universal_Integer_Type_Definition,
+                              Universal_Integer_Type_Declaration,
+                              Name_Universal_Integer);
+         Add_Decl (Universal_Integer_Type_Declaration);
+
+         Create_Integer_Subtype (Universal_Integer_Type_Definition,
+                                 Universal_Integer_Type_Declaration,
+                                 Universal_Integer_Subtype_Definition,
+                                 Universal_Integer_Subtype_Declaration);
+
+         Add_Decl (Universal_Integer_Subtype_Declaration);
+         Set_Subtype_Definition (Universal_Integer_Type_Declaration,
+                                 Universal_Integer_Subtype_Definition);
+
+         --  Do not create implicit operations yet, since "**" needs integer
+         --  type.
+      end;
+
+      --  Universal integer constant 1.
+      Universal_Integer_One :=
+        Create_Std_Integer (1, Universal_Integer_Type_Definition);
+
+      -- Universal real.
+      declare
+         Constraint : Iir_Range_Expression;
+      begin
+         Set_Base_Type (Universal_Real_Type_Definition,
+                        Universal_Real_Type_Definition);
+         Set_Type_Staticness (Universal_Real_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Universal_Real_Type_Definition, True);
+         Set_Has_Signal_Flag (Universal_Real_Type_Definition, False);
+
+         Universal_Real_Type_Declaration :=
+           Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Universal_Real_Type_Declaration, Name_Universal_Real);
+         Set_Type_Definition (Universal_Real_Type_Declaration,
+                              Universal_Real_Type_Definition);
+         Set_Type_Declarator (Universal_Real_Type_Definition,
+                              Universal_Real_Type_Declaration);
+         Add_Decl (Universal_Real_Type_Declaration);
+
+         Universal_Real_Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition);
+         Set_Base_Type (Universal_Real_Subtype_Definition,
+                        Universal_Real_Type_Definition);
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition),
+            Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition),
+            Universal_Real_Type_Definition);
+         Set_Range_Constraint (Universal_Real_Subtype_Definition, Constraint);
+         Set_Type_Staticness (Universal_Real_Subtype_Definition, Locally);
+         Set_Signal_Type_Flag (Universal_Real_Subtype_Definition, True);
+         Set_Has_Signal_Flag (Universal_Real_Subtype_Definition, False);
+
+         --  type is
+         Universal_Real_Subtype_Declaration :=
+           Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Identifier (Universal_Real_Subtype_Declaration,
+                         Name_Universal_Real);
+         Set_Type (Universal_Real_Subtype_Declaration,
+                   Universal_Real_Subtype_Definition);
+         Set_Type_Declarator (Universal_Real_Subtype_Definition,
+                              Universal_Real_Subtype_Declaration);
+         Set_Subtype_Definition (Universal_Real_Type_Declaration,
+                                 Universal_Real_Subtype_Definition);
+
+         Add_Decl (Universal_Real_Subtype_Declaration);
+
+         --  Do not create implicit operations yet, since "**" needs integer
+         --  type.
+      end;
+
+      -- Convertible type.
+      begin
+         Create_Integer_Type (Convertible_Integer_Type_Definition,
+                              Convertible_Integer_Type_Declaration,
+                              Name_Convertible_Integer);
+         Create_Integer_Subtype (Convertible_Integer_Type_Definition,
+                                 Convertible_Integer_Type_Declaration,
+                                 Convertible_Integer_Subtype_Definition,
+                                 Convertible_Integer_Subtype_Declaration);
+
+         --  Not added in std.standard.
+      end;
+
+      begin
+         Set_Base_Type (Convertible_Real_Type_Definition,
+                        Convertible_Real_Type_Definition);
+         Set_Type_Staticness (Convertible_Real_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Convertible_Real_Type_Definition, True);
+         Set_Has_Signal_Flag (Convertible_Real_Type_Definition, False);
+
+         Convertible_Real_Type_Declaration :=
+           Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Convertible_Real_Type_Declaration,
+                         Name_Convertible_Real);
+         Set_Type_Definition (Convertible_Real_Type_Declaration,
+                              Convertible_Real_Type_Definition);
+         Set_Type_Declarator (Convertible_Real_Type_Definition,
+                              Convertible_Real_Type_Declaration);
+      end;
+
+      -- integer type.
+      begin
+         Integer_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Integer_Type_Definition);
+         Create_Integer_Type (Integer_Type_Definition,
+                              Integer_Type_Declaration,
+                              Name_Integer);
+         Add_Decl (Integer_Type_Declaration);
+
+         Add_Implicit_Operations (Integer_Type_Declaration);
+         Add_Implicit_Operations (Universal_Integer_Type_Declaration);
+         Add_Implicit_Operations (Universal_Real_Type_Declaration);
+
+         Create_Integer_Subtype (Integer_Type_Definition,
+                                 Integer_Type_Declaration,
+                                 Integer_Subtype_Definition,
+                                 Integer_Subtype_Declaration);
+         Add_Decl (Integer_Subtype_Declaration);
+      end;
+
+      -- Real type.
+      declare
+         Constraint : Iir_Range_Expression;
+      begin
+         Real_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Floating_Type_Definition);
+         Set_Base_Type (Real_Type_Definition, Real_Type_Definition);
+         Set_Type_Staticness (Real_Type_Definition, Locally);
+         Set_Signal_Type_Flag (Real_Type_Definition, True);
+         Set_Has_Signal_Flag (Real_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         Real_Type_Declaration :=
+           Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Real_Type_Declaration, Name_Real);
+         Set_Type_Definition (Real_Type_Declaration, Real_Type_Definition);
+         Set_Type_Declarator (Real_Type_Definition, Real_Type_Declaration);
+         Add_Decl (Real_Type_Declaration);
+
+         Add_Implicit_Operations (Real_Type_Declaration);
+
+         Real_Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Floating_Subtype_Definition);
+         Set_Base_Type (Real_Subtype_Definition, Real_Type_Definition);
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Fp (Iir_Fp64'First, Universal_Real_Type_Definition),
+            Create_Std_Fp (Iir_Fp64'Last, Universal_Real_Type_Definition),
+             Universal_Real_Type_Definition);
+         Set_Range_Constraint (Real_Subtype_Definition, Constraint);
+         Set_Type_Staticness (Real_Subtype_Definition, Locally);
+         Set_Signal_Type_Flag (Real_Subtype_Definition, True);
+         Set_Has_Signal_Flag (Real_Subtype_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         Real_Subtype_Declaration :=
+           Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Real_Subtype_Declaration, Name_Real);
+         Set_Type (Real_Subtype_Declaration, Real_Subtype_Definition);
+         Set_Type_Declarator
+           (Real_Subtype_Definition, Real_Subtype_Declaration);
+         Add_Decl (Real_Subtype_Declaration);
+
+         Set_Subtype_Definition
+           (Real_Type_Declaration, Real_Subtype_Definition);
+      end;
+
+      -- time definition
+      declare
+         Time_Staticness : Iir_Staticness;
+         Last_Unit : Iir_Unit_Declaration;
+         use Iir_Chains.Unit_Chain_Handling;
+
+         function Create_Std_Phys_Lit (Value : Iir_Int64;
+                                       Unit : Iir_Simple_Name)
+           return Iir_Physical_Int_Literal
+         is
+            Lit: Iir_Physical_Int_Literal;
+         begin
+            Lit := Create_Std_Iir (Iir_Kind_Physical_Int_Literal);
+            Set_Value (Lit, Value);
+            pragma Assert (Get_Kind (Unit) = Iir_Kind_Simple_Name);
+            Set_Unit_Name (Lit, Unit);
+            Set_Type (Lit, Time_Type_Definition);
+            Set_Expr_Staticness (Lit, Time_Staticness);
+            return Lit;
+         end Create_Std_Phys_Lit;
+
+         procedure Create_Unit (Unit : out Iir_Unit_Declaration;
+                                Multiplier_Value : Iir_Int64;
+                                Multiplier : in Iir_Unit_Declaration;
+                                Name : Name_Id)
+         is
+            Lit: Iir_Physical_Int_Literal;
+            Mul_Name : Iir;
+         begin
+            Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration);
+            Set_Std_Identifier (Unit, Name);
+            Set_Type (Unit, Time_Type_Definition);
+
+            Mul_Name := Iirs_Utils.Build_Simple_Name
+              (Multiplier, Std_Location);
+            Lit := Create_Std_Phys_Lit (Multiplier_Value, Mul_Name);
+            Set_Physical_Literal (Unit, Lit);
+            Lit := Create_Std_Phys_Lit
+              (Multiplier_Value
+               * Get_Value (Get_Physical_Unit_Value (Multiplier)),
+               Get_Unit_Name (Get_Physical_Unit_Value (Multiplier)));
+            Set_Physical_Unit_Value (Unit, Lit);
+
+            Set_Expr_Staticness (Unit, Time_Staticness);
+            Set_Name_Staticness (Unit, Locally);
+            Append (Last_Unit, Time_Type_Definition, Unit);
+         end Create_Unit;
+
+         Time_Fs_Name : Iir;
+         Time_Fs_Unit: Iir_Unit_Declaration;
+         Time_Ps_Unit: Iir_Unit_Declaration;
+         Time_Ns_Unit: Iir_Unit_Declaration;
+         Time_Us_Unit: Iir_Unit_Declaration;
+         Time_Ms_Unit: Iir_Unit_Declaration;
+         Time_Sec_Unit: Iir_Unit_Declaration;
+         Time_Min_Unit: Iir_Unit_Declaration;
+         Time_Hr_Unit: Iir_Unit_Declaration;
+         Constraint : Iir_Range_Expression;
+      begin
+         if Vhdl_Std >= Vhdl_93c then
+            Time_Staticness := Globally;
+         else
+            Time_Staticness := Locally;
+         end if;
+
+         Time_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Physical_Type_Definition);
+         Set_Base_Type (Time_Type_Definition, Time_Type_Definition);
+         Set_Type_Staticness (Time_Type_Definition, Locally);--Time_Staticness
+         Set_Signal_Type_Flag (Time_Type_Definition, True);
+         Set_Has_Signal_Flag (Time_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+         Set_End_Has_Reserved_Id (Time_Type_Definition, True);
+
+         Build_Init (Last_Unit);
+
+         Time_Fs_Unit := Create_Std_Decl (Iir_Kind_Unit_Declaration);
+         Set_Std_Identifier (Time_Fs_Unit, Name_Fs);
+         Set_Type (Time_Fs_Unit, Time_Type_Definition);
+         Set_Expr_Staticness (Time_Fs_Unit, Time_Staticness);
+         Set_Name_Staticness (Time_Fs_Unit, Locally);
+         Time_Fs_Name := Iirs_Utils.Build_Simple_Name
+           (Time_Fs_Unit, Std_Location);
+         Set_Physical_Unit_Value
+           (Time_Fs_Unit, Create_Std_Phys_Lit (1, Time_Fs_Name));
+         Append (Last_Unit, Time_Type_Definition, Time_Fs_Unit);
+
+         Create_Unit (Time_Ps_Unit, 1000, Time_Fs_Unit, Name_Ps);
+         Create_Unit (Time_Ns_Unit, 1000, Time_Ps_Unit, Name_Ns);
+         Create_Unit (Time_Us_Unit, 1000, Time_Ns_Unit, Name_Us);
+         Create_Unit (Time_Ms_Unit, 1000, Time_Us_Unit, Name_Ms);
+         Create_Unit (Time_Sec_Unit, 1000, Time_Ms_Unit, Name_Sec);
+         Create_Unit (Time_Min_Unit, 60, Time_Sec_Unit, Name_Min);
+         Create_Unit (Time_Hr_Unit, 60, Time_Min_Unit, Name_Hr);
+
+         --  type is
+         Time_Type_Declaration :=
+           Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration);
+         Set_Identifier (Time_Type_Declaration, Name_Time);
+         Set_Type_Definition (Time_Type_Declaration, Time_Type_Definition);
+         Set_Type_Declarator (Time_Type_Definition, Time_Type_Declaration);
+         Add_Decl (Time_Type_Declaration);
+
+         Add_Implicit_Operations (Time_Type_Declaration);
+
+         Time_Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition);
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Phys_Lit (Low_Bound (Flags.Flag_Time_64),
+                                 Time_Fs_Name),
+            Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64),
+                                 Time_Fs_Name),
+            Time_Type_Definition);
+         Set_Range_Constraint (Time_Subtype_Definition, Constraint);
+         Set_Base_Type (Time_Subtype_Definition, Time_Type_Definition);
+         --Set_Subtype_Type_Mark (Time_Subtype_Definition,
+         --                       Time_Type_Definition);
+         Set_Type_Staticness (Time_Subtype_Definition, Time_Staticness);
+         Set_Signal_Type_Flag (Time_Subtype_Definition, True);
+         Set_Has_Signal_Flag (Time_Subtype_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         --  subtype time is
+         Time_Subtype_Declaration :=
+           Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Time_Subtype_Declaration, Name_Time);
+         Set_Type (Time_Subtype_Declaration, Time_Subtype_Definition);
+         Set_Type_Declarator (Time_Subtype_Definition,
+                              Time_Subtype_Declaration);
+         Add_Decl (Time_Subtype_Declaration);
+         Set_Subtype_Definition
+           (Time_Type_Declaration, Time_Subtype_Definition);
+
+         -- The default time base.
+         case Flags.Time_Resolution is
+            when 'f' =>
+               Time_Base := Time_Fs_Unit;
+            when 'p' =>
+               Time_Base := Time_Ps_Unit;
+            when 'n' =>
+               Time_Base := Time_Ns_Unit;
+            when 'u' =>
+               Time_Base := Time_Us_Unit;
+            when 'm' =>
+               Time_Base := Time_Ms_Unit;
+            when 's' =>
+               Time_Base := Time_Sec_Unit;
+            when 'M' =>
+               Time_Base := Time_Min_Unit;
+            when 'h' =>
+               Time_Base := Time_Hr_Unit;
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --  VHDL93
+         --  subtype DELAY_LENGTH is TIME range 0 to TIME'HIGH
+         if Vhdl_Std >= Vhdl_93c then
+            Delay_Length_Subtype_Definition :=
+              Create_Std_Iir (Iir_Kind_Physical_Subtype_Definition);
+            Set_Subtype_Type_Mark
+              (Delay_Length_Subtype_Definition,
+               Create_Std_Type_Mark (Time_Subtype_Declaration));
+            Constraint := Create_Std_Range_Expr
+              (Create_Std_Phys_Lit (0, Time_Fs_Name),
+               Create_Std_Phys_Lit (High_Bound (Flags.Flag_Time_64),
+                                    Time_Fs_Name),
+               Time_Type_Definition);
+            Set_Range_Constraint (Delay_Length_Subtype_Definition, Constraint);
+            Set_Base_Type
+              (Delay_Length_Subtype_Definition, Time_Type_Definition);
+            Set_Type_Staticness
+              (Delay_Length_Subtype_Definition, Time_Staticness);
+            Set_Signal_Type_Flag (Delay_Length_Subtype_Definition, True);
+            Set_Has_Signal_Flag (Delay_Length_Subtype_Definition,
+                                 not Flags.Flag_Whole_Analyze);
+
+            --  subtype delay_length is ...
+            Delay_Length_Subtype_Declaration :=
+              Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+            Set_Std_Identifier (Delay_Length_Subtype_Declaration,
+                                Name_Delay_Length);
+            Set_Type (Delay_Length_Subtype_Declaration,
+                      Delay_Length_Subtype_Definition);
+            Set_Type_Declarator (Delay_Length_Subtype_Definition,
+                                 Delay_Length_Subtype_Declaration);
+            Set_Subtype_Indication (Delay_Length_Subtype_Declaration,
+                                    Delay_Length_Subtype_Definition);
+            Add_Decl (Delay_Length_Subtype_Declaration);
+         else
+            Delay_Length_Subtype_Definition := Null_Iir;
+            Delay_Length_Subtype_Declaration := Null_Iir;
+         end if;
+      end;
+
+      --  VHDL87:
+      --  function NOW return TIME
+      --
+      --  impure function NOW return DELAY_LENGTH.
+      declare
+         Function_Now : Iir_Implicit_Function_Declaration;
+      begin
+         Function_Now :=
+           Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration);
+         Set_Std_Identifier (Function_Now, Std_Names.Name_Now);
+         if Vhdl_Std = Vhdl_87 then
+            Set_Return_Type (Function_Now, Time_Subtype_Definition);
+         else
+            Set_Return_Type (Function_Now, Delay_Length_Subtype_Definition);
+         end if;
+         if Vhdl_Std = Vhdl_02 then
+            Set_Pure_Flag (Function_Now, True);
+         else
+            Set_Pure_Flag (Function_Now, False);
+         end if;
+         Set_Implicit_Definition (Function_Now, Iir_Predefined_Now_Function);
+         Sem.Compute_Subprogram_Hash (Function_Now);
+         Add_Decl (Function_Now);
+      end;
+
+      -- natural subtype
+      declare
+         Constraint : Iir_Range_Expression;
+      begin
+         Natural_Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition);
+         Set_Base_Type (Natural_Subtype_Definition, Integer_Type_Definition);
+         Set_Subtype_Type_Mark
+           (Natural_Subtype_Definition,
+            Create_Std_Type_Mark (Integer_Subtype_Declaration));
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Integer (0, Integer_Type_Definition),
+            Create_Std_Integer (High_Bound (Flags.Flag_Integer_64),
+                                Integer_Type_Definition),
+            Integer_Type_Definition);
+         Set_Range_Constraint (Natural_Subtype_Definition, Constraint);
+         Set_Type_Staticness (Natural_Subtype_Definition, Locally);
+         Set_Signal_Type_Flag (Natural_Subtype_Definition, True);
+         Set_Has_Signal_Flag (Natural_Subtype_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         Natural_Subtype_Declaration :=
+           Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Natural_Subtype_Declaration, Name_Natural);
+         Set_Type (Natural_Subtype_Declaration, Natural_Subtype_Definition);
+         Set_Subtype_Indication (Natural_Subtype_Declaration,
+                                 Natural_Subtype_Definition);
+         Add_Decl (Natural_Subtype_Declaration);
+         Set_Type_Declarator (Natural_Subtype_Definition,
+                              Natural_Subtype_Declaration);
+      end;
+
+      -- positive subtype
+      declare
+         Constraint : Iir_Range_Expression;
+      begin
+         Positive_Subtype_Definition :=
+           Create_Std_Iir (Iir_Kind_Integer_Subtype_Definition);
+         Set_Base_Type (Positive_Subtype_Definition,
+                        Integer_Type_Definition);
+         Set_Subtype_Type_Mark
+           (Positive_Subtype_Definition,
+            Create_Std_Type_Mark (Integer_Subtype_Declaration));
+         Constraint := Create_Std_Range_Expr
+           (Create_Std_Integer (1, Integer_Type_Definition),
+            Create_Std_Integer (High_Bound (Flags.Flag_Integer_64),
+                                Integer_Type_Definition),
+             Integer_Type_Definition);
+         Set_Range_Constraint (Positive_Subtype_Definition, Constraint);
+         Set_Type_Staticness (Positive_Subtype_Definition, Locally);
+         Set_Signal_Type_Flag (Positive_Subtype_Definition, True);
+         Set_Has_Signal_Flag (Positive_Subtype_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         Positive_Subtype_Declaration :=
+           Create_Std_Decl (Iir_Kind_Subtype_Declaration);
+         Set_Std_Identifier (Positive_Subtype_Declaration, Name_Positive);
+         Set_Type (Positive_Subtype_Declaration, Positive_Subtype_Definition);
+         Set_Subtype_Indication (Positive_Subtype_Declaration,
+                                 Positive_Subtype_Definition);
+         Add_Decl (Positive_Subtype_Declaration);
+         Set_Type_Declarator (Positive_Subtype_Definition,
+                              Positive_Subtype_Declaration);
+      end;
+
+      -- string type.
+      -- type string is array (positive range <>) of character;
+      declare
+         Element : Iir;
+         Index_List : Iir_List;
+      begin
+         Element := Create_Std_Type_Mark (Character_Type_Declaration);
+
+         String_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Array_Type_Definition);
+         Set_Base_Type (String_Type_Definition, String_Type_Definition);
+         Index_List := Create_Iir_List;
+         Append_Element (Index_List,
+                         Create_Std_Type_Mark (Positive_Subtype_Declaration));
+         Set_Index_Subtype_Definition_List (String_Type_Definition,
+                                            Index_List);
+         Set_Index_Subtype_List (String_Type_Definition, Index_List);
+         Set_Element_Subtype_Indication (String_Type_Definition, Element);
+         Set_Element_Subtype (String_Type_Definition,
+                              Character_Type_Definition);
+         Set_Type_Staticness (String_Type_Definition, None);
+         Set_Signal_Type_Flag (String_Type_Definition, True);
+         Set_Has_Signal_Flag (String_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         Create_Std_Type
+           (String_Type_Declaration, String_Type_Definition, Name_String);
+
+         Add_Implicit_Operations (String_Type_Declaration);
+      end;
+
+      if Vhdl_Std >= Vhdl_08 then
+         --  type Boolean_Vector is array (Natural range <>) of Boolean;
+         Create_Array_Type
+           (Boolean_Vector_Type_Definition, Boolean_Vector_Type_Declaration,
+            Boolean_Type_Declaration, Name_Boolean_Vector);
+      end if;
+
+      -- bit_vector type.
+      -- type bit_vector is array (natural range <>) of bit;
+      Create_Array_Type
+        (Bit_Vector_Type_Definition, Bit_Vector_Type_Declaration,
+         Bit_Type_Declaration, Name_Bit_Vector);
+
+      --  LRM08 5.3.2.4 Predefined operations on array types
+      --  The following operations are implicitly declared in package
+      --  STD.STANDARD immediately following the declaration of type
+      --  BIT_VECTOR:
+      if Vhdl_Std >= Vhdl_08 then
+         Create_To_String (Bit_Vector_Type_Definition,
+                           Iir_Predefined_Bit_Vector_To_Ostring,
+                           Name_To_Ostring);
+         Create_To_String (Bit_Vector_Type_Definition,
+                           Iir_Predefined_Bit_Vector_To_Hstring,
+                           Name_To_Hstring);
+      end if;
+
+      --  VHDL 2008
+      --  Vector types
+      if Vhdl_Std >= Vhdl_08 then
+         -- type integer_vector is array (natural range <>) of Integer;
+         Create_Array_Type
+           (Integer_Vector_Type_Definition, Integer_Vector_Type_Declaration,
+            Integer_Subtype_Declaration, Name_Integer_Vector);
+
+         -- type Real_vector is array (natural range <>) of Real;
+         Create_Array_Type
+           (Real_Vector_Type_Definition, Real_Vector_Type_Declaration,
+            Real_Subtype_Declaration, Name_Real_Vector);
+
+         -- type Time_vector is array (natural range <>) of Time;
+         Create_Array_Type
+           (Time_Vector_Type_Definition, Time_Vector_Type_Declaration,
+            Time_Subtype_Declaration, Name_Time_Vector);
+      end if;
+
+      --  VHDL93:
+      --  type file_open_kind is (read_mode, write_mode, append_mode);
+      if Vhdl_Std >= Vhdl_93c then
+         File_Open_Kind_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Base_Type (File_Open_Kind_Type_Definition,
+                        File_Open_Kind_Type_Definition);
+         Set_Enumeration_Literal_List
+           (File_Open_Kind_Type_Definition, Create_Iir_List);
+
+         File_Open_Kind_Read_Mode := Create_Std_Literal
+           (Name_Read_Mode, File_Open_Kind_Type_Definition);
+         File_Open_Kind_Write_Mode := Create_Std_Literal
+           (Name_Write_Mode, File_Open_Kind_Type_Definition);
+         File_Open_Kind_Append_Mode := Create_Std_Literal
+           (Name_Append_Mode, File_Open_Kind_Type_Definition);
+         Set_Type_Staticness (File_Open_Kind_Type_Definition, Locally);
+         Set_Signal_Type_Flag (File_Open_Kind_Type_Definition, True);
+         Set_Has_Signal_Flag (File_Open_Kind_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         --  type file_open_kind is
+         Create_Std_Type
+           (File_Open_Kind_Type_Declaration, File_Open_Kind_Type_Definition,
+            Name_File_Open_Kind);
+
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (File_Open_Kind_Type_Definition);
+         Add_Implicit_Operations (File_Open_Kind_Type_Declaration);
+      else
+         File_Open_Kind_Type_Declaration := Null_Iir;
+         File_Open_Kind_Type_Definition := Null_Iir;
+         File_Open_Kind_Read_Mode := Null_Iir;
+         File_Open_Kind_Write_Mode := Null_Iir;
+         File_Open_Kind_Append_Mode := Null_Iir;
+      end if;
+
+      --  VHDL93:
+      --  type file_open_status is
+      --      (open_ok, status_error, name_error, mode_error);
+      if Vhdl_Std >= Vhdl_93c then
+         File_Open_Status_Type_Definition :=
+           Create_Std_Iir (Iir_Kind_Enumeration_Type_Definition);
+         Set_Base_Type (File_Open_Status_Type_Definition,
+                        File_Open_Status_Type_Definition);
+         Set_Enumeration_Literal_List
+           (File_Open_Status_Type_Definition, Create_Iir_List);
+
+         File_Open_Status_Open_Ok := Create_Std_Literal
+           (Name_Open_Ok, File_Open_Status_Type_Definition);
+         File_Open_Status_Status_Error := Create_Std_Literal
+           (Name_Status_Error, File_Open_Status_Type_Definition);
+         File_Open_Status_Name_Error := Create_Std_Literal
+           (Name_Name_Error, File_Open_Status_Type_Definition);
+         File_Open_Status_Mode_Error := Create_Std_Literal
+           (Name_Mode_Error, File_Open_Status_Type_Definition);
+         Set_Type_Staticness (File_Open_Status_Type_Definition, Locally);
+         Set_Signal_Type_Flag (File_Open_Status_Type_Definition, True);
+         Set_Has_Signal_Flag (File_Open_Status_Type_Definition,
+                              not Flags.Flag_Whole_Analyze);
+
+         --  type file_open_kind is
+         Create_Std_Type (File_Open_Status_Type_Declaration,
+                          File_Open_Status_Type_Definition,
+                          Name_File_Open_Status);
+         Iirs_Utils.Create_Range_Constraint_For_Enumeration_Type
+           (File_Open_Status_Type_Definition);
+         Add_Implicit_Operations (File_Open_Status_Type_Declaration);
+      else
+         File_Open_Status_Type_Declaration := Null_Iir;
+         File_Open_Status_Type_Definition := Null_Iir;
+         File_Open_Status_Open_Ok := Null_Iir;
+         File_Open_Status_Status_Error := Null_Iir;
+         File_Open_Status_Name_Error := Null_Iir;
+         File_Open_Status_Mode_Error := Null_Iir;
+      end if;
+
+      --  VHDL93:
+      --  attribute FOREIGN: string;
+      if Vhdl_Std >= Vhdl_93c then
+         Foreign_Attribute := Create_Std_Decl (Iir_Kind_Attribute_Declaration);
+         Set_Std_Identifier (Foreign_Attribute, Name_Foreign);
+         Set_Type_Mark (Foreign_Attribute,
+                        Create_Std_Type_Mark (String_Type_Declaration));
+         Set_Type (Foreign_Attribute, String_Type_Definition);
+         Add_Decl (Foreign_Attribute);
+      else
+         Foreign_Attribute := Null_Iir;
+      end if;
+
+      if Vhdl_Std >= Vhdl_08 then
+         Create_To_String (Boolean_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+         Create_To_String (Bit_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+         Create_To_String (Character_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+         Create_To_String (Severity_Level_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+         Create_To_String (Universal_Integer_Type_Definition,
+                           Iir_Predefined_Integer_To_String);
+         Create_To_String (Universal_Real_Type_Definition,
+                           Iir_Predefined_Floating_To_String);
+         Create_To_String (Integer_Type_Definition,
+                           Iir_Predefined_Integer_To_String);
+         Create_To_String (Real_Type_Definition,
+                           Iir_Predefined_Floating_To_String);
+         Create_To_String (Time_Type_Definition,
+                           Iir_Predefined_Physical_To_String);
+         Create_To_String (File_Open_Kind_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+         Create_To_String (File_Open_Status_Type_Definition,
+                           Iir_Predefined_Enum_To_String);
+
+         --  Predefined overload TO_STRING operations
+         Create_To_String (Real_Type_Definition,
+                           Iir_Predefined_Real_To_String_Digits,
+                           Name_To_String,
+                           Name_Digits,
+                           Natural_Subtype_Definition);
+         Create_To_String (Real_Type_Definition,
+                           Iir_Predefined_Real_To_String_Format,
+                           Name_To_String,
+                           Name_Format,
+                           String_Type_Definition);
+         Create_To_String (Time_Type_Definition,
+                           Iir_Predefined_Time_To_String_Unit,
+                           Name_To_String,
+                           Name_Unit,
+                           Time_Subtype_Definition);
+      end if;
+
+   end Create_Std_Standard_Package;
+end Std_Package;
diff --git a/src/std_package.ads b/src/std_package.ads
new file mode 100644
index 000000000..166c3c789
--- /dev/null
+++ b/src/std_package.ads
@@ -0,0 +1,182 @@
+--  std.standard package declarations.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Iirs; use Iirs;
+
+package Std_Package is
+
+   --  This is a special node, not really declared in the STANDARD package,
+   --  used to mark a node as erroneous.
+   --  Its kind is Iir_Kind_Error.
+   Error_Mark : constant Iir;
+
+   -- Some well know values declared in the STANDARD package.
+   -- These values (except time_base) *must* not be modified, and are set by
+   -- create_std_standard_package.
+   -- Time_base is the base unit of time.  It is set during the creation of
+   -- all these nodes, and can be modified only *immediatly* after.
+
+   Time_Base: Iir_Unit_Declaration := Null_Iir;
+
+   Std_Standard_File: Iir_Design_File := Null_Iir;
+   Std_Standard_Unit : Iir_Design_Unit := Null_Iir;
+   Standard_Package : Iir_Package_Declaration := Null_Iir;
+
+   -- Boolean values.
+   Boolean_Type_Declaration : Iir_Type_Declaration := Null_Iir;
+   Boolean_Type_Definition : Iir_Enumeration_Type_Definition;
+   Boolean_False : Iir_Enumeration_Literal;
+   Boolean_True : Iir_Enumeration_Literal;
+
+   -- Bit values.
+   Bit_Type_Declaration : Iir_Type_Declaration := Null_Iir;
+   Bit_Type_Definition : Iir_Enumeration_Type_Definition;
+   Bit_0 : Iir_Enumeration_Literal;
+   Bit_1 : Iir_Enumeration_Literal;
+
+   -- Predefined character.
+   Character_Type_Declaration : Iir_Type_Declaration;
+   Character_Type_Definition : Iir_Enumeration_Type_Definition;
+
+   -- severity level.
+   Severity_Level_Type_Declaration : Iir_Type_Declaration;
+   Severity_Level_Type_Definition : Iir_Enumeration_Type_Definition;
+   Severity_Level_Note : Iir_Enumeration_Literal;
+   Severity_Level_Warning : Iir_Enumeration_Literal;
+   Severity_Level_Error : Iir_Enumeration_Literal;
+   Severity_Level_Failure : Iir_Enumeration_Literal;
+
+   -- Universal types.
+   Universal_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition;
+   Universal_Integer_Subtype_Declaration : Iir_Subtype_Declaration;
+   Universal_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   Universal_Integer_One : Iir_Integer_Literal;
+
+   Universal_Real_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition;
+   Universal_Real_Subtype_Declaration : Iir_Subtype_Declaration;
+   Universal_Real_Subtype_Definition : Iir_Floating_Subtype_Definition;
+
+   -- Predefined integer type.
+   Integer_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Integer_Type_Definition : Iir_Integer_Type_Definition;
+   Integer_Subtype_Declaration : Iir_Subtype_Declaration;
+   Integer_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   --  Type used when a subtype indication cannot be semantized.
+   --  FIXME: To be improved.
+   Error_Type : Iir_Integer_Type_Definition renames Integer_Type_Definition;
+
+   -- Predefined real type.
+   Real_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Real_Type_Definition : Iir_Floating_Type_Definition;
+   Real_Subtype_Declaration : Iir_Subtype_Declaration;
+   Real_Subtype_Definition : Iir_Floating_Subtype_Definition;
+
+   -- Predefined natural subtype.
+   Natural_Subtype_Declaration : Iir_Subtype_Declaration;
+   Natural_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   -- Predefined positive subtype.
+   Positive_Subtype_Declaration : Iir_Subtype_Declaration;
+   Positive_Subtype_Definition : Iir_Integer_Subtype_Definition;
+
+   -- Predefined positive subtype.
+   String_Type_Declaration : Iir_Type_Declaration;
+   String_Type_Definition : Iir_Array_Type_Definition;
+
+   -- Predefined positive subtype.
+   Bit_Vector_Type_Declaration : Iir_Type_Declaration;
+   Bit_Vector_Type_Definition : Iir_Array_Type_Definition;
+
+   -- predefined time subtype
+   Time_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Time_Type_Definition: Iir_Physical_Type_Definition;
+   Time_Subtype_Definition: Iir_Physical_Subtype_Definition;
+   Time_Subtype_Declaration : Iir_Subtype_Declaration;
+
+   --  For VHDL-93
+   Delay_Length_Subtype_Definition : Iir_Physical_Subtype_Definition;
+   Delay_Length_Subtype_Declaration : Iir_Subtype_Declaration;
+
+   --  For VHDL-93:
+   --  type File_Open_Kind
+   File_Open_Kind_Type_Declaration : Iir_Type_Declaration;
+   File_Open_Kind_Type_Definition : Iir_Enumeration_Type_Definition;
+   File_Open_Kind_Read_Mode : Iir_Enumeration_Literal;
+   File_Open_Kind_Write_Mode : Iir_Enumeration_Literal;
+   File_Open_Kind_Append_Mode : Iir_Enumeration_Literal;
+
+   --  For VHDL-93:
+   --  type File_Open_Status
+   File_Open_Status_Type_Declaration : Iir_Type_Declaration;
+   File_Open_Status_Type_Definition : Iir_Enumeration_Type_Definition;
+   File_Open_Status_Open_Ok : Iir_Enumeration_Literal;
+   File_Open_Status_Status_Error : Iir_Enumeration_Literal;
+   File_Open_Status_Name_Error : Iir_Enumeration_Literal;
+   File_Open_Status_Mode_Error : Iir_Enumeration_Literal;
+
+   --  For VHDL-93:
+   --    atribute foreign : string;
+   Foreign_Attribute : Iir_Attribute_Declaration;
+
+   --  For VHDL-08
+   Boolean_Vector_Type_Definition : Iir_Array_Type_Definition;
+   Boolean_Vector_Type_Declaration : Iir_Type_Declaration;
+
+   Integer_Vector_Type_Definition : Iir_Array_Type_Definition;
+   Integer_Vector_Type_Declaration : Iir_Type_Declaration;
+
+   Real_Vector_Type_Definition : Iir_Array_Type_Definition;
+   Real_Vector_Type_Declaration : Iir_Type_Declaration;
+
+   Time_Vector_Type_Definition : Iir_Array_Type_Definition;
+   Time_Vector_Type_Declaration : Iir_Type_Declaration;
+
+   --  Internal use only.
+   --  These types should be considered like universal types, but
+   --  furthermore, they can be converted to any integer/real types while
+   --  universal cannot.
+   Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition;
+   Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition;
+   Convertible_Integer_Type_Declaration : Iir_Anonymous_Type_Declaration;
+   Convertible_Real_Type_Declaration : Iir_Anonymous_Type_Declaration;
+
+   Convertible_Integer_Subtype_Definition : Iir_Integer_Subtype_Definition;
+   Convertible_Integer_Subtype_Declaration : Iir_Subtype_Declaration;
+
+   --  Create the first well-known nodes.
+   procedure Create_First_Nodes;
+
+   --  Create the node for the standard package.
+   procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration);
+
+private
+   --  For speed reasons, some often used nodes are hard-coded.
+   Error_Mark : constant Iir := 2;
+   Universal_Integer_Type_Definition : constant Iir_Integer_Type_Definition
+     := 3;
+   Universal_Real_Type_Definition : constant Iir_Floating_Type_Definition
+     := 4;
+
+   Convertible_Integer_Type_Definition : constant Iir_Integer_Type_Definition
+     := 5;
+   Convertible_Real_Type_Definition : constant Iir_Floating_Type_Definition
+     := 6;
+end Std_Package;
diff --git a/src/str_table.adb b/src/str_table.adb
new file mode 100644
index 000000000..947c98792
--- /dev/null
+++ b/src/str_table.adb
@@ -0,0 +1,92 @@
+--  String table.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; 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_Conversion;
+with GNAT.Table;
+
+package body Str_Table is
+   package String_Table is new GNAT.Table
+     (Table_Index_Type => String_Id,
+      Table_Component_Type => Character,
+      Table_Low_Bound => Null_String + 1,
+      Table_Initial => 4096,
+      Table_Increment => 100);
+
+   Nul : constant Character := Character'Val (0);
+
+   In_String : Boolean := False;
+   function Start return String_Id
+   is
+   begin
+      pragma Assert (In_String = False);
+      In_String := True;
+      return String_Table.Last + 1;
+   end Start;
+
+   procedure Append (C : Character) is
+   begin
+      pragma Assert (In_String);
+      String_Table.Append (C);
+   end Append;
+
+   procedure Finish is
+   begin
+      pragma Assert (In_String);
+      String_Table.Append (Nul);
+      In_String := False;
+   end Finish;
+
+   function Get_String_Fat_Acc (Id : String_Id) return String_Fat_Acc
+   is
+      function To_String_Fat_Acc is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => String_Fat_Acc);
+   begin
+      return To_String_Fat_Acc (String_Table.Table (Id)'Address);
+   end Get_String_Fat_Acc;
+
+   function Get_Length (Id : String_Id) return Natural
+   is
+      Ptr : String_Fat_Acc;
+      Len : Nat32;
+   begin
+      Ptr := Get_String_Fat_Acc (Id);
+      Len := 1;
+      loop
+         if Ptr (Len) = Nul then
+            return Natural (Len - 1);
+         end if;
+         Len := Len + 1;
+      end loop;
+   end Get_Length;
+
+   function Image (Id : String_Id) return String
+   is
+      Ptr : String_Fat_Acc;
+      Len : Nat32;
+   begin
+      Len := Nat32 (Get_Length (Id));
+      Ptr := Get_String_Fat_Acc (Id);
+      return String (Ptr (1 .. Len));
+   end Image;
+
+   procedure Initialize is
+   begin
+      String_Table.Free;
+      String_Table.Init;
+   end Initialize;
+end Str_Table;
diff --git a/src/str_table.ads b/src/str_table.ads
new file mode 100644
index 000000000..de65070e3
--- /dev/null
+++ b/src/str_table.ads
@@ -0,0 +1,44 @@
+--  String table.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+
+package Str_Table is
+   --  Create a new entry in the string table and returns a number to it.
+   function Start return String_Id;
+   pragma Inline (Start);
+
+   --  Add a new character in the current entry.
+   procedure Append (C : Character);
+   pragma Inline (Append);
+
+   --  Finish the current entry.
+   procedure Finish;
+   pragma Inline (Finish);
+
+   --  Get a fat access to the string ID.
+   function Get_String_Fat_Acc (Id : String_Id) return String_Fat_Acc;
+   pragma Inline (Get_String_Fat_Acc);
+
+   --  Get ID as a string.
+   --  This function is slow, to be used only for debugging.
+   function Image (Id : String_Id) return String;
+
+   --  Free all the memory and reinitialize the package.
+   procedure Initialize;
+end Str_Table;
+
diff --git a/src/tokens.adb b/src/tokens.adb
new file mode 100644
index 000000000..5d27be8d9
--- /dev/null
+++ b/src/tokens.adb
@@ -0,0 +1,443 @@
+--  Scanner token definitions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package body Tokens is
+   -- Return the name of the token.
+   function Image (Token: Token_Type) return String is
+   begin
+      case Token is
+         when Tok_Invalid =>
+            return "<invalid>";
+         when Tok_Left_Paren =>
+            return "(";
+         when Tok_Right_Paren =>
+            return ")";
+         when Tok_Left_Bracket =>
+            return "[";
+         when Tok_Right_Bracket =>
+            return "]";
+         when Tok_Colon =>
+            return ":";
+         when Tok_Semi_Colon =>
+            return ";";
+         when Tok_Comma =>
+            return ",";
+         when Tok_Tick =>
+            return "'";
+         when Tok_Double_Star =>
+            return "**";
+         when Tok_Double_Arrow =>
+            return "=>";
+         when Tok_Assign =>
+            return ":=";
+         when Tok_Bar =>
+            return "|";
+         when Tok_Box =>
+            return "<>";
+         when Tok_Dot =>
+            return ".";
+
+         when Tok_Eof =>
+            return "<EOF>";
+         when Tok_Newline =>
+            return "<newline>";
+         when Tok_Comment =>
+            return "<comment>";
+         when Tok_Character =>
+            return "<character>";
+         when Tok_Identifier =>
+            return "<identifier>";
+         when Tok_Integer =>
+            return "<integer>";
+         when Tok_Real =>
+            return "<real>";
+         when Tok_String =>
+            return "<string>";
+         when Tok_Bit_String =>
+            return "<bit string>";
+
+         when Tok_Equal_Equal =>
+            return "==";
+
+         -- relational_operator:
+         when Tok_Equal =>
+            return "=";
+         when Tok_Not_Equal =>
+            return "/=";
+         when Tok_Less =>
+            return "<";
+         when Tok_Less_Equal =>
+            return "<=";
+         when Tok_Greater =>
+            return ">";
+         when Tok_Greater_Equal =>
+            return ">=";
+
+         when Tok_Match_Equal =>
+            return "?=";
+         when Tok_Match_Not_Equal =>
+            return "?/=";
+         when Tok_Match_Less =>
+            return "?<";
+         when Tok_Match_Less_Equal =>
+            return "?<=";
+         when Tok_Match_Greater =>
+            return "?>";
+         when Tok_Match_Greater_Equal =>
+            return "?>=";
+
+         -- sign token
+         when Tok_Plus =>
+            return "+";
+         when Tok_Minus =>
+            return "-";
+         -- and adding_operator
+         when Tok_Ampersand =>
+            return "&";
+
+         when Tok_Condition =>
+            return "??";
+
+         -- multiplying operator
+         when Tok_Star =>
+            return "*";
+         when Tok_Slash =>
+            return "/";
+         when Tok_Mod =>
+            return "mod";
+         when Tok_Rem =>
+            return "rem";
+
+         -- relation token:
+         when Tok_And =>
+            return "and";
+         when Tok_Or =>
+            return "or";
+         when Tok_Xor =>
+            return "xor";
+         when Tok_Nand =>
+            return "nand";
+         when Tok_Nor =>
+            return "nor";
+         when Tok_Xnor =>
+            return "xnor";
+
+         -- Reserved words.
+         when Tok_Abs =>
+            return "abs";
+         when Tok_Access =>
+            return "access";
+         when Tok_After =>
+            return "after";
+         when Tok_Alias =>
+            return "alias";
+         when Tok_All =>
+            return "all";
+         when Tok_Architecture =>
+            return "architecture";
+         when Tok_Array =>
+            return "array";
+         when Tok_Assert =>
+            return "assert";
+         when Tok_Attribute =>
+            return "attribute";
+
+         when Tok_Begin =>
+            return "begin";
+         when Tok_Block =>
+            return "block";
+         when Tok_Body =>
+            return "body";
+         when Tok_Buffer =>
+            return "buffer";
+         when Tok_Bus =>
+            return "bus";
+
+         when Tok_Case =>
+            return "case";
+         when Tok_Component =>
+            return "component";
+         when Tok_Configuration =>
+            return "configuration";
+         when Tok_Constant =>
+            return "constant";
+
+         when Tok_Disconnect =>
+            return "disconnect";
+         when Tok_Downto =>
+            return "downto";
+
+         when Tok_Else =>
+            return "else";
+         when Tok_Elsif =>
+            return "elsif";
+         when Tok_End =>
+            return "end";
+         when Tok_Entity =>
+            return "entity";
+         when Tok_Exit =>
+            return "exit";
+
+         when Tok_File =>
+            return "file";
+         when Tok_For =>
+            return "for";
+         when Tok_Function =>
+            return "function";
+
+         when Tok_Generate =>
+            return "generate";
+         when Tok_Generic =>
+            return "generic";
+         when Tok_Group =>
+            return "group";
+         when Tok_Guarded =>
+            return "guarded";
+
+         when Tok_If =>
+            return "if";
+         when Tok_Impure =>
+            return "impure";
+         when Tok_In =>
+            return "in";
+         when Tok_Inertial =>
+            return "inertial";
+         when Tok_Inout =>
+            return "inout";
+         when Tok_Is =>
+            return "is";
+
+         when Tok_Label =>
+            return "label";
+         when Tok_Library =>
+            return "library";
+         when Tok_Linkage =>
+            return "linkage";
+         when Tok_Literal =>
+            return "literal";
+         when Tok_Loop =>
+            return "loop";
+
+         when Tok_Map =>
+            return "map";
+
+         when Tok_New =>
+            return "new";
+         when Tok_Next =>
+            return "next";
+         when Tok_Not =>
+            return "not";
+         when Tok_Null =>
+            return "null";
+
+         when Tok_Of =>
+            return "of";
+         when Tok_On =>
+            return "on";
+         when Tok_Open =>
+            return "open";
+         when Tok_Out =>
+            return "out";
+         when Tok_Others =>
+            return "others";
+
+         when Tok_Package =>
+            return "package";
+         when Tok_Port =>
+            return "port";
+         when Tok_Postponed =>
+            return "postponed";
+         when Tok_Procedure =>
+            return "procedure";
+         when Tok_Process =>
+            return "process";
+         when Tok_Pure =>
+            return "pure";
+
+         when Tok_Range =>
+            return "range";
+         when Tok_Record =>
+            return "record";
+         when Tok_Register =>
+            return "register";
+         when Tok_Reject =>
+            return "reject";
+         when Tok_Report =>
+            return "report";
+         when Tok_Return =>
+            return "return";
+
+         when Tok_Select =>
+            return "select";
+         when Tok_Severity =>
+            return "severity";
+         when Tok_Shared =>
+            return "shared";
+         when Tok_Signal =>
+            return "signal";
+         when Tok_Subtype =>
+            return "subtype";
+
+         when Tok_Then =>
+            return "then";
+         when Tok_To =>
+            return "to";
+         when Tok_Transport =>
+            return "transport";
+         when Tok_Type =>
+            return "type";
+
+         when Tok_Unaffected =>
+            return "unaffected";
+         when Tok_Units =>
+            return "units";
+         when Tok_Until =>
+            return "until";
+         when Tok_Use =>
+            return "use";
+
+         when Tok_Variable =>
+            return "variable";
+
+         when Tok_Wait =>
+            return "wait";
+         when Tok_When =>
+            return "when";
+         when Tok_While =>
+            return "while";
+         when Tok_With =>
+            return "with";
+
+         -- shift_operator
+         when Tok_Sll =>
+            return "sll";
+         when Tok_Sla =>
+            return "sla";
+         when Tok_Sra =>
+            return "sra";
+         when Tok_Srl =>
+            return "srl";
+         when Tok_Rol =>
+            return "rol";
+         when Tok_Ror =>
+            return "ror";
+
+         --  VHDL 00
+         when Tok_Protected =>
+            return "protected";
+
+         --  AMS-VHDL
+         when Tok_Across =>
+            return "across";
+         when Tok_Break =>
+            return "break";
+         when Tok_Limit =>
+            return "limit";
+         when Tok_Nature =>
+            return "nature";
+         when Tok_Noise =>
+            return "noise";
+         when Tok_Procedural =>
+            return "procedural";
+         when Tok_Quantity =>
+            return "quantity";
+         when Tok_Reference =>
+            return "reference";
+         when Tok_Spectrum =>
+            return "spectrum";
+         when Tok_Subnature =>
+            return "subnature";
+         when Tok_Terminal =>
+            return "terminal";
+         when Tok_Through =>
+            return "through";
+         when Tok_Tolerance =>
+            return "tolerance";
+
+         when Tok_And_And =>
+            return "&&";
+         when Tok_Bar_Bar =>
+            return "||";
+         when Tok_Left_Curly =>
+            return "{";
+         when Tok_Right_Curly =>
+            return "}";
+         when Tok_Exclam_Mark =>
+            return "!";
+         when Tok_Brack_Star =>
+            return "[*";
+         when Tok_Brack_Plus_Brack =>
+            return "[+]";
+         when Tok_Brack_Arrow =>
+            return "[->";
+         when Tok_Brack_Equal =>
+            return "[=";
+         when Tok_Bar_Arrow =>
+            return "|->";
+         when Tok_Bar_Double_Arrow =>
+            return "|=>";
+         when Tok_Minus_Greater =>
+            return "->";
+         when Tok_Arobase =>
+            return "@";
+
+         when Tok_Psl_Default =>
+            return "default";
+         when Tok_Psl_Clock =>
+            return "clock";
+         when Tok_Psl_Property =>
+            return "property";
+         when Tok_Psl_Sequence =>
+            return "sequence";
+         when Tok_Psl_Endpoint =>
+            return "endpoint";
+         when Tok_Psl_Assert =>
+            return "assert";
+         when Tok_Psl_Cover =>
+            return "cover";
+         when Tok_Psl_Const =>
+            return "const";
+         when Tok_Psl_Boolean =>
+            return "boolean";
+         when Tok_Inf =>
+            return "inf";
+         when Tok_Within =>
+            return "within";
+         when Tok_Abort =>
+            return "abort";
+         when Tok_Before =>
+            return "before";
+         when Tok_Always =>
+            return "always";
+         when Tok_Never =>
+            return "never";
+         when Tok_Eventually =>
+            return "eventually";
+         when Tok_Next_A =>
+            return "next_a";
+         when Tok_Next_E =>
+            return "next_e";
+         when Tok_Next_Event =>
+            return "next_event";
+         when Tok_Next_Event_A =>
+            return "next_event_a";
+         when Tok_Next_Event_E =>
+            return "next_event_e";
+      end case;
+   end Image;
+
+end Tokens;
diff --git a/src/tokens.ads b/src/tokens.ads
new file mode 100644
index 000000000..c72873103
--- /dev/null
+++ b/src/tokens.ads
@@ -0,0 +1,279 @@
+--  Scanner token definitions.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Tokens is
+   pragma Pure (Tokens);
+
+   type Token_Type is
+      (
+       Tok_Invalid,     -- current_token is not valid.
+
+       Tok_Left_Paren,          -- (
+       Tok_Right_Paren,         -- )
+       Tok_Left_Bracket,        -- [
+       Tok_Right_Bracket,       -- ]
+       Tok_Colon,               -- :
+       Tok_Semi_Colon,          -- ;
+       Tok_Comma,               -- ,
+       Tok_Double_Arrow,        -- =>
+       Tok_Tick,                -- '
+       Tok_Double_Star,         -- **
+       Tok_Assign,              -- :=
+       Tok_Bar,                 -- |
+       Tok_Box,                 -- <>
+       Tok_Dot,                 -- .
+
+       Tok_Equal_Equal,         -- == (AMS Vhdl)
+
+       Tok_Eof,                 -- End of file.
+       Tok_Newline,
+       Tok_Comment,
+       Tok_Character,
+       Tok_Identifier,
+       Tok_Integer,
+       Tok_Real,
+       Tok_String,
+       Tok_Bit_String,
+
+   -- relational_operator
+       Tok_Equal,               -- =
+       Tok_Not_Equal,           -- /=
+       Tok_Less,                -- <
+       Tok_Less_Equal,          -- <=
+       Tok_Greater,             -- >
+       Tok_Greater_Equal,       -- >=
+
+       Tok_Match_Equal,         -- ?=
+       Tok_Match_Not_Equal,     -- ?/=
+       Tok_Match_Less,          -- ?<
+       Tok_Match_Less_Equal,    -- ?<=
+       Tok_Match_Greater,       -- ?>
+       Tok_Match_Greater_Equal, -- ?>=
+
+   -- sign token
+       Tok_Plus,                -- +
+       Tok_Minus,               -- -
+   -- and adding_operator
+       Tok_Ampersand,           -- &
+
+       Tok_Condition,           -- ??
+
+   --  PSL
+       Tok_And_And,             -- &&
+       Tok_Bar_Bar,             -- ||
+       Tok_Left_Curly,          -- {
+       Tok_Right_Curly,         -- }
+       Tok_Exclam_Mark,         -- !
+       Tok_Brack_Star,          -- [*
+       Tok_Brack_Plus_Brack,    -- [+]
+       Tok_Brack_Arrow,         -- [->
+       Tok_Brack_Equal,         -- [=
+       Tok_Bar_Arrow,           -- |->
+       Tok_Bar_Double_Arrow,    -- |=>
+       Tok_Minus_Greater,       -- ->
+       Tok_Arobase,             -- @
+
+   -- multiplying operator
+       Tok_Star,                -- *
+       Tok_Slash,               -- /
+       Tok_Mod,                 -- mod
+       Tok_Rem,                 -- rem
+
+   -- relation token:
+       Tok_And,
+       Tok_Or,
+       Tok_Xor,
+       Tok_Nand,
+       Tok_Nor,
+
+   --  miscellaneous operator
+       Tok_Abs,
+       Tok_Not,
+
+   -- Key words
+       Tok_Access,
+       Tok_After,
+       Tok_Alias,
+       Tok_All,
+       Tok_Architecture,
+       Tok_Array,
+       Tok_Assert,
+       Tok_Attribute,
+
+       Tok_Begin,
+       Tok_Block,
+       Tok_Body,
+       Tok_Buffer,
+       Tok_Bus,
+
+       Tok_Case,
+       Tok_Component,
+       Tok_Configuration,
+       Tok_Constant,
+
+       Tok_Disconnect,
+       Tok_Downto,
+
+       Tok_Else,
+       Tok_Elsif,
+       Tok_End,
+       Tok_Entity,
+       Tok_Exit,
+
+       Tok_File,
+       Tok_For,
+       Tok_Function,
+
+       Tok_Generate,
+       Tok_Generic,
+       Tok_Guarded,
+
+       Tok_If,
+       Tok_In,
+       Tok_Inout,
+       Tok_Is,
+
+       Tok_Label,
+       Tok_Library,
+       Tok_Linkage,
+       Tok_Loop,
+
+       Tok_Map,
+
+       Tok_New,
+       Tok_Next,
+       Tok_Null,
+
+       Tok_Of,
+       Tok_On,
+       Tok_Open,
+       Tok_Others,
+       Tok_Out,
+
+       Tok_Package,
+       Tok_Port,
+       Tok_Procedure,
+       Tok_Process,
+
+       Tok_Range,
+       Tok_Record,
+       Tok_Register,
+       Tok_Report,
+       Tok_Return,
+
+       Tok_Select,
+       Tok_Severity,
+       Tok_Signal,
+       Tok_Subtype,
+
+       Tok_Then,
+       Tok_To,
+       Tok_Transport,
+       Tok_Type,
+
+       Tok_Units,
+       Tok_Until,
+       Tok_Use,
+
+       Tok_Variable,
+
+       Tok_Wait,
+       Tok_When,
+       Tok_While,
+       Tok_With,
+
+   -- Tokens below this line are key words in vhdl93 but not in vhdl87
+       Tok_Xnor,
+       Tok_Group,
+       Tok_Impure,
+       Tok_Inertial,
+       Tok_Literal,
+       Tok_Postponed,
+       Tok_Pure,
+       Tok_Reject,
+       Tok_Shared,
+       Tok_Unaffected,
+
+   -- shift_operator
+       Tok_Sll,
+       Tok_Sla,
+       Tok_Sra,
+       Tok_Srl,
+       Tok_Rol,
+       Tok_Ror,
+
+   -- Added by Vhdl 2000:
+       Tok_Protected,
+
+   --  AMS reserved words
+       Tok_Across,
+       Tok_Break,
+       Tok_Limit,
+       Tok_Nature,
+       Tok_Noise,
+       Tok_Procedural,
+       Tok_Quantity,
+       Tok_Reference,
+       Tok_Spectrum,
+       Tok_Subnature,
+       Tok_Terminal,
+       Tok_Through,
+       Tok_Tolerance,
+
+   -- PSL words
+       Tok_Psl_Default,
+       Tok_Psl_Clock,
+       Tok_Psl_Property,
+       Tok_Psl_Sequence,
+       Tok_Psl_Endpoint,
+       Tok_Psl_Assert,
+       Tok_Psl_Cover,
+
+       Tok_Psl_Const,
+       Tok_Psl_Boolean,
+       Tok_Inf,
+
+       Tok_Within,
+       Tok_Abort,
+       Tok_Before,
+       Tok_Always,
+       Tok_Never,
+       Tok_Eventually,
+       Tok_Next_A,
+       Tok_Next_E,
+       Tok_Next_Event,
+       Tok_Next_Event_A,
+       Tok_Next_Event_E
+      );
+
+   -- subtype Token_Relation_Type is Token_Type range Tok_And .. Tok_Xnor;
+   subtype Token_Relational_Operator_Type is Token_Type range
+     Tok_Equal .. Tok_Match_Greater_Equal;
+   subtype Token_Shift_Operator_Type is Token_Type range
+     Tok_Sll .. Tok_Ror;
+   subtype Token_Sign_Type is Token_Type range
+     Tok_Plus .. Tok_Minus;
+   subtype Token_Adding_Operator_Type is Token_Type range
+     Tok_Plus .. Tok_Ampersand;
+   subtype Token_Multiplying_Operator_Type is Token_Type range
+     Tok_Star .. Tok_Rem;
+
+   Tok_First_Keyword :  constant Tokens.Token_Type := Tokens.Tok_Mod;
+
+   -- Return the name of the token.
+   function Image (Token: Token_Type) return String;
+end Tokens;
diff --git a/src/translate/Makefile b/src/translate/Makefile
new file mode 100644
index 000000000..b331b5728
--- /dev/null
+++ b/src/translate/Makefile
@@ -0,0 +1,45 @@
+#  -*- Makefile -*- for the GHDL translation back-end.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+BE=gcc
+ortho_srcdir=../ortho
+GNAT_FLAGS=-aI.. -aI../psl -gnaty3befhkmr -gnata -gnatf -gnatwael -gnat05
+#GNAT_FLAGS+=-O -gnatn
+LN=ln -s
+
+compiler: force # ortho_nodes.ads ortho_$(BE)_front.ads
+	$(MAKE) -f $(ortho_srcdir)/$(BE)/Makefile \
+	 ortho_srcdir=$(ortho_srcdir) GNAT_FLAGS="$(GNAT_FLAGS)" \
+	 ortho_exec=ghdl1-$(BE) all
+
+all:
+	[ -d lib ] || mkdir lib
+	$(MAKE) -f $(ortho_srcdir)/gcc/Makefile \
+	 ortho_srcdir=$(ortho_srcdir) GNAT_FLAGS="$(GNAT_FLAGS)" \
+	 ortho_exec=ghdl1-gcc all
+	$(MAKE) -C ghdldrv
+	$(MAKE) -C grt all libdir=`pwd`/lib
+	$(MAKE) -C ghdldrv install.v87 install.v93 install.standard
+
+clean:
+	$(RM) *.o *.ali ghdl1-* gen_tree ortho_nodes-main b~*.ad?
+	$(RM) *~ ortho_nodes.ads ortho_nodes.tmp
+
+force:
+
+.PHONY: compiler clean force all
diff --git a/src/translate/gcc/ANNOUNCE b/src/translate/gcc/ANNOUNCE
new file mode 100644
index 000000000..7b1060e20
--- /dev/null
+++ b/src/translate/gcc/ANNOUNCE
@@ -0,0 +1,21 @@
+I am happy to introduce GHDL.
+
+GHDL is a GCC front-end for the VHDL (IEEE 1076) language, an hardware design
+language.
+
+Currently, GHDL implements most of VHDL-1987 and some features of
+VHDL-1993.  It is mature enough to compile and run some complex design (such
+as a DLX processor and leon1, a SPARCv7 processor)
+
+GHDL has been developped on a GNU/Linux x86 system, and only this configuration
+has been tested (porting to other processor or system should not be an hard
+task, but there are system dependent files in the run time).
+
+GHDL is written in Ada95 (using GNAT) and relies on agcc, an Ada
+binding for GCC.  It also includes a run-time library (written in Ada), named
+grt.  The front-end and the library are both distributed under the GPL licence.
+
+For sources, binary tarballs, or for more information, go to
+http://ghdl.free.fr
+
+Tristan Gingold.
diff --git a/src/translate/gcc/INSTALL b/src/translate/gcc/INSTALL
new file mode 100644
index 000000000..e710f9110
--- /dev/null
+++ b/src/translate/gcc/INSTALL
@@ -0,0 +1,24 @@
+Install file for the binary distribution of GHDL.
+
+GHDL is Copyright 2002 - 2010 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 of the License, or
+(at your option) any later version.
+
+The binary are installed in /usr/local directory.  You cannot change this
+default location, unless you set links.
+
+You must be root to install this distribution.
+
+To install ghdl:
+$ su 
+# tar -C / -jxvf @TARFILE@.tar.bz2
+
+Note: you must also have a C compiler and zlib installed.
+
+There is a mailing list for any questions.  You can subscribe via:
+  https://mail.gna.org/listinfo/ghdl-discuss/
+
+Tristan Gingold.
+
diff --git a/src/translate/gcc/Make-lang.in b/src/translate/gcc/Make-lang.in
new file mode 100644
index 000000000..cde3e6c07
--- /dev/null
+++ b/src/translate/gcc/Make-lang.in
@@ -0,0 +1,190 @@
+# Top level -*- makefile -*- fragment for vhdl (GHDL).
+#   Copyright (C) 2002
+#   Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC 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.
+
+#GNU CC 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 GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330,
+#Boston, MA 02111-1307, USA.
+
+# This file provides the language dependent support in the main Makefile.
+# Each language makefile fragment must provide the following targets:
+#
+# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
+# foo.info, foo.dvi,
+# foo.install-normal, foo.install-common, foo.install-info, foo.install-man,
+# foo.uninstall, foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean,
+# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
+#
+# where `foo' is the name of the language.
+#
+# It should also provide rules for:
+#
+# - making any compiler driver (eg: g++)
+# - the compiler proper (eg: cc1plus)
+# - define the names for selecting the language in LANGUAGES.
+# tool definitions
+MV = mv
+RM = rm -f
+
+# Extra flags to pass to recursive makes.
+GHDL_ADAFLAGS= -Wall -gnata
+VHDL_LIB_DIR=$(libsubdir)/vhdl
+GNATBIND = gnatbind
+GNATMAKE = gnatmake
+VHDL_FLAGS_TO_PASS = \
+	"GHDL_ADAFLAGS=$(GHDL_ADAFLAGS)" \
+	"GNATMAKE=$(GNATMAKE)" \
+	"GNATBIND=$(GNATBIND)" \
+	"CFLAGS=$(CFLAGS)" \
+	"VHDL_LIB_DIR=$(VHDL_LIB_DIR)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+        "libexecsubdir=$(libexecsubdir)"
+
+MAKE_IN_VHDL=$(MAKE) -C vhdl $(FLAGS_TO_PASS) $(VHDL_FLAGS_TO_PASS)
+
+# Define the names for selecting vhdl in LANGUAGES.
+vhdl VHDL: ghdl1$(exeext) ghdl$(exeext) ghdllib
+
+# Tell GNU Make to ignore these, if they exist.
+.PHONY: vhdl VHDL ghdllib
+
+#ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \
+# $(AGCC_GCCOBJ_DIR)gcc/gtype-vhdl.h \
+# $(AGCC_GCCOBJ_DIR)gcc/gt-vhdl-ortho-lang.h
+#	$(COMPILER) -c -o $@ $< $(AGCC_CFLAGS) $(INCLUDES)
+
+GHDL1_OBJS = attribs.o vhdl/ortho-lang.o
+
+# To be put in ALL_HOST_FRONTEND_OBJS, so that generated files are created
+# before.
+vhdl_OBJS=vhdl/ortho-lang.o
+
+# The compiler proper.
+# It is compiled into the vhdl/ subdirectory to avoid file name clashes but
+# linked in in gcc directory to be able to access to gcc object files.
+ghdl1$(exeext): force $(GHDL1_OBJS) $(BACKEND) $(LIBDEPS)
+	CURDIR=`pwd`; cd $(srcdir)/vhdl; VHDLSRCDIR=`pwd`; cd $$CURDIR/vhdl; \
+	$(GNATMAKE) -c -aI$$VHDLSRCDIR ortho_gcc-main \
+	 -cargs $(CFLAGS) $(GHDL_ADAFLAGS)
+	$(GNATMAKE) -o $@ -aI$(srcdir)/vhdl -aOvhdl ortho_gcc-main \
+	 -bargs -E -cargs $(CFLAGS) $(GHDL_ADAFLAGS) \
+	 -largs --LINK=$(LLINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) $(GHDL1_OBJS) \
+	 $(filter-out main.o,$(BACKEND)) $(LIBS) $(BACKENDLIBS)
+
+# The driver for ghdl.
+ghdl$(exeext): force
+	$(MAKE_IN_VHDL) ../ghdl$(exeext)
+
+# Ghdl libraries.
+ghdllib: ghdl$(exeext) ghdl1$(exeext) $(GCC_PASSES) force
+	$(MAKE_IN_VHDL) GRT_FLAGS="-O -g" $(FLAGS_TO_PASS) \
+	 ADAC=$(COMPILER_FOR_BUILD) ghdllib
+
+# Build hooks:
+
+vhdl.all.build:
+
+vhdl.all.cross:
+	@echo "No support for building vhdl cross-compiler"
+	exit 1
+
+vhdl.start.encap:
+vhdl.rest.encap:
+
+# Documentation hooks
+doc/ghdl.info: vhdl/ghdl.texi
+	-rm -f doc/ghdl.info*
+	$(MAKEINFO) $(MAKEINFOFLAGS) -o $@ $<
+
+doc/ghdl.dvi: vhdl/ghdl.texi
+	$(TEXI2DVI) -o $@ $<
+
+vhdl.info: doc/ghdl.info
+
+vhdl.man:
+
+vhdl.dvi: doc/ghdl.dvi
+
+vhdl.generated-manpages:
+
+# Install hooks:
+# ghdl1 is installed elsewhere as part of $(COMPILERS).
+
+vhdl.install-normal:
+
+vhdl.install-plugin:
+
+# Install the driver program as ghdl.
+vhdl.install-common: ghdl$(exeext)
+	-mkdir $(DESTDIR)$(bindir)
+	-$(RM) $(DESTDIR)$(bindir)/ghdl$(exeext)
+	$(INSTALL_PROGRAM) ghdl$(exeext) $(DESTDIR)$(bindir)/ghdl$(exeext)
+# Install the library
+	$(MAKE_IN_VHDL) install-ghdllib
+
+install-info:: $(DESTDIR)$(infodir)/ghdl.info
+
+vhdl.install-info: doc/ghdl.info
+	-rm -rf $(infodir)/ghdl.info*
+	$(INSTALL_DATA) doc/ghdl.info* $(DESTDIR)$(infodir)
+	-chmod a-x $(DESTDIR)$(infodir)/ghdl.info*
+
+install-ghdllib:
+	$(MAKE) -f vhdl/Makefile $(FLAGS_TO_PASS) $(VHDL_FLAGS_TO_PASS) install-ghdllib
+
+vhdl.install-man: $(DESTDIR)$(man1dir)/ghdl$(man1ext)
+
+$(DESTDIR)$(man1dir)/ghdl$(man1ext): $(srcdir)/vhdl/ghdl.1
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+vhdl.uninstall:
+	-$(RM) $(DESTDIR)$(bindir)/ghdl$(exeext)
+
+
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+vhdl.mostlyclean:
+	-$(RM) vhdl/*$(objext) vhdl/*.ali vhdl/b_*.c
+vhdl.clean:
+	-$(RM) vhdl/*$(objext)
+vhdl.distclean:
+	-$(RM) vhdl/Makefile
+	-$(RM) ghdl$(exeext)
+vhdl.extraclean:
+
+vhdl.maintainer-clean:
+
+
+# Stage hooks:
+# The main makefile has already created stage?/vhdl
+
+vhdl.stage1:
+	-$(MV) vhdl/*$(objext) vhdl/*.ali vhdl/b_*.c stage1/vhdl
+	-$(MV) vhdl/stamp-* stage1/vhdl
+vhdl.stage2:
+	-$(MV) vhdl/*$(objext) vhdl/*.ali vhdl/b_*.c stage2/vhdl
+	-$(MV) vhdl/stamp-* stage2/vhdl
+vhdl.stage3:
+	-$(MV) vhdl/*$(objext) vhdl/*.ali vhdl/b_*.c stage3/vhdl
+	-$(MV) vhdl/stamp-* stage3/vhdl
+vhdl.stage4:
+	-$(MV) vhdl/*$(objext) vhdl/*.ali vhdl/b_*.c stage4/vhdl
+	-$(MV) vhdl/stamp-* stage4/vhdl
diff --git a/src/translate/gcc/Makefile.in b/src/translate/gcc/Makefile.in
new file mode 100644
index 000000000..13f329660
--- /dev/null
+++ b/src/translate/gcc/Makefile.in
@@ -0,0 +1,299 @@
+# Makefile for GNU vhdl Compiler (GHDL).
+#   Copyright (C) 2002 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC 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.
+
+#GNU CC 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 GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330,
+#Boston, MA 02111-1307, USA.
+
+# The makefile built from this file lives in the language subdirectory.
+# It's purpose is to provide support for:
+#
+# 1) recursion where necessary, and only then (building .o's), and
+# 2) building and debugging cc1 from the language subdirectory, and
+# 3) nothing else.
+#
+# The parent makefile handles all other chores, with help from the
+# language makefile fragment, of course.
+#
+# The targets for external use are:
+# all, TAGS, ???mostlyclean, ???clean.
+
+# This makefile will only work with Gnu make.
+# The rules are written assuming a minimum subset of tools are available:
+#
+# Required:
+#      MAKE:    Only Gnu make will work.
+#      MV:      Must accept (at least) one, maybe wildcard, source argument,
+#               a file or directory destination, and support creation/
+#               modification date preservation.  Gnu mv -f works.
+#      RM:      Must accept an arbitrary number of space separated file
+#               arguments, or one wildcard argument. Gnu rm works.
+#      RMDIR:   Must delete a directory and all its contents. Gnu rm -rf works.
+#      ECHO:    Must support command line redirection. Any Unix-like
+#               shell will typically provide this, otherwise a custom version
+#               is trivial to write.
+#      LN:      ln -s works, cp should work bu was not tested.
+#      CP:      GNU cp -p works.
+#      AR:      Gnu ar works.
+#      MKDIR:   Gnu mkdir works.
+#      CHMOD:   Gnu chmod works.
+#      true:    Does nothing and returns a normal successful return code.
+#      pwd:     Prints the current directory on stdout.
+#      cd:      Change directory.
+
+# Tell GNU make 3.79 not to run this directory in parallel.
+# Not all of the required dependencies are present.
+.NOTPARALLEL:
+
+# Variables that exist for you to override.
+# See below for how to change them for certain systems.
+
+ALLOCA = 
+# Various ways of specifying flags for compilations:  
+# CFLAGS is for the user to override to, e.g., do a bootstrap with -O2.
+# BOOT_CFLAGS is the value of CFLAGS to pass
+# to the stage2 and stage3 compilations
+# XCFLAGS is used for most compilations but not when using the GCC just built.
+XCFLAGS =
+CFLAGS = -g
+BOOT_CFLAGS = -O $(CFLAGS)
+# These exists to be overridden by the x-* and t-* files, respectively.
+X_CFLAGS =
+T_CFLAGS =
+
+X_CPPFLAGS =
+T_CPPFLAGS =
+
+X_ADAFLAGS =
+T_ADAFLAGS =
+
+ADAC = $(CC)
+
+ECHO = echo
+CHMOD = chmod
+CP = cp -p
+MV = mv -f
+RM = rm -f
+RMDIR = rm -rf
+MKDIR = mkdir -p
+LN = ln -s
+AR = ar
+# How to invoke ranlib.
+RANLIB = ranlib
+# Test to use to see whether ranlib exists on the system.
+RANLIB_TEST = [ -f /usr/bin/ranlib -o -f /bin/ranlib ]
+SHELL = /bin/sh
+INSTALL_DATA = install -m 644
+MAKEINFO = makeinfo
+TEXI2DVI = texi2dvi
+GNATBIND = gnatbind
+GNATMAKE = gnatmake
+ADA_CFLAGS = $(CFLAGS)
+GHDL_ADAFLAGS = -Wall -gnata
+
+objext = .o
+exeext =
+arext  = .a
+soext  = .so
+shext  =
+
+HOST_CC=$(CC)
+HOST_CFLAGS=$(ALL_CFLAGS)
+HOST_CLIB=$(CLIB)
+HOST_LDFLAGS=$(LDFLAGS)
+HOST_CPPFLAGS=$(ALL_CPPFLAGS)
+HOST_ALLOCA=$(ALLOCA)
+HOST_MALLOC=$(MALLOC)
+HOST_OBSTACK=$(OBSTACK)
+
+# We don't use cross-make.  Instead we use the tools from the build tree,
+# if they are available.
+# program_transform_name and objdir are set by configure.in.
+program_transform_name =
+objdir = .
+
+target=@target@
+target_alias=@target_alias@
+target_noncanonical:=@target_noncanonical@
+xmake_file=@dep_host_xmake_file@
+tmake_file=@dep_tmake_file@
+#version=`sed -e 's/.*\"\([^ \"]*\)[ \"].*/\1/' < $(srcdir)/version.c`
+#mainversion=`sed -e 's/.*\"\([0-9]*\.[0-9]*\).*/\1/' < $(srcdir)/version.c`
+
+# Directory where sources are, from where we are.
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+# Top build directory, relative to here.
+top_builddir = ..
+
+version := $(shell cat $(srcdir)/../BASE-VER)
+
+# End of variables for you to override.
+
+# Definition of `all' is here so that new rules inserted by sed
+# do not specify the default target.
+all: all.indirect
+
+# This tells GNU Make version 3 not to put all variables in the environment.
+.NOEXPORT:
+
+# Now figure out from those variables how to compile and link.
+
+all.indirect: Makefile
+
+# This tells GNU make version 3 not to export all the variables
+# defined in this file into the environment.
+.NOEXPORT:
+
+Makefile: $(srcdir)/Makefile.in $(srcdir)/../configure
+	cd ..; $(SHELL) config.status
+
+force:
+
+SED=sed
+
+drvdir/default_pathes.ads: drvdir Makefile
+	echo "--  DO NOT EDIT" > tmp-dpathes.ads
+	echo "--  This file is created by Makefile" >> tmp-dpathes.ads
+	echo "package Default_Pathes is" >> tmp-dpathes.ads
+	echo "   --  Accept long lines."  >> tmp-dpathes.ads
+	echo "   pragma Style_Checks (\"M999\");"  >> tmp-dpathes.ads
+	echo "   Install_Prefix : constant String :=" >> tmp-dpathes.ads
+	echo "     \"$(exec_prefix)\";" >> tmp-dpathes.ads
+	echo "   Compiler_Gcc   : constant String :=" >> tmp-dpathes.ads
+	echo "     \"libexec/gcc/$(target_noncanonical)/$(version)/ghdl1$(exeext)\";" >> tmp-dpathes.ads
+	echo "   Compiler_Debug : constant String := \"\";" >> tmp-dpathes.ads
+	echo "   Compiler_Mcode : constant String := \"\";" >> tmp-dpathes.ads
+	echo "   Compiler_Llvm  : constant String := \"\";" >> tmp-dpathes.ads
+	echo "   Post_Processor : constant String := \"\";" >> tmp-dpathes.ads
+	echo "   Lib_Prefix     : constant String :=">> tmp-dpathes.ads
+	echo "     \"lib/gcc/$(target_noncanonical)/$(version)/vhdl/lib/\";" >> tmp-dpathes.ads
+	echo "end Default_Pathes;" >> tmp-dpathes.ads
+	$(srcdir)/../../move-if-change tmp-dpathes.ads $@
+
+../ghdl$(exeext): drvdir drvdir/default_pathes.ads force
+	CURDIR=`pwd`; cd $(srcdir); SRCDIR=`pwd`; cd $$CURDIR/drvdir; \
+	$(GNATMAKE) -o ../$@ -aI$$SRCDIR/ghdldrv -aI$$SRCDIR -aO.. ghdl_gcc \
+	 -bargs -E -cargs $(ADA_CFLAGS) $(GHDL_ADAFLAGS) -largs $(LIBS)
+
+drvdir:
+	mkdir $@
+
+clean: grt-clean ghdllibs-clean force
+	$(RM) *.o *.ali
+	$(RM) default_pathes.ads
+
+# Additionnal rules
+
+LIB87_DIR:=./lib/v87
+LIB93_DIR:=./lib/v93
+LIB08_DIR:=./lib/v08
+LIBSRC_DIR:=$(srcdir)/libraries
+ANALYZE=../ghdl -a --GHDL1=../ghdl1 --ieee=none
+
+$(LIB93_DIR) $(LIB87_DIR):
+	$(srcdir)/../../mkinstalldirs $@
+
+####libraries Makefile.inc
+
+std87_standard.o: $(GHDL1)
+	$(GHDL1) --std=87 -quiet -o std_standard.s --compile-standard
+	../xgcc -c -o std_standard.o std_standard.s
+	$(MV) std_standard.o $@
+
+std93_standard.o: $(GHDL1)
+	$(GHDL1) --std=93 -quiet -o std_standard.s --compile-standard
+	../xgcc -c -o std_standard.o std_standard.s
+	$(MV) std_standard.o $@
+
+std08_standard.o: $(GHDL1)
+	$(GHDL1) --std=08 -quiet -o std_standard.s --compile-standard
+	../xgcc -c -o std_standard.o std_standard.s
+	$(MV) std_standard.o $@
+
+ghdllib: std87_standard.o std93_standard.o std08_standard.o libgrt.a
+
+ghdllibs-clean: force
+	$(RM) -rf $(LIB87_DIR) $(LIB93_DIR) $(LIB08_DIR)
+
+PHONY: ghdllib ghdllibs-clean
+
+GHDL1=../ghdl1
+GRTSRCDIR=$(srcdir)/grt
+GRT_RANLIB=$(RANLIB)
+
+####grt Makefile.inc
+
+install-ghdllib: ghdllib grt.lst $(STD93_SRCS) $(STD87_SRCS) \
+  $(IEEE93_SRCS) $(IEEE87_SRCS) $(SYNOPSYS_SRCS) \
+  $(STD08_SRCS) $(IEEE08_SRCS)
+	$(RM) -rf $(DESTDIR)$(VHDL_LIB_DIR)
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)
+# Install libgrt
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib
+	$(INSTALL_DATA) libgrt.a $(DESTDIR)$(VHDL_LIB_DIR)/lib/libgrt.a
+	$(INSTALL_DATA) grt.lst $(DESTDIR)$(VHDL_LIB_DIR)/lib/grt.lst
+	$(INSTALL_DATA) $(GRTSRCDIR)/grt.ver $(DESTDIR)$(VHDL_LIB_DIR)/lib/grt.ver
+# Install VHDL sources.
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/std
+	for i in $(STD93_SRCS) $(STD87_SRCS) $(STD08_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/std; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/ieee
+	for i in $(IEEE93_SRCS) $(IEEE87_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/ieee; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/vital95
+	for i in $(VITAL95_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/vital95; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/vital2000
+	for i in $(VITAL2000_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/vital2000; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/synopsys
+	for i in $(SYNOPSYS_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/synopsys; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/mentor
+	for i in $(MENTOR93_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/mentor; \
+	done
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/ieee2008
+	for i in $(IEEE08_SRCS); do \
+	  $(INSTALL_DATA) $$i $(DESTDIR)$(VHDL_LIB_DIR)/src/ieee2008; \
+	done
+# Create library dirs
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib/v93
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib/v87
+	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib/v08
+# Compile in place.
+	PDIR=`pwd` && cd $(DESTDIR)$(VHDL_LIB_DIR) && \
+	$(MAKE) -f $$PDIR/Makefile REL_DIR=../../.. LIBSRC_DIR="src" \
+	 LIB93_DIR=lib/v93 LIB87_DIR=lib/v87 LIB08_DIR=lib/v08 \
+	 ANALYZE="$$PDIR/../ghdl -a --GHDL1=$$PDIR/../ghdl1 --ieee=none" \
+	 std.v87 ieee.v87 synopsys.v87 \
+	 std.v93 ieee.v93 synopsys.v93 mentor.v93 \
+	 std.v08 ieee.v08
+# Copy std_standard (this is done after libraries, since they remove dirs).
+	$(INSTALL_DATA) std87_standard.o \
+	  $(DESTDIR)$(VHDL_LIB_DIR)/lib/v87/std/std_standard.o
+	$(INSTALL_DATA) std93_standard.o \
+	  $(DESTDIR)$(VHDL_LIB_DIR)/lib/v93/std/std_standard.o
+	$(INSTALL_DATA) std08_standard.o \
+	  $(DESTDIR)$(VHDL_LIB_DIR)/lib/v08/std/std_standard.o
diff --git a/src/translate/gcc/README b/src/translate/gcc/README
new file mode 100644
index 000000000..1152e9908
--- /dev/null
+++ b/src/translate/gcc/README
@@ -0,0 +1,87 @@
+This is the README from the source distribution of GHDL.
+
+To get the binary distribution or more information, go to http://ghdl.free.fr
+
+Copyright:
+**********
+GHDL is copyright (c) 2002 - 2010 Tristan Gingold.
+See the GHDL manual for more details.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.
+
+
+Building GHDL from sources:
+***************************
+
+Required:
+* the sources of @GCCVERSION@ (at least the core part).
+  Note: other versions of gcc sources have not been tested.
+* the Ada95 GNAT compiler (GNAT GPL 2008 are known to work;
+  Ada compilers in most Linux distributions are more or less buggy)
+* GNU/Linux for ix86 (pc systems) (porting is necessary for other systems)
+
+Procedure:
+* Check your Ada compiler.  On some systems (or with some distribution), the
+  GNAT compiler seems broken.  Try this very simple example, using file
+  example.adb
+<<<<<<<<<<<<<<<<<<
+procedure Example is
+begin
+   null;
+end Example;
+<<<<<<<<<<<<<<<<<<
+  Compile with
+  $ gnatmake example
+  It should create an executable, 'example'.
+  If this doesn't work, your GNAT installation is broken.  It may be a PATH
+  problem or something else.
+* untar the gcc tarball
+* untar the ghdl tarball (this sould have been done, since you are reading a
+  file from it).
+* move or copy the vhdl directory of ghdl into the gcc subdirectory of
+  the gcc distribution.
+  You should have a @GCCVERSION@/gcc/vhdl directory.
+* configure gcc with the --enable-languages=vhdl option.  You may of course
+  add other languages.  Also you'd better to disable bootstraping using
+  --disable-bootstrap.
+  Refer to the gcc installation documentation.
+* compile gcc.
+  'make CFLAGS="-O"' is OK
+* install gcc.  This installs the ghdl driver too.
+  'make install' is OK.
+
+There is a mailing list for any questions.  You can subscribe via:
+  https://mail.gna.org/listinfo/ghdl-discuss/
+Please report bugs on https://gna.org/bugs/?group=ghdl
+
+If you cannot compile, please report the gcc version, GNAT version and gcc
+source version.
+
+* Note for ppc64 (and AIX ?) platform:
+The object file format contains an identifier for the source language. Because
+gcc doesn't know about the VHDL, gcc crashes very early. This could be fixed
+with a very simple change in gcc/config/rs6000/rs6000.c,
+function rs6000_output_function_epilogue (as of gcc 4.8):
+       else if (! strcmp (language_string, "GNU Objective-C"))
+        i = 14;
+       else
+-       gcc_unreachable ();
++       i = 0;
+       fprintf (file, "%d,", i);
+
+       /* 8 single bit fields: global linkage (not set for C extern linkage,
+
+Tristan Gingold.
diff --git a/src/translate/gcc/config-lang.in b/src/translate/gcc/config-lang.in
new file mode 100644
index 000000000..7010b1127
--- /dev/null
+++ b/src/translate/gcc/config-lang.in
@@ -0,0 +1,38 @@
+# Top level configure fragment for GNU vhdl (GHDL).
+#   Copyright (C) 1994-2001 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC 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.
+
+#GNU CC 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 GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330,
+#Boston, MA 02111-1307, USA.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# boot_language - "yes" if we need to build this language in stage1
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+
+language="vhdl"
+boot_language=no
+
+compilers="ghdl1\$(exeext)"
+
+stagestuff="ghdl\$(exeext) ghdl1\$(exeext)"
+
+outputs=vhdl/Makefile
+
+gtfiles="\$(srcdir)/vhdl/ortho-lang.c"
diff --git a/src/translate/gcc/dist-common.sh b/src/translate/gcc/dist-common.sh
new file mode 100644
index 000000000..ad2229734
--- /dev/null
+++ b/src/translate/gcc/dist-common.sh
@@ -0,0 +1,337 @@
+# ghdl core files
+cfiles="
+evaluation.adb
+evaluation.ads
+scanner.ads
+scanner.adb
+scanner-scan_literal.adb
+back_end.ads
+back_end.adb
+files_map.adb
+files_map.ads
+sem.adb
+sem.ads
+sem_expr.adb
+sem_expr.ads
+sem_names.adb
+sem_names.ads
+sem_scopes.adb
+sem_scopes.ads
+sem_decls.ads
+sem_decls.adb
+sem_inst.ads
+sem_inst.adb
+sem_specs.ads
+sem_specs.adb
+sem_stmts.ads
+sem_stmts.adb
+sem_types.ads
+sem_types.adb
+sem_assocs.ads
+sem_assocs.adb
+sem_psl.ads
+sem_psl.adb
+canon.adb
+canon.ads
+canon_psl.ads
+canon_psl.adb
+flags.adb
+flags.ads
+configuration.adb
+configuration.ads
+nodes.ads
+nodes.adb
+nodes_gc.ads
+nodes_gc.adb
+nodes_meta.ads
+nodes_meta.adb
+options.ads
+options.adb
+psl-errors.ads
+lists.ads
+lists.adb
+iirs.adb
+iirs.ads
+iir_chains.ads
+iir_chains.adb
+iir_chain_handling.ads
+iir_chain_handling.adb
+iirs_walk.ads
+iirs_walk.adb
+std_names.adb
+std_names.ads
+disp_tree.adb
+disp_tree.ads
+iirs_utils.adb
+iirs_utils.ads
+std_package.adb
+std_package.ads
+disp_vhdl.adb
+disp_vhdl.ads
+libraries.adb
+libraries.ads
+tokens.adb
+tokens.ads
+name_table.adb
+name_table.ads
+str_table.ads
+str_table.adb
+types.ads
+version.ads
+errorout.adb
+errorout.ads
+parse.adb
+parse.ads
+parse_psl.ads
+parse_psl.adb
+post_sems.ads
+post_sems.adb
+ieee.ads
+ieee-std_logic_1164.ads
+ieee-std_logic_1164.adb
+ieee-vital_timing.ads
+ieee-vital_timing.adb
+xrefs.ads
+xrefs.adb
+bug.ads
+bug.adb
+"
+
+# translation file
+tfiles="
+translation.adb
+ortho_front.adb
+translation.ads
+trans_decls.ads
+trans_be.ads
+trans_be.adb
+trans_analyzes.ads
+trans_analyzes.adb"
+
+ortho_files="
+ortho_front.ads"
+
+ortho_gcc_files="
+lang.opt
+ortho-lang.c
+ortho_gcc-main.adb
+ortho_gcc-main.ads
+ortho_gcc.adb
+ortho_gcc.ads
+ortho_gcc_front.ads
+ortho_ident.adb
+ortho_ident.ads
+ortho_nodes.ads
+"
+
+ghdl_files="
+ghdl_gcc.adb
+ghdldrv.ads
+ghdldrv.adb
+ghdlprint.ads
+ghdlprint.adb
+ghdllocal.ads
+ghdllocal.adb
+ghdlmain.ads
+ghdlmain.adb
+"
+
+libraries_files="
+std/textio.vhdl
+std/textio_body.vhdl
+std/env.vhdl
+std/env_body.vhdl
+ieee/README.ieee
+ieee/numeric_bit-body.vhdl
+ieee/numeric_bit.vhdl
+ieee/numeric_std-body.vhdl
+ieee/numeric_std.vhdl
+ieee/std_logic_1164.vhdl
+ieee/std_logic_1164_body.vhdl
+ieee/math_real.vhdl
+ieee/math_real-body.vhdl
+ieee/math_complex.vhdl
+ieee/math_complex-body.vhdl
+ieee2008/README.ieee
+ieee2008/fixed_float_types.vhdl
+ieee2008/fixed_generic_pkg-body.vhdl
+ieee2008/fixed_generic_pkg.vhdl
+ieee2008/fixed_pkg.vhdl
+ieee2008/float_generic_pkg-body.vhdl
+ieee2008/float_generic_pkg.vhdl
+ieee2008/float_pkg.vhdl
+ieee2008/math_complex-body.vhdl
+ieee2008/math_complex.vhdl
+ieee2008/math_real-body.vhdl
+ieee2008/math_real.vhdl
+ieee2008/numeric_bit-body.vhdl
+ieee2008/numeric_bit.vhdl
+ieee2008/numeric_bit_unsigned-body.vhdl
+ieee2008/numeric_bit_unsigned.vhdl
+ieee2008/numeric_std-body.vhdl
+ieee2008/numeric_std.vhdl
+ieee2008/numeric_std_unsigned-body.vhdl
+ieee2008/numeric_std_unsigned.vhdl
+ieee2008/std_logic_1164-body.vhdl
+ieee2008/std_logic_1164.vhdl
+ieee2008/std_logic_textio.vhdl
+vital95/vital_primitives.vhdl
+vital95/vital_primitives_body.vhdl
+vital95/vital_timing.vhdl
+vital95/vital_timing_body.vhdl
+vital2000/memory_b.vhdl
+vital2000/memory_p.vhdl
+vital2000/prmtvs_b.vhdl
+vital2000/prmtvs_p.vhdl
+vital2000/timing_b.vhdl
+vital2000/timing_p.vhdl
+synopsys/std_logic_arith.vhdl
+synopsys/std_logic_misc.vhdl
+synopsys/std_logic_misc-body.vhdl
+synopsys/std_logic_signed.vhdl
+synopsys/std_logic_textio.vhdl
+synopsys/std_logic_unsigned.vhdl
+mentor/std_logic_arith.vhdl
+mentor/std_logic_arith_body.vhdl
+"
+
+grt_files="
+grt-cbinding.c
+grt-cvpi.c
+grt.adc
+grt-astdio.ads
+grt-astdio.adb
+grt-avhpi.adb
+grt-avhpi.ads
+grt-avls.ads
+grt-avls.adb
+grt-c.ads
+grt-disp.adb
+grt-disp.ads
+grt-disp_rti.adb
+grt-disp_rti.ads
+grt-disp_tree.adb
+grt-disp_tree.ads
+grt-disp_signals.adb
+grt-disp_signals.ads
+grt-errors.adb
+grt-errors.ads
+grt-files.adb
+grt-files.ads
+grt-hooks.adb
+grt-hooks.ads
+grt-images.adb
+grt-images.ads
+grt-lib.adb
+grt-lib.ads
+grt-main.adb
+grt-main.ads
+grt-modules.ads
+grt-modules.adb
+grt-names.adb
+grt-names.ads
+grt-options.adb
+grt-options.ads
+grt-processes.adb
+grt-processes.ads
+grt-rtis.ads
+grt-rtis.adb
+grt-rtis_addr.adb
+grt-rtis_addr.ads
+grt-rtis_utils.adb
+grt-rtis_utils.ads
+grt-rtis_binding.ads
+grt-rtis_types.ads
+grt-rtis_types.adb
+grt-sdf.adb
+grt-sdf.ads
+grt-shadow_ieee.ads
+grt-shadow_ieee.adb
+grt-signals.adb
+grt-signals.ads
+grt-stack2.adb
+grt-stack2.ads
+grt-stacks.adb
+grt-stacks.ads
+grt-stats.ads
+grt-stats.adb
+grt-stdio.ads
+grt-table.ads
+grt-table.adb
+grt-types.ads
+grt-unithread.ads
+grt-unithread.adb
+grt-values.adb
+grt-values.ads
+grt-vcd.adb
+grt-vcd.ads
+grt-vcdz.adb
+grt-vcdz.ads
+grt-vital_annotate.adb
+grt-vital_annotate.ads
+grt-vpi.adb
+grt-vpi.ads
+grt-vstrings.adb
+grt-vstrings.ads
+grt-waves.ads
+grt-waves.adb
+grt-zlib.ads
+grt-threads.ads
+grt-arch_none.ads
+grt-arch_none.adb
+grt-std_logic_1164.ads
+grt-std_logic_1164.adb
+grt.ads
+main.adb
+main.ads
+ghdl_main.ads
+ghdl_main.adb
+ghwlib.h
+ghwlib.c
+ghwdump.c
+grt.ver
+"
+
+grt_config_files="
+i386.S
+sparc.S
+ppc.S
+ia64.S
+amd64.S
+times.c
+clock.c
+linux.c
+pthread.c
+win32.c"
+
+psl_files="
+psl.ads
+psl-build.adb
+psl-build.ads
+psl-cse.adb
+psl-cse.ads
+psl-disp_nfas.adb
+psl-disp_nfas.ads
+psl-dump_tree.adb
+psl-dump_tree.ads
+psl-hash.adb
+psl-hash.ads
+psl-nfas.adb
+psl-nfas.ads
+psl-nfas-utils.adb
+psl-nfas-utils.ads
+psl-nodes.adb
+psl-nodes.ads
+psl-optimize.adb
+psl-optimize.ads
+psl-prints.adb
+psl-prints.ads
+psl-priorities.ads
+psl-qm.adb
+psl-qm.ads
+psl-rewrites.adb
+psl-rewrites.ads
+psl-subsets.adb
+psl-subsets.ads
+psl-tprint.adb
+psl-tprint.ads"
diff --git a/src/translate/gcc/dist.sh b/src/translate/gcc/dist.sh
new file mode 100755
index 000000000..8632dc574
--- /dev/null
+++ b/src/translate/gcc/dist.sh
@@ -0,0 +1,471 @@
+#!/bin/sh
+
+#  Script used to create tar balls.
+#  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.
+
+# Building a distribution:
+# * update the 'version' variable in ../../Makefile
+# * Regenerate version.ads: make -f ../../Makefile version.ads
+# * Check NEWS, README and INSTALL files.
+# * Check version and copyright years in doc/ghdl.texi, ghdlmain.adb
+# * Check GCCVERSION below.
+# * Check lists of exported files in this file.
+# * Create source tar and build binaries: ./dist.sh dist_phase1
+# * su root
+# * Build binary tar: HOME=~user ./dist.sh dist_phase2
+# * Run the testsuites: GHDL=ghdl ./testsuite.sh gcc
+# * Update website/index.html (./dist.sh website helps)
+# * upload (./dist upload)
+# * CVS commit, tag + cd image.
+# * remove previous version in /usr/local
+
+## DO NOT MODIFY this file while it is running...
+
+set -e
+
+# GCC version
+GCCVERSION=4.9.2
+# Machine name used by GCC
+MACHINE=${MACHINE:i686-pc-linux-gnu}
+# Directory where GCC sources (and objects) stay.
+DISTDIR=${DISTDIR:-$HOME/dist}
+# GTKWave version.
+GTKWAVE_VERSION=3.3.50
+
+# GHDL version (extracted from version.ads)
+VERSION=`sed -n -e 's/.*GHDL \([0-9.a-z]*\) (.*/\1/p' ../../version.ads`
+
+CWD=`pwd`
+
+distdir=ghdl-$VERSION
+tarfile=$distdir.tar
+
+GTKWAVE_BASE=$HOME/devel/gtkwave-$GTKWAVE_VERSION
+
+GCCDIST=$DISTDIR/gcc-$GCCVERSION
+GCCDISTOBJ=$GCCDIST-objs
+PREFIX=/usr/local
+GCCLIBDIR=$PREFIX/lib/gcc/$MACHINE/$GCCVERSION
+GCCLIBEXECDIR=$PREFIX/libexec/gcc/$MACHINE/$GCCVERSION
+bindirname=ghdl-$VERSION-$MACHINE
+TARINSTALL=$DISTDIR/$bindirname.tar.bz2
+VHDLDIR=$distdir/vhdl
+DOWNLOAD_HTML=../../website/download.html
+DESTDIR=$CWD/
+UNSTRIPDIR=${distdir}-unstripped
+
+PATH=/usr/gnat/bin:$PATH
+
+do_clean ()
+{
+  rm -rf $VHDLDIR
+  mkdir $VHDLDIR
+  mkdir $VHDLDIR/ghdldrv
+  mkdir $VHDLDIR/libraries
+  mkdir $VHDLDIR/libraries/std $VHDLDIR/libraries/ieee
+  mkdir $VHDLDIR/libraries/vital95 $VHDLDIR/libraries/vital2000
+  mkdir $VHDLDIR/libraries/synopsys $VHDLDIR/libraries/mentor
+  mkdir $VHDLDIR/libraries/ieee2008
+  mkdir $VHDLDIR/grt
+  mkdir $VHDLDIR/grt/config
+}
+
+# Build Makefile
+do_Makefile ()
+{
+  sed -e "/^####libraries Makefile.inc/r ../../libraries/Makefile.inc" \
+      -e "/^####grt Makefile.inc/r ../grt/Makefile.inc" \
+     < Makefile.in > $VHDLDIR/Makefile.in
+  cp Make-lang.in $VHDLDIR/Make-lang.in
+}
+
+# Copy (or link) sources files into $VHDLDIR
+do_files ()
+{
+. ./dist-common.sh
+
+# Local files
+lfiles="config-lang.in lang-options.h lang-specs.h"
+for i in $lfiles; do ln -sf $CWD/$i $VHDLDIR/$i; done
+
+for i in $cfiles; do ln -sf $CWD/../../$i $VHDLDIR/$i; done
+
+for i in ghdl.texi ghdl.1; do ln -sf $CWD/../../doc/$i $VHDLDIR/$i; done
+
+for i in $tfiles; do ln -sf $CWD/../$i $VHDLDIR/$i; done
+
+for i in $ortho_files; do ln -sf $CWD/../../ortho/$i $VHDLDIR/$i; done
+
+for i in $ortho_gcc_files; do
+  ln -sf $CWD/../../ortho/gcc/$i $VHDLDIR/$i
+done
+
+for i in $ghdl_files; do
+  ln -sf $CWD/../ghdldrv/$i $VHDLDIR/ghdldrv/$i
+done
+
+for i in $libraries_files; do
+    ln -sf $CWD/../../libraries/$i $VHDLDIR/libraries/$i
+done
+
+for i in $grt_files; do
+    ln -sf $CWD/../grt/$i $VHDLDIR/grt/$i
+done
+
+for i in $grt_config_files; do
+    ln -sf $CWD/../grt/config/$i $VHDLDIR/grt/config/$i
+done
+
+for i in $psl_files; do
+    ln -sf $CWD/../../psl/$i $VHDLDIR/$i
+done
+}
+
+# Create the tar of sources.
+do_sources ()
+{
+    \rm -rf $distdir
+    mkdir $distdir
+    VHDLDIR=$distdir/vhdl
+    do_clean $VHDLDIR
+    do_Makefile
+    do_files
+    ln -sf ../../../COPYING $distdir
+    sed -e "s/@GCCVERSION@/gcc-$GCCVERSION/g" < README > $distdir/README
+    tar cvhf $tarfile $distdir
+    bzip2 -f $tarfile
+    rm -rf $distdir
+}
+
+# Put GHDL sources in GCC.
+do_update_gcc_sources ()
+{
+  set -x
+
+  cd $GCCDIST/..
+  tar jxvf $CWD/$tarfile.bz2
+  rm -rf $GCCDIST/gcc/vhdl
+  mv $distdir/vhdl $GCCDIST/gcc
+}
+
+# Extract the source, configure and make.
+do_compile ()
+{
+  #set -x
+
+  do_update_gcc_sources;
+
+# gmp build with:
+# CFLAGS="-O -m32" ./configure --prefix=$HOME/dist/build \
+#   --disable-shared --build=i686-pc-linux-gnu
+# make
+# make install
+# make check
+
+  # usegnat32!
+
+  rm -rf $GCCDISTOBJ
+  mkdir $GCCDISTOBJ
+  cd $GCCDISTOBJ
+  export CFLAGS="-O -g"
+
+  case $MACHINE in
+  i?86-*-linux*)
+          # gmp location (mpfr and mpc are supposed to be at the same place)
+	  CONFIG_LIBS="--with-gmp=$PWD/../build"
+	  ;;
+  x86_64-*-linux*)
+	  CONFIG_LIBS=""
+	  ;;
+  x86_64-*-darwin*)
+	  CONFIG_LIBS="--with-gmp=$HOME/local --with-stage1-ldflags="
+	  ;;
+  *)
+	  exit 1
+	  ;;
+  esac
+  ../gcc-$GCCVERSION/configure --enable-languages=vhdl --prefix=$PREFIX --disable-bootstrap --with-bugurl="<URL:http://gna.org/projects/ghdl>" --build=$MACHINE $CONFIG_LIBS --disable-shared --disable-libmudflap --disable-libssp --disable-libgomp --disable-libquadmath
+
+  make -j4
+  make -C gcc vhdl.info
+  cd $CWD
+}
+
+# Re-package sources, update gcc sources and recompile without reconfiguring.
+do_recompile ()
+{
+  do_sources
+  do_update_gcc_sources;
+  cd $GCCDISTOBJ
+  export CFLAGS="-O -g"
+  make -j4
+}
+
+check_root ()
+{
+  if [ $UID -ne 0 ]; then
+    echo "$0: you must be root";
+    exit 1;
+  fi
+}
+
+#  Do a make install
+do_gcc_install ()
+{
+  set -x
+  cd $GCCDISTOBJ
+  # Check the info file is not empty.
+  if [ -s gcc/doc/ghdl.info ]; then
+    echo "info file found"
+  else
+    echo "Error: ghdl.info not found".
+    exit 1;
+  fi
+  mkdir -p $DESTDIR/usr/local || true
+  make DESTDIR=$DESTDIR install
+  cd $CWD
+  if [ -d $UNSTRIPDIR ]; then
+     rm -rf $UNSTRIPDIR
+  fi
+  mkdir $UNSTRIPDIR
+  cp ${DESTDIR}${GCCLIBEXECDIR}/ghdl1 ${DESTDIR}${PREFIX}/bin/ghdl $UNSTRIPDIR
+  chmod -w $UNSTRIPDIR/*
+  strip ${DESTDIR}${GCCLIBEXECDIR}/ghdl1 ${DESTDIR}${PREFIX}/bin/ghdl
+}
+
+# Create the tar file from the current installation.
+do_tar_install ()
+{
+  tar -C $DESTDIR -jcvf $TARINSTALL \
+    ./$PREFIX/bin/ghdl ./$PREFIX/info/ghdl.info ./$PREFIX/man/man1/ghdl.1 \
+    ./$GCCLIBDIR/vhdl \
+    ./$GCCLIBEXECDIR/ghdl1
+}
+
+do_extract_tar_install ()
+{
+  check_root;
+  cd /
+  tar jxvf $TARINSTALL
+  cd $CWD
+}
+
+# Create the tar file to be distributed.
+do_tar_dist ()
+{
+  rm -rf $bindirname
+  mkdir $bindirname
+  sed -e "s/@TARFILE@/$bindirname/" < INSTALL > $bindirname/INSTALL
+  ln ../../COPYING $bindirname
+  cp $TARINSTALL $bindirname
+  tar cvf $bindirname.tar $bindirname
+}
+
+# Remove the non-ghdl files of gcc in the current installation.
+do_distclean_gcc ()
+{
+  set -x
+  rm -f ${DESTDIR}${PREFIX}/bin/cpp ${DESTDIR}${PREFIX}/bin/gcc
+  rm -f ${DESTDIR}${PREFIX}/bin/gcc-*
+  rm -f ${DESTDIR}${PREFIX}/bin/gccbug ${DESTDIR}${PREFIX}/bin/gcov
+  rm -f ${DESTDIR}${PREFIX}/bin/${MACHINE}-gcc*
+  rm -f ${DESTDIR}${PREFIX}/info/cpp.info*
+  rm -f ${DESTDIR}${PREFIX}/info/cppinternals.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gcc.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gccinstall.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gccint.info*
+  rm -f ${DESTDIR}${PREFIX}/lib/*.a
+  rm -f ${DESTDIR}${PREFIX}/lib/*.so*
+  rm -f ${DESTDIR}${PREFIX}/lib/*.la
+  rm -rf ${DESTDIR}${PREFIX}/share
+  rm -rf ${DESTDIR}${PREFIX}/man/man7
+  rm -rf ${DESTDIR}${PREFIX}/man/man1/{cpp,gcc,gcov}.1
+  rm -rf ${DESTDIR}${PREFIX}/include
+  rm -f ${DESTDIR}${GCCLIBEXECDIR}/cc1 ${DESTDIR}${GCCLIBEXECDIR}/collect2
+  rm -f ${DESTDIR}${GCCLIBEXECDIR}/cpp0 ${DESTDIR}${GCCLIBEXECDIR}/tradcpp0
+  rm -rf ${DESTDIR}${GCCLIBEXECDIR}/plugin
+  rm -rf ${DESTDIR}${GCCLIBEXECDIR}/lto-wrapper
+  rm -f ${DESTDIR}${GCCLIBDIR}/*.o ${DESTDIR}$GCCLIBDIR/*.a
+  rm -f ${DESTDIR}${GCCLIBDIR}/specs
+  rm -rf ${DESTDIR}${GCCLIBDIR}/plugin
+  rm -rf ${DESTDIR}${GCCLIBDIR}/include
+  rm -rf ${DESTDIR}${GCCLIBDIR}/include-fixed
+  rm -rf ${DESTDIR}${GCCLIBDIR}/install-tools
+  rm -rf ${DESTDIR}${GCCLIBEXECDIR}/install-tools
+}
+
+# Remove ghdl files in the current installation.
+do_distclean_ghdl ()
+{
+  check_root;
+  set -x
+  rm -f $PREFIX/bin/ghdl
+  rm -f $PREFIX/info/ghdl.info*
+  rm -f $GCCLIBEXECDIR/ghdl1
+  rm -rf $GCCLIBDIR/vhdl
+}
+
+# Build the source tar, and build the binaries.
+do_dist_phase1 ()
+{
+  do_sources;
+  do_compile;
+  do_gcc_install;
+  do_distclean_gcc;
+  do_tar_install;
+  do_tar_dist;
+  rm -rf ./$PREFIX
+}
+
+# Install the binaries and create the binary tar.
+do_dist_phase2 ()
+{
+  check_root;
+  do_distclean_ghdl;
+  do_extract_tar_install;
+  echo "dist_phase2 success"
+}
+
+# Create gtkwave patch
+do_gtkwave_patch ()
+{
+#  rm -rf gtkwave-patch
+  mkdir gtkwave-patch
+  diff -rc -x Makefile.in $GTKWAVE_BASE.orig $GTKWAVE_BASE | \
+    sed -e "/^Only in/d" \
+    > gtkwave-patch/gtkwave-$GTKWAVE_VERSION.diffs
+  cp ../grt/ghwlib.c ../grt/ghwlib.h $GTKWAVE_BASE/src/ghw.c gtkwave-patch
+  sed -e "s/VERSION/$GTKWAVE_VERSION/g" < README.gtkwave > gtkwave-patch/README
+  tar zcvf ../../website/gtkwave-patch.tgz gtkwave-patch
+  rm -rf gtkwave-patch
+}
+
+# Update the index.html
+# Update the doc
+do_website ()
+{
+  cp "$DOWNLOAD_HTML" "$DOWNLOAD_HTML".old
+  sed -e "
+/SRC-HREF/ s/href=\".*\"/href=\"$tarfile.bz2\"/
+/BIN-HREF/ s/href=\".*\"/href=\"$bindirname.tar\"/
+/HISTORY/ a \\
+      <tr>\\
+	<td>$VERSION</td>\\
+        <td>`date +'%b %e %Y'`</td>\\
+        <td>$GCCVERSION</td>\\
+	<td><a href=\"$tarfile.bz2\">$tarfile.bz2</a></td>\\
+	<td><a href=\"$bindirname.tar\">\\
+	    $bindirname.tar</a></td>\\
+      </tr>
+" < "$DOWNLOAD_HTML".old > "$DOWNLOAD_HTML"
+  dir=../../website/ghdl
+  echo "Updating $dir"
+  rm -rf $dir
+  makeinfo --html -o $dir ../../doc/ghdl.texi
+}
+
+# Do ftp commands to upload
+do_upload ()
+{
+if tty -s; then
+  echo -n "Please, enter password: "
+  stty -echo
+  read pass
+  stty echo
+  echo
+else
+  echo "$0: upload must be done from a tty"
+  exit 1;
+fi
+ftp -n <<EOF
+open ftpperso.free.fr
+user ghdl $pass
+prompt
+hash
+bin
+passive
+put $tarfile.bz2
+put $bindirname.tar
+put INSTALL
+lcd ../../website
+put NEWS
+put index.html
+put download.html
+put features.html
+put roadmap.html
+put manual.html
+put more.html
+put links.html
+put bug.html
+put waveviewer.html
+put gtkwave-patch.tgz
+put favicon.ico
+lcd ghdl
+cd ghdl
+mput \*
+bye
+EOF
+}
+
+if [ $# -eq 0 ]; then
+  do_Makefile;
+else
+  for i ; do
+    case $i in
+      Makefile|makefile)
+	do_Makefile ;;
+      files)
+        do_files ;;
+      sources)
+        do_sources ;;
+      compile)
+        do_compile;;
+      recompile)
+        do_recompile;;
+      update_gcc)
+        do_update_gcc_sources;;
+      gcc_install)
+        do_gcc_install;;
+      tar_install)
+        do_tar_install;;
+      tar_dist)
+        do_tar_dist;;
+      -v | --version | version)
+        echo $VERSION
+        exit 0
+        ;;
+      website)
+        do_website;;
+      upload)
+        do_upload;;
+      distclean_gcc)
+        do_distclean_gcc;;
+      distclean_ghdl)
+        do_distclean_ghdl;;
+      dist_phase1)
+        do_dist_phase1;;
+      dist_phase2)
+        do_dist_phase2;;
+      gtkwave_patch)
+        do_gtkwave_patch;;
+      *)
+	echo "usage: $0 clean|Makefile|files|all"
+	exit 1 ;;
+     esac
+   done
+fi
diff --git a/src/translate/gcc/lang-options.h b/src/translate/gcc/lang-options.h
new file mode 100644
index 000000000..c92b12132
--- /dev/null
+++ b/src/translate/gcc/lang-options.h
@@ -0,0 +1,29 @@
+/* Definitions for switches for vhdl.
+   Copyright (C) 2002
+   Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC 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.
+
+GNU CC 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 GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+DEFINE_LANG_NAME ("vhdl")
+
+/* This is the contribution to the `lang_options' array in gcc.c for ghdl.  */
+
+  {"--ghdl-", "Specify options to GHDL"},
+
+
+
diff --git a/src/translate/gcc/lang-specs.h b/src/translate/gcc/lang-specs.h
new file mode 100644
index 000000000..050443521
--- /dev/null
+++ b/src/translate/gcc/lang-specs.h
@@ -0,0 +1,28 @@
+/* Definitions for specs for vhdl.
+   Copyright (C) 2002
+   Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC 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.
+
+GNU CC 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 GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* This is the contribution to the `default_compilers' array in gcc.c for
+   GHDL.  */
+
+  {".vhd", "@vhdl", 0, 0, 0},
+  {".vhdl", "@vhdl", 0, 0, 0},
+  {"@vhdl",
+   "ghdl1 %i %(cc1_options) %{!fsyntax-only:%(invoke_as)}", 0, 0, 0},
diff --git a/src/translate/ghdldrv/Makefile b/src/translate/ghdldrv/Makefile
new file mode 100644
index 000000000..ebf23c2d1
--- /dev/null
+++ b/src/translate/ghdldrv/Makefile
@@ -0,0 +1,193 @@
+#  -*- Makefile -*- for the GHDL drivers.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+GNATFLAGS=-gnaty3befhkmr -gnata -gnatwael -aI../.. -aI.. -aI../../psl -aI../grt -aO.. -g -gnatf -gnat05
+GRT_FLAGS=-g
+LIB_CFLAGS=-g -O2
+GNATMAKE=gnatmake
+CC=gcc
+
+# Optimize, do not forget to use MODE=--genfast for iirs.adb.
+#GNATFLAGS+=-O -gnatn
+#GRT_FLAGS+=-O
+
+# Profiling.
+#GNATFLAGS+=-pg -gnatn -O
+#GRT_FLAGS+=-pg -O
+
+# Coverage
+#GNATFLAGS+=-fprofile-arcs -ftest-coverage
+
+GNAT_BARGS=-bargs -E
+
+LLVM_CONFIG=llvm-config
+
+#GNAT_LARGS= -static
+all: ghdl_mcode
+
+target=i686-pc-linux-gnu
+#target=x86_64-pc-linux-gnu
+#target=i686-apple-darwin
+#target=x86_64-apple-darwin
+#target=i386-pc-mingw32
+GRTSRCDIR=../grt
+include $(GRTSRCDIR)/Makefile.inc
+
+ifeq ($(filter-out i%86 linux,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Linux
+endif
+ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Macosx
+endif
+ifeq ($(filter-out i%86 mingw32%,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Windows
+endif
+ifdef ORTHO_X86_FLAGS
+  ORTHO_DEPS=ortho_code-x86-flags.ads
+endif
+
+ortho_code-x86-flags.ads:
+	echo "with Ortho_Code.X86.$(ORTHO_X86_FLAGS);" > $@
+	echo "package Ortho_Code.X86.Flags renames Ortho_Code.X86.$(ORTHO_X86_FLAGS);" >> $@
+
+ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
+ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force
+	$(GNATMAKE) -o $@ -aI../../ortho/mcode -aI../../ortho $(GNATFLAGS) ghdl_jit.adb $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
+
+memsegs_c.o: ../../ortho/mcode/memsegs_c.c
+	$(CC) -c -g -o $@ $<
+
+ghdl_llvm_jit: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
+ghdl_llvm_jit: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) llvm-cbindings.o force
+	$(GNATMAKE) -o $@ -aI../../ortho/llvm -aI../../ortho $(GNATFLAGS) ghdl_jit.adb $(GNAT_BARGS) -largs llvm-cbindings.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) `$(LLVM_CONFIG) --ldflags --libs --system-libs` -lc++
+
+llvm-cbindings.o: ../../ortho/llvm/llvm-cbindings.cpp
+	$(CXX) -c -m64 `$(LLVM_CONFIG) --includedir --cxxflags` -g -o $@ $<
+
+ghdl_simul: default_pathes.ads $(GRT_ADD_OBJS) force
+	$(GNATMAKE) -aI../../simulate $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
+
+ghdl_gcc: default_pathes.ads force
+	$(GNATMAKE) $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS)
+
+ghdl_llvm: default_pathes.ads force
+	$(GNATMAKE) $(GNATFLAGS) ghdl_llvm $(GNAT_BARGS) -largs $(GNAT_LARGS)
+
+default_pathes.ads: default_pathes.ads.in Makefile
+	curdir=`cd ..; pwd`; \
+	sed -e "s%@COMPILER_GCC@%$$curdir/ghdl1-gcc%" \
+	 -e "s%@COMPILER_DEBUG@%$$curdir/ghdl1-debug%" \
+	 -e "s%@COMPILER_MCODE@%$$curdir/ghdl1-mcode%" \
+	 -e "s%@COMPILER_LLVM@%$$curdir/ghdl1-llvm%" \
+	 -e "s%@POST_PROCESSOR@%$$curdir/../ortho/oread/oread-gcc%" \
+	 -e "s%@INSTALL_PREFIX@%%" \
+	 -e "s%@LIB_PREFIX@%$$curdir/lib/%" < $< > $@
+
+bootstrap.old: force
+	$(RM) ../../libraries/std-obj87.cf
+	$(MAKE) -C ../../libraries EXT=obj \
+	  ANALYSE="$(PWD)/ghdl -a -g" std-obj87.cf
+	$(RM) ../../libraries/std-obj93.cf
+	$(MAKE) -C ../../libraries EXT=obj \
+	  ANALYSE="$(PWD)/ghdl -a -g" std-obj93.cf
+
+LIB87_DIR:=../lib/v87
+LIB93_DIR:=../lib/v93
+LIB08_DIR:=../lib/v08
+
+LIBSRC_DIR:=../../libraries
+REL_DIR:=../..
+GHDL=ghdl
+ANALYZE:=../../../ghdldrv/$(GHDL) -a $(LIB_CFLAGS)
+LN=ln -s
+CP=cp
+
+$(LIB87_DIR) $(LIB93_DIR) $(LIB08_DIR):
+	[ -d ../lib ] || mkdir ../lib
+	[ -d $@ ] || mkdir $@
+
+include ../../libraries/Makefile.inc
+
+GHDL1=../ghdl1-gcc
+$(LIB93_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=93 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=93 -quiet $(LIB_CFLAGS)  -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+$(LIB87_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=87 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=87 -quiet $(LIB_CFLAGS) -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+$(LIB08_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=08 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=08 -quiet $(LIB_CFLAGS) -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93
+install.v87: std.v87 ieee.v87 synopsys.v87
+install.v08: std.v08 ieee.v08
+
+install.standard: $(LIB93_DIR)/std/std_standard.o \
+ $(LIB87_DIR)/std/std_standard.o \
+ $(LIB08_DIR)/std/std_standard.o
+
+grt.links:
+	cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver .
+
+install.all: install.v87 install.v93 install.v08
+
+install.gcc:
+	$(MAKE) GHDL=ghdl_gcc install.all
+	$(MAKE) GHDL1=../ghdl1-gcc install.standard
+
+install.mcode:
+	$(MAKE) GHDL=ghdl_mcode install.all
+
+install.simul:
+	$(MAKE) GHDL=ghdl_simul install.all
+
+install.llvm:
+	$(MAKE) GHDL=ghdl_llvm install.all
+	$(MAKE) GHDL1=../ghdl1-llvm install.standard
+
+clean: force
+	$(RM) -f *.o *.ali ghdl_gcc ghdl_mcode ghdl_llvm ghdl_llvm_jit
+	$(RM) -f b~*.ad? *~ default_pathes.ads ghdl_simul
+	$(RM) -rf ../lib
+
+clean-c: force
+	$(RM) -f memsegs_c.o chkstk.o linux.o times.o grt-cbinding.o grt-cvpi.o
+
+force:
+
+.PHONY: force clean
diff --git a/src/translate/ghdldrv/default_pathes.ads.in b/src/translate/ghdldrv/default_pathes.ads.in
new file mode 100644
index 000000000..7f471a5ed
--- /dev/null
+++ b/src/translate/ghdldrv/default_pathes.ads.in
@@ -0,0 +1,39 @@
+--  GHDL driver pathes  -*- ada -*-.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+package Default_Pathes is
+
+   --  Accept long lines.
+   pragma Style_Checks ("M999");
+
+   Install_Prefix : constant String :=
+     "@INSTALL_PREFIX@";
+   Lib_Prefix : constant String :=
+     "@LIB_PREFIX@";
+
+   Compiler_Gcc : constant String :=
+     "@COMPILER_GCC@";
+   Compiler_Mcode : constant String :=
+     "@COMPILER_MCODE@";
+   Compiler_Llvm : constant String :=
+     "@COMPILER_LLVM@";
+   Compiler_Debug : constant String :=
+     "@COMPILER_DEBUG@";
+   Post_Processor : constant String :=
+     "@POST_PROCESSOR@";
+end Default_Pathes;
diff --git a/src/translate/ghdldrv/foreigns.adb b/src/translate/ghdldrv/foreigns.adb
new file mode 100644
index 000000000..15e3dd009
--- /dev/null
+++ b/src/translate/ghdldrv/foreigns.adb
@@ -0,0 +1,64 @@
+with Interfaces.C; use Interfaces.C;
+
+package body Foreigns is
+   function Sin (Arg : double) return double;
+   pragma Import (C, Sin);
+
+   function Log (Arg : double) return double;
+   pragma Import (C, Log);
+
+   function Exp (Arg : double) return double;
+   pragma Import (C, Exp);
+
+   function Sqrt (Arg : double) return double;
+   pragma Import (C, Sqrt);
+
+   function Asin (Arg : double) return double;
+   pragma Import (C, Asin);
+
+   function Acos (Arg : double) return double;
+   pragma Import (C, Acos);
+
+   function Asinh (Arg : double) return double;
+   pragma Import (C, Asinh);
+
+   function Acosh (Arg : double) return double;
+   pragma Import (C, Acosh);
+
+   function Atanh (X : double) return double;
+   pragma Import (C, Atanh);
+
+   function Atan2 (X, Y : double) return double;
+   pragma Import (C, Atan2);
+
+   type String_Cacc is access constant String;
+   type Foreign_Record is record
+      Name : String_Cacc;
+      Addr : Address;
+   end record;
+
+
+   Foreign_Arr : constant array (Natural range <>) of Foreign_Record :=
+     (
+      (new String'("sin"), Sin'Address),
+      (new String'("log"), Log'Address),
+      (new String'("exp"), Exp'Address),
+      (new String'("sqrt"), Sqrt'Address),
+      (new String'("asin"), Asin'Address),
+      (new String'("acos"), Acos'Address),
+      (new String'("asinh"), Asinh'Address),
+      (new String'("acosh"), Acosh'Address),
+      (new String'("atanh"), Atanh'Address),
+      (new String'("atan2"), Atan2'Address)
+     );
+
+   function Find_Foreign (Name : String) return Address is
+   begin
+      for I in Foreign_Arr'Range loop
+         if Foreign_Arr(I).Name.all = Name then
+            return Foreign_Arr(I).Addr;
+         end if;
+      end loop;
+      return Null_Address;
+   end Find_Foreign;
+end Foreigns;
diff --git a/src/translate/ghdldrv/foreigns.ads b/src/translate/ghdldrv/foreigns.ads
new file mode 100644
index 000000000..5759ae4f5
--- /dev/null
+++ b/src/translate/ghdldrv/foreigns.ads
@@ -0,0 +1,5 @@
+with System; use System;
+
+package Foreigns is
+   function Find_Foreign (Name : String) return Address;
+end Foreigns;
diff --git a/src/translate/ghdldrv/ghdl_gcc.adb b/src/translate/ghdldrv/ghdl_gcc.adb
new file mode 100644
index 000000000..615a8c5d6
--- /dev/null
+++ b/src/translate/ghdldrv/ghdl_gcc.adb
@@ -0,0 +1,34 @@
+--  GHDL driver for gcc.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ghdlmain;
+with Ghdllocal;
+with Ghdldrv;
+with Ghdlprint;
+
+procedure Ghdl_Gcc is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String := new String'("GCC back-end code generator");
+   Ghdldrv.Compile_Kind := Ghdldrv.Compile_Gcc;
+   Ghdldrv.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Gcc;
diff --git a/src/translate/ghdldrv/ghdl_jit.adb b/src/translate/ghdldrv/ghdl_jit.adb
new file mode 100644
index 000000000..ba7087492
--- /dev/null
+++ b/src/translate/ghdldrv/ghdl_jit.adb
@@ -0,0 +1,35 @@
+--  GHDL driver for jit.
+--  Copyright (C) 2002-2014 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 Ghdlmain;
+with Ghdllocal;
+with Ghdlprint;
+with Ghdlrun;
+with Ortho_Jit;
+
+procedure Ghdl_Jit is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String :=
+     new String'(Ortho_Jit.Get_Jit_Name & " code generator");
+   Ghdlrun.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Jit;
diff --git a/src/translate/ghdldrv/ghdl_simul.adb b/src/translate/ghdldrv/ghdl_simul.adb
new file mode 100644
index 000000000..d4d0abd7a
--- /dev/null
+++ b/src/translate/ghdldrv/ghdl_simul.adb
@@ -0,0 +1,33 @@
+--  GHDL driver for simulator.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ghdlmain;
+with Ghdllocal;
+with Ghdlprint;
+with Ghdlsimul;
+
+procedure Ghdl_Simul is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String := new String'("interpretation");
+   Ghdlsimul.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Simul;
diff --git a/src/translate/ghdldrv/ghdlcomp.adb b/src/translate/ghdldrv/ghdlcomp.adb
new file mode 100644
index 000000000..ba755af8a
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlcomp.adb
@@ -0,0 +1,757 @@
+--  GHDL driver - compile commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
+with Ada.Command_Line;
+with Ada.Characters.Latin_1;
+with Ada.Text_IO;
+
+with Types;
+with Iirs; use Iirs;
+with Nodes_GC;
+with Flags;
+with Back_End;
+with Sem;
+with Name_Table;
+with Errorout; use Errorout;
+with Libraries;
+with Std_Package;
+with Files_Map;
+with Version;
+with Default_Pathes;
+
+package body Ghdlcomp is
+
+   Flag_Expect_Failure : Boolean := False;
+
+   Flag_Debug_Nodes_Leak : Boolean := False;
+   --  If True, detect unreferenced nodes at the end of analysis.
+
+   --  Commands which use the mcode compiler.
+   type Command_Comp is abstract new Command_Lib with null record;
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Disp_Long_Help (Cmd : Command_Comp);
+
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Option = "--debug-nodes-leak" then
+         Flag_Debug_Nodes_Leak := True;
+         Res := Option_Ok;
+      elsif Hooks.Decode_Option.all (Option) then
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+
+   procedure Disp_Long_Help (Cmd : Command_Comp)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Hooks.Disp_Long_Help.all;
+      Put_Line (" --expect-failure  Expect analysis/elaboration failure");
+   end Disp_Long_Help;
+
+   --  Command -r
+   type Command_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-r" or Name = "--elab-run";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-r,--elab-run [OPTS] UNIT [ARCH] [RUNOPTS]  Run UNIT";
+   end Get_Short_Help;
+
+
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Opt_Arg : Natural;
+   begin
+      begin
+         Hooks.Compile_Init.all (False);
+
+         Libraries.Load_Work_Library (False);
+         Flags.Flag_Elaborate_With_Outdated := False;
+         Flags.Flag_Only_Elab_Warnings := True;
+
+         Hooks.Compile_Elab.all ("-r", Args, Opt_Arg);
+      exception
+         when Compilation_Error =>
+            if Flag_Expect_Failure then
+               return;
+            else
+               raise;
+            end if;
+      end;
+      Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last));
+      Hooks.Run.all;
+   end Perform_Action;
+
+
+   --  Command -c xx -r
+   type Command_Compile is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Compile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Compile) return String;
+   procedure Decode_Option (Cmd : in out Command_Compile;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Perform_Action (Cmd : in out Command_Compile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Compile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-c";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Compile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-c [OPTS] FILEs -r UNIT [ARCH] [RUNOPTS]  "
+        & "Compile, elaborate and run UNIT";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Compile;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-r" or else Option = "-e" then
+         Res := Option_End;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Compile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Elab_Arg : Natural;
+      Run_Arg : Natural;
+   begin
+      begin
+         Hooks.Compile_Init.all (False);
+
+         Flags.Flag_Elaborate_With_Outdated := True;
+         Flags.Flag_Only_Elab_Warnings := False;
+
+         if Args'Length > 1 and then
+           (Args (Args'First).all = "-r" or else Args (Args'First).all = "-e")
+         then
+            --  If there is no files, then load the work library.
+            Libraries.Load_Work_Library (False);
+            --  Also, load all libraries and files, so that every design unit
+            --  is known.
+            Load_All_Libraries_And_Files;
+            Elab_Arg := Args'First + 1;
+         else
+            --  If there is at least one file, do not load the work library.
+            Libraries.Load_Work_Library (True);
+            Elab_Arg := Natural'Last;
+            for I in Args'Range loop
+               declare
+                  Arg : constant String := Args (I).all;
+                  Res : Iir_Design_File;
+                  Design : Iir;
+                  Next_Design : Iir;
+               begin
+                  if Arg = "-r" or else Arg = "-e" then
+                     Elab_Arg := I + 1;
+                     exit;
+                  else
+                     Res := Libraries.Load_File
+                       (Name_Table.Get_Identifier (Arg));
+                     if Errorout.Nbr_Errors > 0 then
+                        raise Compilation_Error;
+                     end if;
+
+                     --  Put units into library.
+                     Design := Get_First_Design_Unit (Res);
+                     while not Is_Null (Design) loop
+                        Next_Design := Get_Chain (Design);
+                        Set_Chain (Design, Null_Iir);
+                        Libraries.Add_Design_Unit_Into_Library (Design);
+                        Design := Next_Design;
+                     end loop;
+                  end if;
+               end;
+            end loop;
+            if Elab_Arg = Natural'Last then
+               Libraries.Save_Work_Library;
+               return;
+            end if;
+         end if;
+
+         Hooks.Compile_Elab.all ("-c", Args (Elab_Arg .. Args'Last), Run_Arg);
+      exception
+         when Compilation_Error =>
+            if Flag_Expect_Failure then
+               return;
+            else
+               raise;
+            end if;
+      end;
+      if Args (Elab_Arg - 1).all = "-r" then
+         Hooks.Set_Run_Options (Args (Run_Arg .. Args'Last));
+         Hooks.Run.all;
+      else
+         if Run_Arg <= Args'Last then
+            Error_Msg_Option ("options after unit are ignored");
+         end if;
+      end if;
+   end Perform_Action;
+
+   --  Command -a
+   type Command_Analyze is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Analyze) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-a";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Analyze) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-a [OPTS] FILEs    Analyze FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      New_Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+   begin
+      Setup_Libraries (True);
+
+      Hooks.Compile_Init.all (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Errorout.Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+
+         if False then
+            --  Speed up analysis: remove all previous designs.
+            --  However, this is not in the LRM...
+            Libraries.Purge_Design_File (Design_File);
+         end if;
+
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               Back_End.Finish_Compilation (Unit, True);
+
+               Next_Unit := Get_Chain (Unit);
+
+               if Errorout.Nbr_Errors = 0 then
+                  Set_Chain (Unit, Null_Iir);
+                  Libraries.Add_Design_Unit_Into_Library (Unit);
+                  New_Design_File := Get_Design_File (Unit);
+               end if;
+
+               Unit := Next_Unit;
+            end loop;
+
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+
+            Free_Iir (Design_File);
+
+            --  Do late analysis checks.
+            Unit := Get_First_Design_Unit (New_Design_File);
+            while Unit /= Null_Iir loop
+               Sem.Sem_Analysis_Checks_List (Unit, Flags.Warn_Delayed_Checks);
+               Unit := Get_Chain (Unit);
+            end loop;
+
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+         end if;
+      end loop;
+
+      if Flag_Expect_Failure then
+         raise Compilation_Error;
+      end if;
+
+      if Flag_Debug_Nodes_Leak then
+         Nodes_GC.Report_Unreferenced;
+      end if;
+
+      Libraries.Save_Work_Library;
+
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure and Errorout.Nbr_Errors /= 0 then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command -e
+   type Command_Elab is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab) return String;
+   procedure Decode_Option (Cmd : in out Command_Elab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-e";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-e [OPTS] UNIT [ARCH]  Elaborate UNIT";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Elab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Option = "-o" then
+         if Arg'Length = 0 then
+            Res := Option_Arg_Req;
+         else
+            --  Silently accepted.
+            Res := Option_Arg;
+         end if;
+      --elsif Option'Length >= 4 and then Option (1 .. 4) = "-Wl," then
+      --   Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Run_Arg : Natural;
+   begin
+      Hooks.Compile_Init.all (False);
+
+      Libraries.Load_Work_Library (False);
+      Flags.Flag_Elaborate_With_Outdated := False;
+      Flags.Flag_Only_Elab_Warnings := True;
+
+      Hooks.Compile_Elab.all ("-e", Args, Run_Arg);
+      if Run_Arg <= Args'Last then
+         Error_Msg_Option ("options after unit are ignored");
+      end if;
+      if Flag_Expect_Failure then
+         raise Compilation_Error;
+      end if;
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure and then Errorout.Nbr_Errors > 0 then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command dispconfig.
+   type Command_Dispconfig is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String;
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--dispconfig";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--dispconfig       Disp tools path";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List)
+   is
+      use Ada.Text_IO;
+      use Libraries;
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("--dispconfig does not accept any argument");
+         raise Errorout.Option_Error;
+      end if;
+
+      Put ("command line prefix (--PREFIX): ");
+      if Prefix_Path = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Path.all);
+      end if;
+      Setup_Libraries (False);
+
+      Put ("environment prefix (GHDL_PREFIX): ");
+      if Prefix_Env = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Env.all);
+      end if;
+
+      Put_Line ("default prefix: " & Default_Pathes.Prefix);
+      Put_Line ("actual prefix: " & Prefix_Path.all);
+      Put_Line ("command_name: " & Ada.Command_Line.Command_Name);
+      Put_Line ("default library pathes:");
+      for I in 2 .. Get_Nbr_Pathes loop
+         Put (' ');
+         Put_Line (Name_Table.Image (Get_Path (I)));
+      end loop;
+   end Perform_Action;
+
+   --  Command Make.
+   type Command_Make is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Make) return String;
+   procedure Perform_Action (Cmd : in out Command_Make;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-m";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Make) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-m [OPTS] UNIT [ARCH]  Make UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Next_Arg : Natural;
+      Date : Date_Type;
+      Unit : Iir_Design_Unit;
+   begin
+      Extract_Elab_Unit ("-m", Args, Next_Arg);
+      Setup_Libraries (True);
+
+      --  Create list of files.
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Date := Get_Date (Libraries.Work_Library);
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+
+         if Get_Library (File) = Libraries.Work_Library then
+            --  Mark this file as analyzed.
+            Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp);
+
+            Unit := Get_First_Design_Unit (File);
+            while Unit /= Null_Iir loop
+               if Get_Date (Unit) = Date_Analyzed
+                 or else Get_Date (Unit) in Date_Valid
+               then
+                  Date := Date + 1;
+                  Set_Date (Unit, Date);
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+      end loop;
+      Set_Date (Libraries.Work_Library, Date);
+      Libraries.Save_Work_Library;
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+      --  Command Gen_Makefile.
+   type Command_Gen_Makefile is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String;
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--gen-makefile";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--gen-makefile [OPTS] UNIT [ARCH]  Generate a Makefile for UNIT";
+   end Get_Short_Help;
+
+   function Is_Makeable_File (File : Iir_Design_File) return Boolean is
+   begin
+      if File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+      return True;
+   end Is_Makeable_File;
+
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+      use Ada.Text_IO;
+      use Ada.Command_Line;
+      use Name_Table;
+
+      HT : constant Character := Ada.Characters.Latin_1.HT;
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Lib : Iir_Library_Declaration;
+      Dir_Id : Name_Id;
+
+      Next_Arg : Natural;
+   begin
+      Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg);
+      Setup_Libraries (True);
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Put_Line ("# Makefile automatically generated by ghdl");
+      Put ("# Version: ");
+      Put (Version.Ghdl_Release);
+      Put (" - ");
+      if Version_String /= null then
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("# Command used to generate this makefile:");
+      Put ("# ");
+      Put (Command_Name);
+      for I in 1 .. Argument_Count loop
+         Put (' ');
+         Put (Argument (I));
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put ("GHDL=");
+      Put_Line (Command_Name);
+
+      --  Extract options for command line.
+      Put ("GHDLFLAGS=");
+      for I in 2 .. Argument_Count loop
+         declare
+            Arg : constant String := Argument (I);
+         begin
+            if Arg (1) = '-' then
+               if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--ieee=")
+                 or else (Arg'Length > 6 and then Arg (1 .. 6) = "--std=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--work=")
+                 or else (Arg'Length > 2 and then Arg (1 .. 2) = "-P")
+               then
+                  Put (" ");
+                  Put (Arg);
+               end if;
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      Put ("GHDLRUNFLAGS=");
+      for I in Next_Arg .. Args'Last loop
+         Put (' ');
+         Put (Args (I).all);
+      end loop;
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Default target : elaborate");
+      Put_Line ("all : elab");
+      New_Line;
+
+      Put_Line ("# Elaborate target.  Almost useless");
+      Put_Line ("elab : force");
+      Put (HT & "$(GHDL) -c $(GHDLFLAGS) -e ");
+      Put (Prim_Name.all);
+      if Sec_Name /= null then
+         Put (' ');
+         Put (Sec_Name.all);
+      end if;
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Run target");
+      Put_Line ("run : force");
+      Put (HT & "$(GHDL) -c $(GHDLFLAGS) -r ");
+      Put (Prim_Name.all);
+      if Sec_Name /= null then
+         Put (' ');
+         Put (Sec_Name.all);
+      end if;
+      Put (" $(GHDLRUNFLAGS)");
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Targets to analyze libraries");
+      Put_Line ("init: force");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         Dir_Id := Get_Design_File_Directory (File);
+         if not Is_Makeable_File (File) then
+            --  Builtin file.
+            null;
+         elsif Dir_Id /= Files_Map.Get_Home_Directory then
+            --  Not locally built file.
+            Put (HT & "# ");
+            Put (Image (Dir_Id));
+            Put (Image (Get_Design_File_Filename (File)));
+            New_Line;
+         else
+
+            Put (HT & "$(GHDL) -a $(GHDLFLAGS)");
+            Lib := Get_Library (File);
+            if Lib /= Libraries.Work_Library then
+               --  Overwrite some options.
+               Put (" --work=");
+               Put (Image (Get_Identifier (Lib)));
+               Dir_Id := Get_Library_Directory (Lib);
+               Put (" --workdir=");
+               if Dir_Id = Libraries.Local_Directory then
+                  Put (".");
+               else
+                  Put (Image (Dir_Id));
+               end if;
+            end if;
+            Put (' ');
+            Put (Image (Get_Design_File_Filename (File)));
+            New_Line;
+         end if;
+      end loop;
+      New_Line;
+
+      Put_Line ("force:");
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Analyze);
+      Register_Command (new Command_Elab);
+      Register_Command (new Command_Run);
+      Register_Command (new Command_Compile);
+      Register_Command (new Command_Make);
+      Register_Command (new Command_Gen_Makefile);
+      Register_Command (new Command_Dispconfig);
+   end Register_Commands;
+
+end Ghdlcomp;
diff --git a/src/translate/ghdldrv/ghdlcomp.ads b/src/translate/ghdldrv/ghdlcomp.ads
new file mode 100644
index 000000000..f803ca4fa
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlcomp.ads
@@ -0,0 +1,67 @@
+--  GHDL driver - compile commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+
+package Ghdlcomp is
+   --  This procedure is called at start of commands which call
+   --  finish_compilation to generate code.
+   type Compile_Init_Acc is access procedure (Analyze_Only : Boolean);
+
+   --  This procedure is called for elaboration.
+   --  CMD_NAME is the name of the command, used to report errors.
+   --  ARGS is the argument list, starting from the unit name to be elaborated.
+   --   The procedure should extract the unit.
+   --  OPT_ARG is the index of the first argument from ARGS to be used as
+   --   a run option.
+   type Compile_Elab_Acc is access procedure
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural);
+
+   --  Use ARGS as run options.
+   --  Should do all the work.
+   type Set_Run_Options_Acc is access
+     procedure (Args : Argument_List);
+
+   --  Run the simulation.
+   --  All the parameters were set through calling Compile_Elab and
+   --  Set_Run_Options.
+   type Run_Acc is access procedure;
+
+   --  Called when an analysis/elaboration option is decoded.
+   --  Return True if OPTION is known (and do the side effects).
+   --  No parameters are allowed.
+   type Decode_Option_Acc is access function (Option : String) return Boolean;
+
+   --  Disp help for options decoded by Decode_Option.
+   type Disp_Long_Help_Acc is access procedure;
+
+   --  All the hooks gathered.
+   --  A record is used to be sure all hooks are set.
+   type Hooks_Type is record
+      Compile_Init : Compile_Init_Acc := null;
+      Compile_Elab : Compile_Elab_Acc := null;
+      Set_Run_Options : Set_Run_Options_Acc := null;
+      Run : Run_Acc := null;
+      Decode_Option : Decode_Option_Acc := null;
+      Disp_Long_Help : Disp_Long_Help_Acc := null;
+   end record;
+
+   Hooks : Hooks_Type;
+
+   --  Register commands.
+   procedure Register_Commands;
+end Ghdlcomp;
diff --git a/src/translate/ghdldrv/ghdldrv.adb b/src/translate/ghdldrv/ghdldrv.adb
new file mode 100644
index 000000000..be905f1af
--- /dev/null
+++ b/src/translate/ghdldrv/ghdldrv.adb
@@ -0,0 +1,1818 @@
+--  GHDL driver - commands invoking gcc.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ada.Command_Line; use Ada.Command_Line;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Table;
+with GNAT.Dynamic_Tables;
+with Libraries;
+with Name_Table; use Name_Table;
+with Std_Package;
+with Types; use Types;
+with Iirs; use Iirs;
+with Files_Map;
+with Flags;
+with Configuration;
+--with Disp_Tree;
+with Default_Pathes;
+with Interfaces.C_Streams;
+with System;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with Errorout;
+with Version;
+with Options;
+
+package body Ghdldrv is
+   --  Name of the tools used.
+   Compiler_Cmd : String_Access := null;
+   Post_Processor_Cmd : String_Access := null;
+   Assembler_Cmd : constant String := "as";
+   Linker_Cmd : constant String := "gcc";
+
+   --  Path of the tools.
+   Compiler_Path : String_Access;
+   Post_Processor_Path : String_Access;
+   Assembler_Path : String_Access;
+   Linker_Path : String_Access;
+
+   --  Set by the '-o' option: the output filename.  If the option is not
+   --  present, then null.
+   Output_File : String_Access;
+
+   --  "-o" string.
+   Dash_o : constant String_Access := new String'("-o");
+
+   --  "-c" string.
+   Dash_c : constant String_Access := new String'("-c");
+
+   --  "-quiet" option.
+   Dash_Quiet : constant String_Access := new String'("-quiet");
+
+   --  If set, do not assmble
+   Flag_Asm : Boolean;
+
+   --  If true, executed commands are displayed.
+   Flag_Disp_Commands : Boolean;
+
+   --  Flag not quiet
+   Flag_Not_Quiet : Boolean;
+
+   --  True if failure expected.
+   Flag_Expect_Failure : Boolean;
+
+   --  Argument table for the tools.
+   --  Each table low bound is 1 so that the length of a table is equal to
+   --  the last bound.
+   package Argument_Table_Pkg is new GNAT.Dynamic_Tables
+     (Table_Component_Type => String_Access,
+      Table_Index_Type => Integer,
+      Table_Low_Bound => 1,
+      Table_Initial => 4,
+      Table_Increment => 100);
+   use Argument_Table_Pkg;
+
+   --  Arguments for tools.
+   Compiler_Args : Argument_Table_Pkg.Instance;
+   Postproc_Args : Argument_Table_Pkg.Instance;
+   Assembler_Args : Argument_Table_Pkg.Instance;
+   Linker_Args : Argument_Table_Pkg.Instance;
+
+   --  Display the program spawned in Flag_Disp_Commands is TRUE.
+   --  Raise COMPILE_ERROR in case of failure.
+   procedure My_Spawn (Program_Name : String; Args : Argument_List)
+   is
+      Status : Integer;
+   begin
+      if Flag_Disp_Commands then
+         Put (Program_Name);
+         for I in Args'Range loop
+            Put (' ');
+            Put (Args (I).all);
+         end loop;
+         New_Line;
+      end if;
+      Status := Spawn (Program_Name, Args);
+      if Status = 0 then
+         return;
+      elsif Status = 1 then
+         Error ("compilation error");
+         raise Compile_Error;
+      elsif Status > 127 then
+         Error ("executable killed by a signal");
+         raise Exec_Error;
+      else
+         Error ("exec error");
+         raise Exec_Error;
+      end if;
+   end My_Spawn;
+
+   --  Compile FILE with additional argument OPTS.
+   procedure Do_Compile (Options : Argument_List; File : String)
+   is
+      Obj_File : String_Access;
+      Asm_File : String_Access;
+      Post_File : String_Access;
+      Success : Boolean;
+   begin
+      --  Create post file.
+      case Compile_Kind is
+         when Compile_Debug =>
+            Post_File := Append_Suffix (File, Post_Suffix);
+         when others =>
+            null;
+      end case;
+
+      --  Create asm file.
+      case Compile_Kind is
+         when Compile_Gcc
+           | Compile_Debug =>
+            Asm_File := Append_Suffix (File, Asm_Suffix);
+         when Compile_Llvm
+           | Compile_Mcode =>
+            null;
+      end case;
+
+      --  Create obj file (may not be used, but the condition isn't simple).
+      Obj_File := Append_Suffix (File, Get_Object_Suffix.all);
+
+      --  Compile.
+      declare
+         P : Natural;
+         Nbr_Args : constant Natural :=
+           Last (Compiler_Args) + Options'Length + 4;
+         Args : Argument_List (1 .. Nbr_Args);
+      begin
+         P := 0;
+         for I in First .. Last (Compiler_Args) loop
+            P := P + 1;
+            Args (P) := Compiler_Args.Table (I);
+         end loop;
+         for I in Options'Range loop
+            P := P + 1;
+            Args (P) := Options (I);
+         end loop;
+
+         --  Add -quiet.
+         case Compile_Kind is
+            when Compile_Gcc =>
+               if not Flag_Not_Quiet then
+                  P := P + 1;
+                  Args (P) := Dash_Quiet;
+               end if;
+            when Compile_Llvm =>
+               P := P + 1;
+               Args (P) := Dash_c;
+            when Compile_Debug
+              | Compile_Mcode =>
+               null;
+         end case;
+
+         Args (P + 1) := Dash_o;
+         case Compile_Kind is
+            when Compile_Debug =>
+               Args (P + 2) := Post_File;
+            when Compile_Gcc =>
+               Args (P + 2) := Asm_File;
+            when Compile_Mcode
+              | Compile_Llvm =>
+               Args (P + 2) := Obj_File;
+         end case;
+         Args (P + 3) := new String'(File);
+
+         My_Spawn (Compiler_Path.all, Args (1 .. P + 3));
+         Free (Args (P + 3));
+      exception
+         when Compile_Error =>
+            --  Delete temporary file in case of error.
+            Delete_File (Args (P + 2).all, Success);
+            --  FIXME: delete object file too ?
+            raise;
+      end;
+
+      --  Post-process.
+      if Compile_Kind = Compile_Debug then
+         declare
+            P : Natural;
+            Nbr_Args : constant Natural := Last (Postproc_Args) + 4;
+            Args : Argument_List (1 .. Nbr_Args);
+         begin
+            P := 0;
+            for I in First .. Last (Postproc_Args) loop
+               P := P + 1;
+               Args (P) := Postproc_Args.Table (I);
+            end loop;
+
+            if not Flag_Not_Quiet then
+               P := P + 1;
+               Args (P) := Dash_Quiet;
+            end if;
+
+            Args (P + 1) := Dash_o;
+            Args (P + 2) := Asm_File;
+            Args (P + 3) := Post_File;
+            My_Spawn (Post_Processor_Path.all, Args (1 .. P + 3));
+         end;
+
+         Free (Post_File);
+      end if;
+
+      --  Assemble.
+      if Compile_Kind >= Compile_Gcc then
+         if Flag_Expect_Failure then
+            Delete_File (Asm_File.all, Success);
+         elsif not Flag_Asm then
+            declare
+               P : Natural;
+               Nbr_Args : constant Natural := Last (Assembler_Args) + 4;
+               Args : Argument_List (1 .. Nbr_Args);
+               Success : Boolean;
+            begin
+               P := 0;
+               for I in First .. Last (Assembler_Args) loop
+                  P := P + 1;
+                  Args (P) := Assembler_Args.Table (I);
+               end loop;
+
+               Args (P + 1) := Dash_o;
+               Args (P + 2) := Obj_File;
+               Args (P + 3) := Asm_File;
+               My_Spawn (Assembler_Path.all, Args (1 .. P + 3));
+               Delete_File (Asm_File.all, Success);
+            end;
+         end if;
+      end if;
+
+      Free (Asm_File);
+      Free (Obj_File);
+   end Do_Compile;
+
+   package Filelist is new GNAT.Table
+     (Table_Component_Type => String_Access,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   Link_Obj_Suffix : String_Access;
+
+   --  Read a list of files from file FILENAME.
+   --  Lines starting with a '#' are ignored (comments)
+   --  Lines starting with a '>' are directory lines
+   --  If first character of a line is a '@', it is replaced with
+   --    the lib_prefix_path.
+   --  If TO_OBJ is true, then each file is converted to an object file name
+   --   (suffix is replaced by the object file extension).
+   procedure Add_File_List (Filename : String; To_Obj : Boolean)
+   is
+      use Interfaces.C_Streams;
+      use System;
+      use Ada.Characters.Latin_1;
+
+      --  Replace the first '@' with the machine path.
+      function Substitute (Str : String) return String
+      is
+      begin
+         for I in Str'Range loop
+            if Str (I) = '@' then
+               return Str (Str'First .. I - 1)
+                 & Get_Machine_Path_Prefix
+                 & Str (I + 1 .. Str'Last);
+            end if;
+         end loop;
+         return Str;
+      end Substitute;
+
+      Dir : String (1 .. max_path_len);
+      Dir_Len : Natural;
+      Line : String (1 .. max_path_len);
+      Stream : Interfaces.C_Streams.FILEs;
+      Mode : constant String := "rt" & Ghdllocal.Nul;
+      L : Natural;
+      File : String_Access;
+   begin
+      Line (1 .. Filename'Length) := Filename;
+      Line (Filename'Length + 1) := Ghdllocal.Nul;
+      Stream := fopen (Line'Address, Mode'Address);
+      if Stream = NULL_Stream then
+         Error ("cannot open " & Filename);
+         raise Compile_Error;
+      end if;
+      Dir_Len := 0;
+      loop
+         exit when fgets (Line'Address, Line'Length, Stream) = NULL_Stream;
+         if Line (1) /= '#' then
+            --  Compute string length.
+            L := 0;
+            while Line (L + 1) /= Ghdllocal.Nul loop
+               L := L + 1;
+            end loop;
+
+            --  Remove trailing NL.
+            while L > 0 and then (Line (L) = LF or Line (L) = CR) loop
+               L := L - 1;
+            end loop;
+
+            if Line (1) = '>' then
+               Dir_Len := L - 1;
+               Dir (1 .. Dir_Len) := Line (2 .. L);
+            else
+               if To_Obj then
+                  File := new String'(Dir (1 .. Dir_Len)
+                                      & Get_Base_Name (Line (1 .. L))
+                                      & Link_Obj_Suffix.all);
+               else
+                  File := new String'(Substitute (Line (1 .. L)));
+               end if;
+
+               Filelist.Increment_Last;
+               Filelist.Table (Filelist.Last) := File;
+
+               Dir_Len := 0;
+            end if;
+         end if;
+      end loop;
+      if fclose (Stream) /= 0 then
+         Error ("cannot close " & Filename);
+      end if;
+   end Add_File_List;
+
+   function Get_Object_Filename (File : Iir_Design_File) return String
+   is
+      Dir : Name_Id;
+      Name : Name_Id;
+   begin
+      Dir := Get_Library_Directory (Get_Library (File));
+      Name := Get_Design_File_Filename (File);
+      return Image (Dir) & Get_Base_Name (Image (Name))
+        & Get_Object_Suffix.all;
+   end Get_Object_Filename;
+
+   Last_Stamp : Time_Stamp_Id;
+   Last_Stamp_File : Iir;
+
+   function Is_File_Outdated (Design_File : Iir_Design_File) return Boolean
+   is
+      use Files_Map;
+
+      Name : Name_Id;
+
+      File : Source_File_Entry;
+   begin
+      --  Std.Standard is never outdated.
+      if Design_File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+
+      Name := Get_Design_File_Filename (Design_File);
+      declare
+         Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul;
+         Stamp : Time_Stamp_Id;
+      begin
+         Stamp := Get_File_Time_Stamp (Obj_Pathname'Address);
+
+         --  If the object file does not exist, recompile the file.
+         if Stamp = Null_Time_Stamp then
+            if Flag_Verbose then
+               Put_Line ("no object file for " & Image (Name));
+            end if;
+            return True;
+         end if;
+
+         --  Keep the time stamp of the most recently analyzed unit.
+         if Last_Stamp = Null_Time_Stamp
+           or else Is_Gt (Stamp, Last_Stamp)
+         then
+            Last_Stamp := Stamp;
+            Last_Stamp_File := Design_File;
+         end if;
+      end;
+
+      --  2) file has been modified.
+      File := Load_Source_File (Get_Design_File_Directory (Design_File),
+                                Get_Design_File_Filename (Design_File));
+      if not Is_Eq (Get_File_Time_Stamp (File),
+                    Get_File_Time_Stamp (Design_File))
+      then
+         if Flag_Verbose then
+            Put_Line ("file " & Image (Get_File_Name (File))
+                 & " has been modified");
+         end if;
+         return True;
+      end if;
+
+      return False;
+   end Is_File_Outdated;
+
+   function Is_Unit_Outdated (Unit : Iir_Design_Unit) return Boolean
+   is
+      Design_File : Iir_Design_File;
+   begin
+      --  Std.Standard is never outdated.
+      if Unit = Std_Package.Std_Standard_Unit then
+         return False;
+      end if;
+
+      Design_File := Get_Design_File (Unit);
+
+      --  1) not yet analyzed:
+      if Get_Date (Unit) not in Date_Valid then
+         if Flag_Verbose then
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            Put_Line (" was not analyzed");
+         end if;
+         return True;
+      end if;
+
+      --  3) the object file does not exist.
+      --  Already checked.
+
+      --  4) one of the dependence is newer
+      declare
+         Depends : Iir_List;
+         El : Iir;
+         Dep : Iir_Design_Unit;
+         Stamp : Time_Stamp_Id;
+         Dep_File : Iir_Design_File;
+      begin
+         Depends := Get_Dependence_List (Unit);
+         Stamp := Get_Analysis_Time_Stamp (Design_File);
+         if Depends /= Null_Iir_List then
+            for I in Natural loop
+               El := Get_Nth_Element (Depends, I);
+               exit when El = Null_Iir;
+               Dep := Libraries.Find_Design_Unit (El);
+               if Dep = Null_Iir then
+                  if Flag_Verbose then
+                     Disp_Library_Unit (Unit);
+                     Put (" depends on an unknown unit ");
+                     Disp_Library_Unit (El);
+                     New_Line;
+                  end if;
+                  return True;
+               end if;
+               Dep_File := Get_Design_File (Dep);
+               if Dep /= Std_Package.Std_Standard_Unit
+                 and then Files_Map.Is_Gt (Get_Analysis_Time_Stamp (Dep_File),
+                                           Stamp)
+               then
+                  if Flag_Verbose then
+                     Disp_Library_Unit (Get_Library_Unit (Unit));
+                     Put (" depends on: ");
+                     Disp_Library_Unit (Get_Library_Unit (Dep));
+                     Put (" (more recently analyzed)");
+                     New_Line;
+                  end if;
+                  return True;
+               end if;
+            end loop;
+         end if;
+      end;
+
+      return False;
+   end Is_Unit_Outdated;
+
+   procedure Add_Argument (Inst : in out Instance; Arg : String_Access)
+   is
+   begin
+      Increment_Last (Inst);
+      Inst.Table (Last (Inst)) := Arg;
+   end Add_Argument;
+
+   --  Convert option "-Wx,OPTIONS" to arguments for tool X.
+   procedure Add_Arguments (Inst : in out Instance; Opt : String) is
+   begin
+      Add_Argument (Inst, new String'(Opt (Opt'First + 4 .. Opt'Last)));
+   end Add_Arguments;
+
+   procedure Tool_Not_Found (Name : String) is
+   begin
+      Error ("installation problem: " & Name & " not found");
+      raise Option_Error;
+   end Tool_Not_Found;
+
+   --  Set the compiler command according to the configuration (and swicthes).
+   procedure Set_Tools_Name is
+   begin
+      --  Set tools name.
+      if Compiler_Cmd = null then
+         case Compile_Kind is
+            when Compile_Debug =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Debug);
+            when Compile_Gcc =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Gcc);
+            when Compile_Mcode =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Mcode);
+            when Compile_Llvm =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Llvm);
+         end case;
+      end if;
+      if Post_Processor_Cmd = null then
+         Post_Processor_Cmd := new String'(Default_Pathes.Post_Processor);
+      end if;
+   end Set_Tools_Name;
+
+   function Locate_Exec_Tool (Toolname : String) return String_Access is
+   begin
+      if Is_Absolute_Path (Toolname) then
+         if Is_Executable_File (Toolname) then
+            return new String'(Toolname);
+         end if;
+      else
+         --  Try from install prefix
+         if Exec_Prefix /= null then
+            declare
+               Path : constant String :=
+                 Exec_Prefix.all & Directory_Separator & Toolname;
+            begin
+               if Is_Executable_File (Path) then
+                  return new String'(Path);
+               end if;
+            end;
+         end if;
+
+         --  Try configured prefix
+         declare
+            Path : constant String :=
+              Default_Pathes.Install_Prefix & Directory_Separator & Toolname;
+         begin
+            if Is_Executable_File (Path) then
+               return new String'(Path);
+            end if;
+         end;
+      end if;
+
+      --  Search the basename on path.
+      declare
+         Pos : constant Natural := Get_Basename_Pos (Toolname);
+      begin
+         if Pos = 0 then
+            return Locate_Exec_On_Path (Toolname);
+         else
+            return Locate_Exec_On_Path (Toolname (Pos .. Toolname'Last));
+         end if;
+      end;
+   end Locate_Exec_Tool;
+
+   procedure Locate_Tools is
+   begin
+      Compiler_Path := Locate_Exec_Tool (Compiler_Cmd.all);
+      if Compiler_Path = null then
+         Tool_Not_Found (Compiler_Cmd.all);
+      end if;
+      if Compile_Kind >= Compile_Debug then
+         Post_Processor_Path := Locate_Exec_Tool (Post_Processor_Cmd.all);
+         if Post_Processor_Path = null then
+            Tool_Not_Found (Post_Processor_Cmd.all);
+         end if;
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Assembler_Path := Locate_Exec_On_Path (Assembler_Cmd);
+         if Assembler_Path = null and not Flag_Asm then
+            Tool_Not_Found (Assembler_Cmd);
+         end if;
+      end if;
+      Linker_Path := Locate_Exec_On_Path (Linker_Cmd);
+      if Linker_Path = null then
+         Tool_Not_Found (Linker_Cmd);
+      end if;
+   end Locate_Tools;
+
+   procedure Setup_Compiler (Load : Boolean)
+   is
+      use Libraries;
+   begin
+      Set_Tools_Name;
+      Setup_Libraries (Load);
+      Locate_Tools;
+      for I in 2 .. Get_Nbr_Pathes loop
+         Add_Argument (Compiler_Args,
+                       new String'("-P" & Image (Get_Path (I))));
+      end loop;
+   end Setup_Compiler;
+
+   type Command_Comp is abstract new Command_Lib with null record;
+
+   --  Setup GHDL.
+   procedure Init (Cmd : in out Command_Comp);
+
+   --  Handle:
+   --  all ghdl flags.
+   --  some GCC flags.
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Disp_Long_Help (Cmd : Command_Comp);
+
+   procedure Init (Cmd : in out Command_Comp)
+   is
+   begin
+      --  Init options.
+      Flag_Not_Quiet := False;
+      Flag_Disp_Commands := False;
+      Flag_Asm := False;
+      Flag_Expect_Failure := False;
+      Output_File := null;
+
+      --  Initialize argument tables.
+      Init (Compiler_Args);
+      Init (Postproc_Args);
+      Init (Assembler_Args);
+      Init (Linker_Args);
+      Init (Command_Lib (Cmd));
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      Str : String_Access;
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      Res := Option_Bad;
+      if Opt = "-v" and then Flag_Verbose = False then
+         --  Note: this is also decoded for command_lib, but we set
+         --  Flag_Disp_Commands too.
+         Flag_Verbose := True;
+         --Flags.Verbose := True;
+         Flag_Disp_Commands := True;
+         Res := Option_Ok;
+      elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then
+         Compiler_Cmd := new String'(Opt (9 .. Opt'Last));
+         Res := Option_Ok;
+      elsif Opt = "-S" then
+         Flag_Asm := True;
+         Res := Option_Ok;
+      elsif Opt = "--post" then
+         Compile_Kind := Compile_Debug;
+         Res := Option_Ok;
+      elsif Opt = "--mcode" then
+         Compile_Kind := Compile_Mcode;
+         Res := Option_Ok;
+      elsif Opt = "--llvm" then
+         Compile_Kind := Compile_Llvm;
+         Res := Option_Ok;
+      elsif Opt = "-o" then
+         if Arg'Length = 0 then
+            Res := Option_Arg_Req;
+         else
+            Output_File := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      elsif Opt = "-m32" then
+         Add_Argument (Compiler_Args, new String'("-m32"));
+         Add_Argument (Assembler_Args, new String'("--32"));
+         Add_Argument (Linker_Args, new String'("-m32"));
+         Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
+      elsif Opt'Length > 4
+        and then Opt (2) = 'W' and then Opt (4) = ','
+      then
+         if Opt (3) = 'c' then
+            Add_Arguments (Compiler_Args, Opt);
+         elsif Opt (3) = 'a' then
+            Add_Arguments (Assembler_Args, Opt);
+         elsif Opt (3) = 'p' then
+            Add_Arguments (Postproc_Args, Opt);
+         elsif Opt (3) = 'l' then
+            Add_Arguments (Linker_Args, Opt);
+         else
+            Error ("unknown tool name in '-W" & Opt (3) & ",' option");
+            raise Option_Error;
+         end if;
+         Res := Option_Ok;
+      elsif Opt'Length >= 2 and then Opt (2) = 'g' then
+         --  Debugging option.
+         Str := new String'(Opt);
+         Add_Argument (Compiler_Args, Str);
+         Add_Argument (Linker_Args, Str);
+         Res := Option_Ok;
+      elsif Opt = "-Q" then
+         Flag_Not_Quiet := True;
+         Res := Option_Ok;
+      elsif Opt = "--expect-failure" then
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Opt = "-C" then
+         --  Translate -C into --mb-comments, as gcc already has a definition
+         --  for -C.  Done before Flags.Parse_Option.
+         Add_Argument (Compiler_Args, new String'("--mb-comments"));
+         Res := Option_Ok;
+      elsif Options.Parse_Option (Opt) then
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Res := Option_Ok;
+      elsif Opt'Length >= 2
+        and then (Opt (2) = 'O' or Opt (2) = 'f')
+      then
+         --  Optimization option.
+         --  This is put after Flags.Parse_Option, since it may catch -fxxx
+         --  options.
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Comp) is
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Put_Line (" -v             Be verbose");
+      Put_Line (" --GHDL1=PATH   Set the path of the ghdl1 compiler");
+      Put_Line (" -S             Do not assemble");
+      Put_Line (" -o FILE        Set the name of the output file");
+   -- Put_Line (" -m32           Generate 32bit code on 64bit machines");
+      Put_Line (" -WX,OPTION     Pass OPTION to X, where X is one of");
+      Put_Line ("                 c: compiler, a: assembler, l: linker");
+      Put_Line (" -g[XX]         Pass debugging option to the compiler");
+      Put_Line (" -O[XX]/-f[XX]  Pass optimization option to the compiler");
+      Put_Line (" -Q             Do not add -quiet option to compiler");
+      Put_Line (" --expect-failure  Expect analysis/elaboration failure");
+   end Disp_Long_Help;
+
+   --  Command dispconfig.
+   type Command_Dispconfig is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String;
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--dispconfig" or else Name = "--disp-config";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--disp-config      Disp tools path";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List)
+   is
+      use Libraries;
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("--dispconfig does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Set_Tools_Name;
+      Put_Line ("Pathes at configuration:");
+      Put ("compiler command: ");
+      Put_Line (Compiler_Cmd.all);
+      if Compile_Kind >= Compile_Debug then
+         Put ("post-processor command: ");
+         Put_Line (Post_Processor_Cmd.all);
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Put ("assembler command: ");
+         Put_Line (Assembler_Cmd);
+      end if;
+      Put ("linker command: ");
+      Put_Line (Linker_Cmd);
+      Put_Line ("default lib prefix: " & Default_Pathes.Lib_Prefix);
+
+      New_Line;
+
+      Put ("command line prefix (--PREFIX): ");
+      if Switch_Prefix_Path = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Switch_Prefix_Path.all);
+      end if;
+
+      Put ("environment prefix (GHDL_PREFIX): ");
+      if Prefix_Env = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Env.all);
+      end if;
+
+      Setup_Libraries (False);
+
+      Put ("exec prefix (from program name): ");
+      if Exec_Prefix = null then
+         Put_Line ("(not found)");
+      else
+         Put_Line (Exec_Prefix.all);
+      end if;
+
+      New_Line;
+
+      Put_Line ("library prefix: " & Lib_Prefix_Path.all);
+      Put ("library directory: ");
+      Put_Line (Get_Machine_Path_Prefix);
+      Locate_Tools;
+      Put ("compiler path: ");
+      Put_Line (Compiler_Path.all);
+      if Compile_Kind >= Compile_Debug then
+         Put ("post-processor path: ");
+         Put_Line (Post_Processor_Path.all);
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Put ("assembler path: ");
+         Put_Line (Assembler_Path.all);
+      end if;
+      Put ("linker path: ");
+      Put_Line (Linker_Path.all);
+
+      New_Line;
+
+      Put_Line ("default library pathes:");
+      for I in 2 .. Get_Nbr_Pathes loop
+         Put (' ');
+         Put_Line (Image (Get_Path (I)));
+      end loop;
+   end Perform_Action;
+
+   --  Command Analyze.
+   type Command_Analyze is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Analyze) return String;
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-a";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Analyze) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-a [OPTS] FILEs    Analyze FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Nil_Opt : Argument_List (2 .. 1);
+   begin
+      if Args'Length = 0 then
+         Error ("no file to analyze");
+         raise Option_Error;
+      end if;
+      Setup_Compiler (False);
+
+      for I in Args'Range loop
+         Do_Compile (Nil_Opt, Args (I).all);
+      end loop;
+   end Perform_Action;
+
+   --  Elaboration.
+
+   Base_Name : String_Access;
+   Elab_Name : String_Access;
+   Filelist_Name : String_Access;
+   Unit_Name : String_Access;
+
+   procedure Set_Elab_Units (Cmd_Name : String;
+                             Args : Argument_List;
+                             Run_Arg : out Natural)
+   is
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Run_Arg);
+      if Sec_Name = null then
+         Base_Name := Prim_Name;
+         Unit_Name := Prim_Name;
+      else
+         Base_Name := new String'(Prim_Name.all & '-' & Sec_Name.all);
+         Unit_Name := new String'(Prim_Name.all & '(' & Sec_Name.all & ')');
+      end if;
+
+      Elab_Name := new String'(Elab_Prefix & Base_Name.all);
+      Filelist_Name := null;
+
+      if Output_File = null then
+         Output_File := new String'(Base_Name.all);
+      end if;
+   end Set_Elab_Units;
+
+   procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List)
+   is
+      Next_Arg : Natural;
+   begin
+      Set_Elab_Units (Cmd_Name, Args, Next_Arg);
+      if Next_Arg <= Args'Last then
+         Error ("too many unit names for command '" & Cmd_Name & "'");
+         raise Option_Error;
+      end if;
+   end Set_Elab_Units;
+
+   procedure Bind
+   is
+      Comp_List : Argument_List (1 .. 4);
+   begin
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+
+      Comp_List (1) := new String'("--elab");
+      Comp_List (2) := Unit_Name;
+      Comp_List (3) := new String'("-l");
+      Comp_List (4) := Filelist_Name;
+      Do_Compile (Comp_List, Elab_Name.all);
+      Free (Comp_List (3));
+      Free (Comp_List (1));
+   end Bind;
+
+   procedure Bind_Anaelab (Files : Argument_List)
+   is
+      Comp_List : Argument_List (1 .. Files'Length + 2);
+      Index : Natural;
+   begin
+      Comp_List (1) := new String'("--anaelab");
+      Comp_List (2) := Unit_Name;
+      Index := 3;
+      for I in Files'Range loop
+         Comp_List (Index) := new String'("--ghdl-source=" & Files (I).all);
+         Index := Index + 1;
+      end loop;
+      Do_Compile (Comp_List, Elab_Name.all);
+      Free (Comp_List (1));
+      for I in 3 .. Comp_List'Last loop
+         Free (Comp_List (I));
+      end loop;
+   end Bind_Anaelab;
+
+   procedure Link (Add_Std : Boolean;
+                   Disp_Only : Boolean)
+   is
+      Last_File : Natural;
+   begin
+      Link_Obj_Suffix := Get_Object_Suffix;
+
+      --  read files list
+      if Filelist_Name /= null then
+         Add_File_List (Filelist_Name.all, True);
+      end if;
+      Last_File := Filelist.Last;
+      Add_File_List (Get_Machine_Path_Prefix & "grt" & List_Suffix, False);
+
+      --  call the linker
+      declare
+         P : Natural;
+         Nbr_Args : constant Natural := Last (Linker_Args) + Filelist.Last + 4;
+         Args : Argument_List (1 .. Nbr_Args);
+         Obj_File : String_Access;
+         Std_File : String_Access;
+      begin
+         Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all);
+         P := 0;
+         Args (P + 1) := Dash_o;
+         Args (P + 2) := Output_File;
+         Args (P + 3) := Obj_File;
+         P := P + 3;
+         if Add_Std then
+            Std_File := new
+              String'(Get_Machine_Path_Prefix
+                      & Get_Version_Path & Directory_Separator
+                      & "std" & Directory_Separator
+                      & "std_standard" & Link_Obj_Suffix.all);
+            P := P + 1;
+            Args (P) := Std_File;
+         else
+            Std_File := null;
+         end if;
+
+         --  Object files of the design.
+         for I in Filelist.First .. Last_File loop
+            P := P + 1;
+            Args (P) := Filelist.Table (I);
+         end loop;
+         --  User added options.
+         for I in First .. Last (Linker_Args) loop
+            P := P + 1;
+            Args (P) := Linker_Args.Table (I);
+         end loop;
+         --  GRT files (should be the last one, since it contains an
+         --  optional main).
+         for I in Last_File + 1 .. Filelist.Last loop
+            P := P + 1;
+            Args (P) := Filelist.Table (I);
+         end loop;
+
+         if Disp_Only then
+            for I in 3 .. P loop
+               Put_Line (Args (I).all);
+            end loop;
+         else
+            My_Spawn (Linker_Path.all, Args (1 .. P));
+         end if;
+
+         Free (Obj_File);
+         Free (Std_File);
+      end;
+
+      for I in Filelist.First .. Filelist.Last loop
+         Free (Filelist.Table (I));
+      end loop;
+   end Link;
+
+   --  Command Elab.
+   type Command_Elab is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab) return String;
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-e";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-e [OPTS] UNIT [ARCH]      Elaborate UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Elab; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Success : Boolean;
+      pragma Unreferenced (Success);
+   begin
+      Set_Elab_Units ("-e", Args);
+      Setup_Compiler (False);
+
+      Bind;
+      if not Flag_Expect_Failure then
+         Link (Add_Std => True, Disp_Only => False);
+      end if;
+      Delete_File (Filelist_Name.all, Success);
+   end Perform_Action;
+
+   --  Command Run.
+   type Command_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run) return String;
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-r";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-r UNIT [ARCH] [OPTS]      Run UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Opt_Arg : Natural;
+   begin
+      Extract_Elab_Unit ("-r", Args, Opt_Arg);
+      if Sec_Name = null then
+         Base_Name := Prim_Name;
+      else
+         Base_Name := new String'(Prim_Name.all & '-' & Sec_Name.all);
+      end if;
+      if not Is_Regular_File (Base_Name.all & Nul) then
+         Error ("file '" & Base_Name.all & "' does not exists");
+         Error ("Please elaborate your design.");
+         raise Exec_Error;
+      end if;
+      My_Spawn ('.' & Directory_Separator & Base_Name.all,
+                Args (Opt_Arg .. Args'Last));
+   end Perform_Action;
+
+   --  Command Elab_Run.
+   type Command_Elab_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Elab_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab_Run) return String;
+   procedure Perform_Action (Cmd : in out Command_Elab_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--elab-run";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--elab-run [OPTS] UNIT [ARCH] [OPTS]  Elaborate and run UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Elab_Run;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Success : Boolean;
+      Run_Arg : Natural;
+   begin
+      Set_Elab_Units ("-elab-run", Args, Run_Arg);
+      Setup_Compiler (False);
+
+      Bind;
+      if Flag_Expect_Failure then
+         Delete_File (Filelist_Name.all, Success);
+      else
+         Link (Add_Std => True, Disp_Only => False);
+         Delete_File (Filelist_Name.all, Success);
+         My_Spawn ('.' & Directory_Separator & Output_File.all,
+                   Args (Run_Arg .. Args'Last));
+      end if;
+   end Perform_Action;
+
+   --  Command Bind.
+   type Command_Bind is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Bind; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Bind) return String;
+   procedure Perform_Action (Cmd : in out Command_Bind;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Bind; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--bind";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Bind) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--bind [OPTS] UNIT [ARCH]  Bind UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Bind; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--bind", Args);
+      Setup_Compiler (False);
+
+      Bind;
+   end Perform_Action;
+
+   --  Command Link.
+   type Command_Link is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Link; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Link) return String;
+   procedure Perform_Action (Cmd : in out Command_Link; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Link; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--link";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Link) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--link [OPTS] UNIT [ARCH]  Link UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Link; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--link", Args);
+      Setup_Compiler (False);
+
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+      Link (Add_Std => True, Disp_Only => False);
+   end Perform_Action;
+
+
+   --  Command List_Link.
+   type Command_List_Link is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_List_Link; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_List_Link) return String;
+   procedure Perform_Action (Cmd : in out Command_List_Link;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_List_Link; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--list-link";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_List_Link) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--list-link [OPTS] UNIT [ARCH]  List objects file to link UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_List_Link;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--list-link", Args);
+      Setup_Compiler (False);
+
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+      Link (Add_Std => True, Disp_Only => True);
+   end Perform_Action;
+
+
+   --  Command analyze and elaborate
+   type Command_Anaelab is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Anaelab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Anaelab) return String;
+   procedure Decode_Option (Cmd : in out Command_Anaelab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Perform_Action (Cmd : in out Command_Anaelab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Anaelab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-c";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Anaelab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-c [OPTS] FILEs -e UNIT [ARCH]  "
+        & "Generate whole code to elab UNIT from FILEs";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Anaelab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-e" then
+         Res := Option_End;
+         return;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Anaelab;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Elab_Index : Integer;
+   begin
+      Elab_Index := -1;
+      for I in Args'Range loop
+         if Args (I).all = "-e" then
+            Elab_Index := I;
+            exit;
+         end if;
+      end loop;
+      if Elab_Index < 0 then
+         Analyze_Files (Args, True);
+      else
+         Flags.Flag_Whole_Analyze := True;
+         Set_Elab_Units ("-c", Args (Elab_Index + 1 .. Args'Last));
+         Setup_Compiler (False);
+
+         Bind_Anaelab (Args (Args'First .. Elab_Index - 1));
+         Link (Add_Std => False, Disp_Only => False);
+      end if;
+   end Perform_Action;
+
+   --  Command Make.
+   type Command_Make is new Command_Comp with record
+      --  Disp dependences during make.
+      Flag_Depend_Unit : Boolean;
+
+      --  Force recompilation of units in work library.
+      Flag_Force : Boolean;
+   end record;
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean;
+   procedure Init (Cmd : in out Command_Make);
+   procedure Decode_Option (Cmd : in out Command_Make;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   function Get_Short_Help (Cmd : Command_Make) return String;
+   procedure Disp_Long_Help (Cmd : Command_Make);
+
+   procedure Perform_Action (Cmd : in out Command_Make;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-m";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Make) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-m [OPTS] UNIT [ARCH]  Make UNIT";
+   end Get_Short_Help;
+
+   procedure Disp_Long_Help (Cmd : Command_Make)
+   is
+   begin
+      Disp_Long_Help (Command_Comp (Cmd));
+      Put_Line (" -f             Force recompilation of work units");
+      Put_Line (" -Mu            Disp unit dependences (human format)");
+   end Disp_Long_Help;
+
+   procedure Init (Cmd : in out Command_Make) is
+   begin
+      Init (Command_Comp (Cmd));
+      Cmd.Flag_Depend_Unit := False;
+      Cmd.Flag_Force := False;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Make;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res) is
+   begin
+      if Option = "-Mu" then
+         Cmd.Flag_Depend_Unit := True;
+         Res := Option_Ok;
+      elsif Option = "-f" then
+         Cmd.Flag_Force := True;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List)
+   is
+      use Configuration;
+
+      File : Iir_Design_File;
+      Unit : Iir;
+      Lib_Unit : Iir;
+      Lib : Iir_Library_Declaration;
+      In_Work : Boolean;
+
+      Files_List : Iir_List;
+
+      --  Set when a design file has been compiled.
+      Has_Compiled : Boolean;
+
+      Need_Analyze : Boolean;
+
+      Need_Elaboration : Boolean;
+
+      Stamp : Time_Stamp_Id;
+      File_Id : Name_Id;
+
+      Nil_Args : Argument_List (2 .. 1);
+      Success : Boolean;
+   begin
+      Set_Elab_Units ("-m", Args);
+      Setup_Compiler (True);
+
+      --  Create list of files.
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      if Cmd.Flag_Depend_Unit then
+         Put_Line ("Units analysis order:");
+         for I in Design_Units.First .. Design_Units.Last loop
+            Unit := Design_Units.Table (I);
+            Put ("  ");
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+--             Put (" file: ");
+--             File := Get_Design_File (Unit);
+--             Image (Get_Design_File_Filename (File));
+--             Put_Line (Name_Buffer (1 .. Name_Length));
+         end loop;
+      end if;
+      if Cmd.Flag_Depend_Unit then
+         Put_Line ("File analysis order:");
+         for I in Natural loop
+            File := Get_Nth_Element (Files_List, I);
+            exit when File = Null_Iir;
+            Image (Get_Design_File_Filename (File));
+            Put ("  ");
+            Put (Name_Buffer (1 .. Name_Length));
+            if Flag_Verbose then
+               Put_Line (":");
+               declare
+                  Dep_List : Iir_List;
+                  Dep_File : Iir;
+               begin
+                  Dep_List := Get_File_Dependence_List (File);
+                  if Dep_List /= Null_Iir_List then
+                     for J in Natural loop
+                        Dep_File := Get_Nth_Element (Dep_List, J);
+                        exit when Dep_File = Null_Iir;
+                        Image (Get_Design_File_Filename (Dep_File));
+                        Put ("    ");
+                        Put_Line (Name_Buffer (1 .. Name_Length));
+                     end loop;
+                  end if;
+               end;
+            else
+               New_Line;
+            end if;
+         end loop;
+      end if;
+
+      Has_Compiled := False;
+      Last_Stamp := Null_Time_Stamp;
+
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+
+         Need_Analyze := False;
+         if Is_File_Outdated (File) then
+            Need_Analyze := True;
+         else
+            Unit := Get_First_Design_Unit (File);
+            while Unit /= Null_Iir loop
+               Lib_Unit := Get_Library_Unit (Unit);
+               if not (Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration
+                       and then Get_Identifier (Lib_Unit) = Null_Identifier)
+               then
+                  if Is_Unit_Outdated (Unit) then
+                     Need_Analyze := True;
+                     exit;
+                  end if;
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+
+         Lib := Get_Library (File);
+         In_Work := Lib = Libraries.Work_Library;
+
+         if Need_Analyze or else (Cmd.Flag_Force and In_Work) then
+            File_Id := Get_Design_File_Filename (File);
+            if not Flag_Verbose then
+               Put ("analyze ");
+               Put (Image (File_Id));
+               --Disp_Library_Unit (Get_Library_Unit (Unit));
+               New_Line;
+            end if;
+
+            if In_Work then
+               Do_Compile (Nil_Args, Image (File_Id));
+            else
+               declare
+                  use Libraries;
+                  Lib_Args : Argument_List (1 .. 2);
+                  Prev_Workdir : Name_Id;
+               begin
+                  Prev_Workdir := Work_Directory;
+
+                  --  Must be set, since used to build the object filename.
+                  Work_Directory := Get_Library_Directory (Lib);
+
+                  --  Always overwrite --work and --workdir.
+                  Lib_Args (1) := new String'
+                    ("--work=" & Image (Get_Identifier (Lib)));
+                  if Work_Directory = Libraries.Local_Directory then
+                     Lib_Args (2) := new String'("--workdir=.");
+                  else
+                     Lib_Args (2) := new String'
+                       ("--workdir=" & Image (Work_Directory));
+                  end if;
+                  Do_Compile (Lib_Args, Image (File_Id));
+
+                  Work_Directory := Prev_Workdir;
+
+                  Free (Lib_Args (1));
+                  Free (Lib_Args (2));
+               end;
+            end if;
+
+            Has_Compiled := True;
+            --  Set the analysis time stamp since the file has just been
+            --  analyzed.
+            Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp);
+         end if;
+      end loop;
+
+      Need_Elaboration := False;
+      --  Elaboration.
+      --  if libgrt is more recent than the executable (FIXME).
+      if Has_Compiled then
+         if Flag_Verbose then
+            Put_Line ("link due to a file compilation");
+         end if;
+         Need_Elaboration := True;
+      else
+         declare
+            Exec_File : String := Output_File.all & Nul;
+         begin
+            Stamp := Files_Map.Get_File_Time_Stamp (Exec_File'Address);
+         end;
+
+         if Stamp = Null_Time_Stamp then
+            if Flag_Verbose then
+               Put_Line ("link due to no binary file");
+            end if;
+            Need_Elaboration := True;
+         else
+            if Files_Map.Is_Gt (Last_Stamp, Stamp) then
+               --  if a file is more recent than the executable.
+               if Flag_Verbose then
+                  Put ("link due to outdated binary file: ");
+                  Put (Image (Get_Design_File_Filename (Last_Stamp_File)));
+                  Put (" (");
+                  Put (Files_Map.Get_Time_Stamp_String (Last_Stamp));
+                  Put (" > ");
+                  Put (Files_Map.Get_Time_Stamp_String (Stamp));
+                  Put (")");
+                  New_Line;
+               end if;
+               Need_Elaboration := True;
+            end if;
+         end if;
+      end if;
+      if Need_Elaboration then
+         if not Flag_Verbose then
+            Put ("elaborate ");
+            Put (Prim_Name.all);
+            --Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+         end if;
+         Bind;
+         Link (Add_Std => True, Disp_Only => False);
+         Delete_File (Filelist_Name.all, Success);
+      end if;
+   exception
+      when Errorout.Compilation_Error =>
+         if Flag_Expect_Failure then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command Gen_Makefile.
+   type Command_Gen_Makefile is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String;
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--gen-makefile";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--gen-makefile [OPTS] UNIT [ARCH]  Generate a Makefile for UNIT";
+   end Get_Short_Help;
+
+   function Is_Makeable_File (File : Iir_Design_File) return Boolean is
+   begin
+      if File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+      return True;
+   end Is_Makeable_File;
+
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      HT : constant Character := Ada.Characters.Latin_1.HT;
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Lib : Iir_Library_Declaration;
+      Dir_Id : Name_Id;
+
+      Dep_List : Iir_List;
+      Dep_File : Iir;
+   begin
+      Set_Elab_Units ("--gen-makefile", Args);
+      Setup_Libraries (True);
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Put_Line ("# Makefile automatically generated by ghdl");
+      Put ("# Version: ");
+      Put (Version.Ghdl_Release);
+      Put (" - ");
+      if Version_String /= null then
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("# Command used to generate this makefile:");
+      Put ("# ");
+      Put (Command_Name);
+      for I in 1 .. Argument_Count loop
+         Put (' ');
+         Put (Argument (I));
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put ("GHDL=");
+      Put_Line (Command_Name);
+
+      --  Extract options for command line.
+      Put ("GHDLFLAGS=");
+      for I in 2 .. Argument_Count loop
+         declare
+            Arg : constant String := Argument (I);
+         begin
+            if Arg (1) = '-' then
+               if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--ieee=")
+                 or else (Arg'Length > 6 and then Arg (1 .. 6) = "--std=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--work=")
+                 or else (Arg'Length > 2 and then Arg (1 .. 2) = "-P")
+               then
+                  Put (" ");
+                  Put (Arg);
+               end if;
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put_Line ("# Default target");
+      Put ("all: ");
+      Put_Line (Base_Name.all);
+      New_Line;
+
+      Put_Line ("# Elaboration target");
+      Put (Base_Name.all);
+      Put (":");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         if Is_Makeable_File (File) then
+            Put (" ");
+            Put (Get_Object_Filename (File));
+         end if;
+      end loop;
+      New_Line;
+      Put_Line (HT & "$(GHDL) -e $(GHDLFLAGS) $@");
+      New_Line;
+
+      Put_Line ("# Run target");
+      Put_Line ("run: " & Base_Name.all);
+      Put_Line (HT & "$(GHDL) -r " & Base_Name.all & " $(GHDLRUNFLAGS)");
+      New_Line;
+
+      Put_Line ("# Targets to analyze files");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         Dir_Id := Get_Design_File_Directory (File);
+         if not Is_Makeable_File (File) then
+            --  Builtin file.
+            null;
+         else
+            Put (Get_Object_Filename (File));
+            Put (": ");
+            if Dir_Id /= Files_Map.Get_Home_Directory then
+               Put (Image (Dir_Id));
+               Put (Image (Get_Design_File_Filename (File)));
+               New_Line;
+
+               Put_Line
+                 (HT & "@echo ""This file was not locally built ($<)""");
+               Put_Line (HT & "exit 1");
+            else
+               Put (Image (Get_Design_File_Filename (File)));
+               New_Line;
+
+               Put (HT & "$(GHDL) -a $(GHDLFLAGS)");
+               Lib := Get_Library (File);
+               if Lib /= Libraries.Work_Library then
+                  --  Overwrite some options.
+                  Put (" --work=");
+                  Put (Image (Get_Identifier (Lib)));
+                  Dir_Id := Get_Library_Directory (Lib);
+                  Put (" --workdir=");
+                  if Dir_Id = Libraries.Local_Directory then
+                     Put (".");
+                  else
+                     Put (Image (Dir_Id));
+                  end if;
+               end if;
+               Put_Line (" $<");
+            end if;
+         end if;
+      end loop;
+      New_Line;
+
+      Put_Line ("# Files dependences");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         if Is_Makeable_File (File) then
+            Put (Get_Object_Filename (File));
+            Put (": ");
+            Dep_List := Get_File_Dependence_List (File);
+            if Dep_List /= Null_Iir_List then
+               for J in Natural loop
+                  Dep_File := Get_Nth_Element (Dep_List, J);
+                  exit when Dep_File = Null_Iir;
+                  if Dep_File /= File and then Is_Makeable_File (Dep_File)
+                  then
+                     Put (" ");
+                     Put (Get_Object_Filename (Dep_File));
+                  end if;
+                  end loop;
+            end if;
+            New_Line;
+         end if;
+      end loop;
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Analyze);
+      Register_Command (new Command_Elab);
+      Register_Command (new Command_Run);
+      Register_Command (new Command_Elab_Run);
+      Register_Command (new Command_Bind);
+      Register_Command (new Command_Link);
+      Register_Command (new Command_List_Link);
+      Register_Command (new Command_Anaelab);
+      Register_Command (new Command_Make);
+      Register_Command (new Command_Gen_Makefile);
+      Register_Command (new Command_Dispconfig);
+   end Register_Commands;
+end Ghdldrv;
diff --git a/src/translate/ghdldrv/ghdldrv.ads b/src/translate/ghdldrv/ghdldrv.ads
new file mode 100644
index 000000000..3e37b38f1
--- /dev/null
+++ b/src/translate/ghdldrv/ghdldrv.ads
@@ -0,0 +1,25 @@
+--  GHDL driver - commands invoking gcc.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+package Ghdldrv is
+   --  Compiler to use.
+   type Compile_Kind_Type is
+     (Compile_Mcode, Compile_Llvm, Compile_Gcc, Compile_Debug);
+   Compile_Kind : Compile_Kind_Type := Compile_Gcc;
+
+   procedure Register_Commands;
+end Ghdldrv;
diff --git a/src/translate/ghdldrv/ghdllocal.adb b/src/translate/ghdldrv/ghdllocal.adb
new file mode 100644
index 000000000..a1d94bd77
--- /dev/null
+++ b/src/translate/ghdldrv/ghdllocal.adb
@@ -0,0 +1,1415 @@
+--  GHDL driver - local commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ada.Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with GNAT.Directory_Operations;
+with Types; use Types;
+with Libraries;
+with Std_Package;
+with Flags;
+with Name_Table;
+with Std_Names;
+with Back_End;
+with Disp_Vhdl;
+with Default_Pathes;
+with Scanner;
+with Sem;
+with Canon;
+with Errorout;
+with Configuration;
+with Files_Map;
+with Post_Sems;
+with Disp_Tree;
+with Options;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Ghdllocal is
+   --  Version of the IEEE library to use.  This just change pathes.
+   type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor);
+   Flag_Ieee : Ieee_Lib_Kind;
+
+   Flag_Create_Default_Config : constant Boolean := True;
+
+   --  If TRUE, generate 32bits code on 64bits machines.
+   Flag_32bit : Boolean := False;
+
+   procedure Finish_Compilation
+     (Unit : Iir_Design_Unit; Main : Boolean := False)
+   is
+      use Errorout;
+      use Ada.Text_IO;
+      Config : Iir_Design_Unit;
+      Lib : Iir;
+   begin
+      if (Main or Flags.Dump_All) and then Flags.Dump_Parse then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Flags.Verbose then
+         Put_Line ("semantize " & Disp_Node (Get_Library_Unit (Unit)));
+      end if;
+
+      Sem.Semantic (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Sem then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Sem then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      Post_Sems.Post_Sem_Checks (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if Flags.Flag_Elaborate then
+         if Flags.Verbose then
+            Put_Line ("canonicalize " & Disp_Node (Get_Library_Unit (Unit)));
+         end if;
+
+         Canon.Canonicalize (Unit);
+
+         if Flag_Create_Default_Config then
+            Lib := Get_Library_Unit (Unit);
+            if Get_Kind (Lib) = Iir_Kind_Architecture_Body then
+               Config := Canon.Create_Default_Configuration_Declaration (Lib);
+               Set_Default_Configuration_Declaration (Lib, Config);
+            end if;
+         end if;
+      end if;
+   end Finish_Compilation;
+
+   procedure Init (Cmd : in out Command_Lib)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Options.Initialize;
+      Flag_Ieee := Lib_Standard;
+      Back_End.Finish_Compilation := Finish_Compilation'Access;
+      Flag_Verbose := False;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Lib;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Arg);
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      Res := Option_Bad;
+      if Opt = "-v" and then Flag_Verbose = False then
+         Flag_Verbose := True;
+         Res := Option_Ok;
+      elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then
+         Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last));
+         Res := Option_Ok;
+      elsif Opt = "--ieee=synopsys" then
+         Flag_Ieee := Lib_Synopsys;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=mentor" then
+         Flag_Ieee := Lib_Mentor;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=none" then
+         Flag_Ieee := Lib_None;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=standard" then
+         Flag_Ieee := Lib_Standard;
+         Res := Option_Ok;
+      elsif Opt = "-m32" then
+         Flag_32bit := True;
+         Res := Option_Ok;
+      elsif Opt'Length >= 2
+        and then (Opt (2) = 'g' or Opt (2) = 'O')
+      then
+         --  Silently accept -g and -O.
+         Res := Option_Ok;
+      else
+         if Options.Parse_Option (Opt) then
+            Res := Option_Ok;
+         end if;
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Lib)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+      procedure P (Str : String) renames Put_Line;
+   begin
+      P ("Main options (try --options-help for details):");
+      P (" --std=XX       Use XX as VHDL standard (87,93c,93,00 or 02)");
+      P (" --work=NAME    Set the name of the WORK library");
+      P (" -PDIR          Add DIR in the library search path");
+      P (" --workdir=DIR  Specify the directory of the WORK library");
+      P (" --PREFIX=DIR   Specify installation prefix");
+      P (" --ieee=NAME    Use NAME as ieee library, where name is:");
+      P ("    standard: standard version (default)");
+      P ("    synopsys, mentor: vendor version (not advised)");
+      P ("    none: do not use a predefined ieee library");
+   end Disp_Long_Help;
+
+   function Is_Directory_Separator (C : Character) return Boolean is
+   begin
+      return C = '/' or else C = Directory_Separator;
+   end Is_Directory_Separator;
+
+   function Get_Basename_Pos (Pathname : String) return Natural is
+   begin
+      for I in reverse Pathname'Range loop
+         if Is_Directory_Separator (Pathname (I)) then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Get_Basename_Pos;
+
+   procedure Set_Prefix_From_Program_Path (Prog_Path : String)
+   is
+      Dir_Pos : Natural;
+   begin
+      Dir_Pos := Get_Basename_Pos (Prog_Path);
+      if Dir_Pos = 0 then
+         --  No directory in Prog_Path.  This is not expected.
+         return;
+      end if;
+
+      declare
+         Pathname : String :=
+           Normalize_Pathname (Prog_Path (Dir_Pos + 1 .. Prog_Path'Last),
+                               Prog_Path (Prog_Path'First .. Dir_Pos - 1));
+         Pos : Natural;
+      begin
+         --  Stop now in case of error.
+         if Pathname'Length = 0 then
+            return;
+         end if;
+
+         --  Skip executable name
+         Dir_Pos := Get_Basename_Pos (Pathname);
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         --  Simplify path:
+         --    /./ => /
+         --    // => /
+         Pos := Dir_Pos - 1;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos)) then
+               if Is_Directory_Separator (Pathname (Pos + 1)) then
+                  --  // => /
+                  Pathname (Pos .. Dir_Pos - 1) :=
+                    Pathname (Pos + 1 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 1;
+               elsif Pos + 2 <= Dir_Pos
+                 and then Pathname (Pos + 1) = '.'
+                 and then Is_Directory_Separator (Pathname (Pos + 2))
+               then
+                  --  /./ => /
+                  Pathname (Pos .. Dir_Pos - 2) :=
+                    Pathname (Pos + 2 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 2;
+               end if;
+            end if;
+            Pos := Pos - 1;
+         end loop;
+
+         --  Simplify path:
+         --    /xxx/../ => /
+         --  This is done after the previous simplication to avoid to deal
+         --  with cases like /xxx//../ or /xxx/./../
+         Pos := Dir_Pos - 3;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos))
+              and then Pathname (Pos + 1) = '.'
+              and then Pathname (Pos + 2) = '.'
+              and then Is_Directory_Separator (Pathname (Pos + 3))
+            then
+               declare
+                  Pos2 : constant Natural :=
+                    Get_Basename_Pos (Pathname (Pathname'First .. Pos - 1));
+                  --  /xxxxxxxxxx/../
+                  --  ^          ^
+                  --  Pos2       Pos
+                  Len : Natural;
+               begin
+                  if Pos2 = 0 then
+                     --  Shouldn't happen.
+                     return;
+                  end if;
+                  Len := Pos + 3 - Pos2;
+                  Pathname (Pos2 + 1 .. Dir_Pos - Len) :=
+                    Pathname (Pos + 4 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - Len;
+                  if Pos2 < Pathname'First + 3 then
+                     exit;
+                  end if;
+                  Pos := Pos2 - 3;
+               end;
+            else
+               Pos := Pos - 1;
+            end if;
+         end loop;
+
+         --  Remove last '/'
+         Dir_Pos := Dir_Pos - 1;
+
+         --  Skip directory.
+         Dir_Pos := Get_Basename_Pos (Pathname (Pathname'First .. Dir_Pos));
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         Exec_Prefix := new String'(Pathname (Pathname'First .. Dir_Pos - 1));
+      end;
+   end Set_Prefix_From_Program_Path;
+
+   --  Extract Exec_Prefix from executable name.
+   procedure Set_Exec_Prefix
+   is
+      use GNAT.Directory_Operations;
+      Prog_Path : constant String := Ada.Command_Line.Command_Name;
+      Exec_Path : String_Access;
+   begin
+      --  If the command name is an absolute path, deduce prefix from it.
+      if Is_Absolute_Path (Prog_Path) then
+         Set_Prefix_From_Program_Path (Prog_Path);
+         return;
+      end if;
+
+      --  If the command name is a relative path, deduce prefix from it
+      --  and current path.
+      if Get_Basename_Pos (Prog_Path) /= 0 then
+         if Is_Executable_File (Prog_Path) then
+            Set_Prefix_From_Program_Path
+              (Get_Current_Dir & Directory_Separator & Prog_Path);
+         end if;
+         return;
+      end if;
+
+      --  Look for program name on the path.
+      Exec_Path := Locate_Exec_On_Path (Prog_Path);
+      if Exec_Path /= null then
+         Set_Prefix_From_Program_Path (Exec_Path.all);
+         Free (Exec_Path);
+      end if;
+   end Set_Exec_Prefix;
+
+   function Get_Version_Path return String
+   is
+      use Flags;
+   begin
+      case Vhdl_Std is
+         when Vhdl_87 =>
+            return "v87";
+         when Vhdl_93c
+           | Vhdl_93
+           | Vhdl_00
+           | Vhdl_02 =>
+            return "v93";
+         when Vhdl_08 =>
+            return "v08";
+      end case;
+   end Get_Version_Path;
+
+   function Get_Machine_Path_Prefix return String is
+   begin
+      if Flag_32bit then
+         return Lib_Prefix_Path.all & "32";
+      else
+         return Lib_Prefix_Path.all;
+      end if;
+   end Get_Machine_Path_Prefix;
+
+   procedure Add_Library_Path (Name : String)
+   is
+   begin
+      Libraries.Add_Library_Path
+        (Get_Machine_Path_Prefix & Directory_Separator
+         & Get_Version_Path & Directory_Separator
+         & Name & Directory_Separator);
+   end Add_Library_Path;
+
+   procedure Setup_Libraries (Load : Boolean)
+   is
+   begin
+      --  Get environment variable.
+      Prefix_Env := GNAT.OS_Lib.Getenv ("GHDL_PREFIX");
+      if Prefix_Env = null or else Prefix_Env.all = "" then
+         Prefix_Env := null;
+      end if;
+
+      --  Compute Exec_Prefix.
+      Set_Exec_Prefix;
+
+      --  Set prefix path.
+      --  If not set by command line, try environment variable.
+      if Switch_Prefix_Path /= null then
+         Lib_Prefix_Path := Switch_Prefix_Path;
+      else
+         Lib_Prefix_Path := Prefix_Env;
+      end if;
+      --  Else try default path.
+      if Lib_Prefix_Path = null then
+         if Is_Absolute_Path (Default_Pathes.Lib_Prefix) then
+            Lib_Prefix_Path := new String'(Default_Pathes.Lib_Prefix);
+         else
+            if Exec_Prefix /= null then
+               Lib_Prefix_Path := new
+                 String'(Exec_Prefix.all & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+            if Lib_Prefix_Path = null
+              or else not Is_Directory (Lib_Prefix_Path.all)
+            then
+               Free (Lib_Prefix_Path);
+               Lib_Prefix_Path := new
+                 String'(Default_Pathes.Install_Prefix
+                           & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+         end if;
+      else
+         -- Assume the user has set the correct path, so do not insert 32.
+         Flag_32bit := False;
+      end if;
+
+      --  Add pathes for predefined libraries.
+      if not Flags.Bootstrap then
+         Add_Library_Path ("std");
+         case Flag_Ieee is
+            when Lib_Standard =>
+               Add_Library_Path ("ieee");
+            when Lib_Synopsys =>
+               Add_Library_Path ("synopsys");
+            when Lib_Mentor =>
+               Add_Library_Path ("mentor");
+            when Lib_None =>
+               null;
+         end case;
+      end if;
+      if Load then
+         Libraries.Load_Std_Library;
+         Libraries.Load_Work_Library;
+      end if;
+   end Setup_Libraries;
+
+   procedure Disp_Library_Unit (Unit : Iir)
+   is
+      use Ada.Text_IO;
+      use Name_Table;
+      Id : Name_Id;
+   begin
+      Id := Get_Identifier (Unit);
+      case Get_Kind (Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            Put ("entity ");
+         when Iir_Kind_Architecture_Body =>
+            Put ("architecture ");
+         when Iir_Kind_Configuration_Declaration =>
+            Put ("configuration ");
+         when Iir_Kind_Package_Declaration =>
+            Put ("package ");
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Put ("package instance ");
+         when Iir_Kind_Package_Body =>
+            Put ("package body ");
+         when others =>
+            Put ("???");
+            return;
+      end case;
+      Image (Id);
+      Put (Name_Buffer (1 .. Name_Length));
+      case Get_Kind (Unit) is
+         when Iir_Kind_Architecture_Body =>
+            Put (" of ");
+            Image (Get_Entity_Identifier_Of_Architecture (Unit));
+            Put (Name_Buffer (1 .. Name_Length));
+         when Iir_Kind_Configuration_Declaration =>
+            if Id = Null_Identifier then
+               Put ("<default> of entity ");
+               Image (Get_Entity_Identifier_Of_Architecture (Unit));
+               Put (Name_Buffer (1 .. Name_Length));
+            end if;
+         when others =>
+            null;
+      end case;
+   end Disp_Library_Unit;
+
+   procedure Disp_Library (Name : Name_Id)
+   is
+      use Ada.Text_IO;
+      use Libraries;
+      Lib : Iir_Library_Declaration;
+      File : Iir_Design_File;
+      Unit : Iir;
+   begin
+      if Name = Std_Names.Name_Work then
+         Lib := Work_Library;
+      elsif Name = Std_Names.Name_Std then
+         Lib := Std_Library;
+      else
+         Lib := Get_Library (Name, Command_Line_Location);
+      end if;
+
+      --  Disp contents of files.
+      File := Get_Design_File_Chain (Lib);
+      while File /= Null_Iir loop
+         Unit := Get_First_Design_Unit (File);
+         while Unit /= Null_Iir loop
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+            Unit := Get_Chain (Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Disp_Library;
+
+   --  Return FILENAME without the extension.
+   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
+                           return String
+   is
+      First : Natural;
+      Last : Natural;
+   begin
+      First := Filename'First;
+      Last := Filename'Last;
+      for I in Filename'Range loop
+         if Filename (I) = '.' then
+            Last := I - 1;
+         elsif Remove_Dir and then Filename (I) = Directory_Separator then
+            First := I + 1;
+            Last := Filename'Last;
+         end if;
+      end loop;
+      return Filename (First .. Last);
+   end Get_Base_Name;
+
+   function Append_Suffix (File : String; Suffix : String) return String_Access
+   is
+      use Name_Table;
+      Basename : constant String := Get_Base_Name (File);
+   begin
+      Image (Libraries.Work_Directory);
+      Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) :=
+        Basename;
+      Name_Length := Name_Length + Basename'Length;
+      Name_Buffer (Name_Length + 1 .. Name_Length + Suffix'Length) := Suffix;
+      Name_Length := Name_Length + Suffix'Length;
+      return new String'(Name_Buffer (1 .. Name_Length));
+   end Append_Suffix;
+
+
+   --  Command Dir.
+   type Command_Dir is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Dir) return String;
+   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-d" or else Name = "--dir";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dir) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-d or --dir        Disp contents of the work library";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("command '-d' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Flags.Bootstrap := True;
+      --  Load word library.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      Disp_Library (Std_Names.Name_Work);
+
+--       else
+--          for L in Libs'Range loop
+--             Id := Get_Identifier (Libs (L).all);
+--             Disp_Library (Id);
+--          end loop;
+--       end if;
+   end Perform_Action;
+
+   --  Command Find.
+   type Command_Find is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Find; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Find) return String;
+   procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Find; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-f";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Find) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-f FILEs           Disp units in FILES";
+   end Get_Short_Help;
+
+   --  Return TRUE is UNIT can be at the apex of a design hierarchy.
+   function Is_Top_Entity (Unit : Iir) return Boolean
+   is
+   begin
+      if Get_Kind (Unit) /= Iir_Kind_Entity_Declaration then
+         return False;
+      end if;
+      if Get_Port_Chain (Unit) /= Null_Iir then
+         return False;
+      end if;
+      if Get_Generic_Chain (Unit) /= Null_Iir then
+         return False;
+      end if;
+      return True;
+   end Is_Top_Entity;
+
+   --  Disp contents design files FILES.
+   procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Ada.Text_IO;
+      use Name_Table;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Lib : Iir;
+      Flag_Add : constant Boolean := False;
+   begin
+      Flags.Bootstrap := True;
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               Lib := Get_Library_Unit (Unit);
+               Disp_Library_Unit (Lib);
+               if Is_Top_Entity (Lib) then
+                  Put (" **");
+               end if;
+               New_Line;
+               if Flag_Add then
+                  Libraries.Add_Design_Unit_Into_Library (Unit);
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+      end loop;
+      if Flag_Add then
+         Libraries.Save_Work_Library;
+      end if;
+   end Perform_Action;
+
+   --  Command Import.
+   type Command_Import is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Import; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Import) return String;
+   procedure Perform_Action (Cmd : in out Command_Import;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Import; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-i";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Import) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-i [OPTS] FILEs    Import units of FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Import; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+      Lib : Iir;
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               if Flag_Verbose then
+                  Lib := Get_Library_Unit (Unit);
+                  Disp_Library_Unit (Lib);
+                  if Is_Top_Entity (Lib) then
+                     Put (" **");
+                  end if;
+                  New_Line;
+               end if;
+               Next_Unit := Get_Chain (Unit);
+               Set_Chain (Unit, Null_Iir);
+               Libraries.Add_Design_Unit_Into_Library (Unit);
+               Unit := Next_Unit;
+            end loop;
+         end if;
+      end loop;
+
+      --  Analyze all files.
+      if False then
+         Design_File := Get_Design_File_Chain (Libraries.Work_Library);
+         while Design_File /= Null_Iir loop
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               case Get_Date (Unit) is
+                  when Date_Valid
+                    | Date_Analyzed =>
+                     null;
+                  when Date_Parsed =>
+                     Back_End.Finish_Compilation (Unit, False);
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               Unit := Get_Chain (Unit);
+            end loop;
+            Design_File := Get_Chain (Design_File);
+         end loop;
+      end if;
+
+      Libraries.Save_Work_Library;
+   exception
+      when Errorout.Compilation_Error =>
+         Error ("importation has failed due to compilation error");
+         raise;
+   end Perform_Action;
+
+   --  Command Check_Syntax.
+   type Command_Check_Syntax is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Check_Syntax; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Check_Syntax) return String;
+   procedure Perform_Action (Cmd : in out Command_Check_Syntax;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Check_Syntax; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-s";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Check_Syntax) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-s [OPTS] FILEs    Check syntax of FILEs";
+   end Get_Short_Help;
+
+   procedure Analyze_One_File (File_Name : String)
+   is
+      use Ada.Text_IO;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+   begin
+      Id := Name_Table.Get_Identifier (File_Name);
+      if Flag_Verbose then
+         Put (File_Name);
+         Put_Line (":");
+      end if;
+      Design_File := Libraries.Load_File (Id);
+      if Design_File = Null_Iir then
+         raise Errorout.Compilation_Error;
+      end if;
+
+      Unit := Get_First_Design_Unit (Design_File);
+      while Unit /= Null_Iir loop
+         if Flag_Verbose then
+            Put (' ');
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+         end if;
+         -- Sem, canon, annotate a design unit.
+         Back_End.Finish_Compilation (Unit, True);
+
+         Next_Unit := Get_Chain (Unit);
+         if Errorout.Nbr_Errors = 0 then
+            Set_Chain (Unit, Null_Iir);
+            Libraries.Add_Design_Unit_Into_Library (Unit);
+         end if;
+
+         Unit := Next_Unit;
+      end loop;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Errorout.Compilation_Error;
+      end if;
+   end Analyze_One_File;
+
+   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) is
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Analyze_One_File (Files (I).all);
+      end loop;
+
+      if Save_Library then
+         Libraries.Save_Work_Library;
+      end if;
+   end Analyze_Files;
+
+   procedure Perform_Action (Cmd : in out Command_Check_Syntax;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Analyze_Files (Args, False);
+   end Perform_Action;
+
+   --  Command --clean: remove object files.
+   type Command_Clean is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Clean) return String;
+   procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--clean";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Clean) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--clean            Remove generated files";
+   end Get_Short_Help;
+
+   procedure Delete (Str : String)
+   is
+      use Ada.Text_IO;
+      Status : Boolean;
+   begin
+      Delete_File (Str'Address, Status);
+      if Flag_Verbose and Status then
+         Put_Line ("delete " & Str (Str'First .. Str'Last - 1));
+      end if;
+   end Delete;
+
+   procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Name_Table;
+
+      procedure Delete_Asm_Obj (Str : String) is
+      begin
+         Delete (Str & Get_Object_Suffix.all & Nul);
+         Delete (Str & Asm_Suffix & Nul);
+      end Delete_Asm_Obj;
+
+      procedure Delete_Top_Unit (Str : String) is
+      begin
+         --  Delete elaboration file
+         Delete_Asm_Obj (Image (Libraries.Work_Directory) & Elab_Prefix & Str);
+
+         --  Delete file list.
+         Delete (Image (Libraries.Work_Directory) & Str & List_Suffix & Nul);
+
+         --  Delete executable.
+         Delete (Str & Nul);
+      end Delete_Top_Unit;
+
+      File : Iir_Design_File;
+      Design_Unit : Iir_Design_Unit;
+      Lib_Unit : Iir;
+      Str : String_Access;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--clean' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Flags.Bootstrap := True;
+      --  Load libraries.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      File := Get_Design_File_Chain (Libraries.Work_Library);
+      while File /= Null_Iir loop
+         --  Delete compiled file.
+         Str := Append_Suffix (Image (Get_Design_File_Filename (File)), "");
+         Delete_Asm_Obj (Str.all);
+         Free (Str);
+
+         Design_Unit := Get_First_Design_Unit (File);
+         while Design_Unit /= Null_Iir loop
+            Lib_Unit := Get_Library_Unit (Design_Unit);
+            case Get_Kind (Lib_Unit) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Configuration_Declaration =>
+                  Delete_Top_Unit (Image (Get_Identifier (Lib_Unit)));
+               when Iir_Kind_Architecture_Body =>
+                  Delete_Top_Unit
+                    (Image (Get_Entity_Identifier_Of_Architecture (Lib_Unit))
+                       & '-'
+                       & Image (Get_Identifier (Lib_Unit)));
+               when others =>
+                  null;
+            end case;
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Perform_Action;
+
+   --  Command --remove: remove object file and library file.
+   type Command_Remove is new Command_Clean with null record;
+   function Decode_Command (Cmd : Command_Remove; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Remove) return String;
+   procedure Perform_Action (Cmd : in out Command_Remove;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Remove; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--remove";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Remove) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--remove           Remove generated files and library file";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Remove; Args : Argument_List)
+   is
+      use Name_Table;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--remove' does not accept any argument");
+         raise Option_Error;
+      end if;
+      Perform_Action (Command_Clean (Cmd), Args);
+      Delete (Image (Libraries.Work_Directory)
+              & Back_End.Library_To_File_Name (Libraries.Work_Library)
+              & Nul);
+   end Perform_Action;
+
+   --  Command --copy: copy work library to current directory.
+   type Command_Copy is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Copy) return String;
+   procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--copy";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Copy) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--copy             Copy work library to current directory";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Name_Table;
+      use Libraries;
+
+      File : Iir_Design_File;
+      Dir : Name_Id;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--copy' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+      Dir := Work_Directory;
+      Work_Directory := Null_Identifier;
+      Libraries.Load_Work_Library;
+      Work_Directory := Dir;
+
+      Dir := Get_Library_Directory (Libraries.Work_Library);
+      if Dir = Name_Nil or else Dir = Files_Map.Get_Home_Directory then
+         Error ("cannot copy library on itself (use --remove first)");
+         raise Option_Error;
+      end if;
+
+      File := Get_Design_File_Chain (Libraries.Work_Library);
+      while File /= Null_Iir loop
+         --  Copy object files (if any).
+         declare
+            Basename : constant String :=
+              Get_Base_Name (Image (Get_Design_File_Filename (File)));
+            Src : String_Access;
+            Dst : String_Access;
+            Success : Boolean;
+            pragma Unreferenced (Success);
+         begin
+            Src := new String'(Image (Dir) & Basename & Get_Object_Suffix.all);
+            Dst := new String'(Basename & Get_Object_Suffix.all);
+            Copy_File (Src.all, Dst.all, Success, Overwrite, Full);
+            --  Be silent in case of error.
+            Free (Src);
+            Free (Dst);
+         end;
+         if Get_Design_File_Directory (File) = Name_Nil then
+            Set_Design_File_Directory (File, Dir);
+         end if;
+
+         File := Get_Chain (File);
+      end loop;
+      Libraries.Work_Directory := Name_Nil;
+      Libraries.Save_Work_Library;
+   end Perform_Action;
+
+   --  Command --disp-standard.
+   type Command_Disp_Standard is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Disp_Standard; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Disp_Standard) return String;
+   procedure Perform_Action (Cmd : in out Command_Disp_Standard;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Disp_Standard; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--disp-standard";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Disp_Standard) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--disp-standard    Disp std.standard in pseudo-vhdl";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Disp_Standard;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--disp-standard' does not accept any argument");
+         raise Option_Error;
+      end if;
+      Flags.Bootstrap := True;
+      Libraries.Load_Std_Library;
+      Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit);
+   end Perform_Action;
+
+   procedure Load_All_Libraries_And_Files
+   is
+      use Files_Map;
+      use Libraries;
+      use Errorout;
+
+      procedure Extract_Library_Clauses (Unit : Iir_Design_Unit)
+      is
+         Lib1 : Iir_Library_Declaration;
+         pragma Unreferenced (Lib1);
+         Ctxt_Item : Iir;
+      begin
+         --  Extract library clauses.
+         Ctxt_Item := Get_Context_Items (Unit);
+         while Ctxt_Item /= Null_Iir loop
+            if Get_Kind (Ctxt_Item) = Iir_Kind_Library_Clause then
+               Lib1 := Get_Library (Get_Identifier (Ctxt_Item),
+                                    Get_Location (Ctxt_Item));
+            end if;
+            Ctxt_Item := Get_Chain (Ctxt_Item);
+         end loop;
+      end Extract_Library_Clauses;
+
+      Lib : Iir_Library_Declaration;
+      Fe : Source_File_Entry;
+      File, Next_File : Iir_Design_File;
+      Unit, Next_Unit : Iir_Design_Unit;
+      Design_File : Iir_Design_File;
+
+      Old_Work : Iir_Library_Declaration;
+   begin
+      Lib := Std_Library;
+      Lib := Get_Chain (Lib);
+      Old_Work := Work_Library;
+      while Lib /= Null_Iir loop
+         --  Design units are always put in the work library.
+         Work_Library := Lib;
+
+         File := Get_Design_File_Chain (Lib);
+         while File /= Null_Iir loop
+            Next_File := Get_Chain (File);
+            Fe := Load_Source_File (Get_Design_File_Directory (File),
+                                    Get_Design_File_Filename (File));
+            if Fe = No_Source_File_Entry then
+               --  FIXME: should remove all the design file from the library.
+               null;
+            elsif Is_Eq (Get_File_Time_Stamp (Fe),
+                         Get_File_Time_Stamp (File))
+            then
+               --  File has not been modified.
+               --  Extract libraries.
+               --  Note: we can't parse it only, since we need to keep the
+               --    date.
+               Unit := Get_First_Design_Unit (File);
+               while Unit /= Null_Iir loop
+                  Load_Parse_Design_Unit (Unit, Null_Iir);
+                  Extract_Library_Clauses (Unit);
+                  Unit := Get_Chain (Unit);
+               end loop;
+            else
+               --  File has been modified.
+               --  Parse it.
+               Design_File := Load_File (Fe);
+
+               --  Exit now in case of parse error.
+               if Design_File = Null_Iir
+                 or else Nbr_Errors > 0
+               then
+                  raise Compilation_Error;
+               end if;
+
+               Unit := Get_First_Design_Unit (Design_File);
+               while Unit /= Null_Iir loop
+                  Extract_Library_Clauses (Unit);
+
+                  Next_Unit := Get_Chain (Unit);
+                  Set_Chain (Unit, Null_Iir);
+                  Add_Design_Unit_Into_Library (Unit);
+                  Unit := Next_Unit;
+               end loop;
+            end if;
+            File := Next_File;
+         end loop;
+         Lib := Get_Chain (Lib);
+      end loop;
+      Work_Library := Old_Work;
+   end Load_All_Libraries_And_Files;
+
+   procedure Check_No_Elab_Flag (Lib : Iir_Library_Declaration)
+   is
+      File : Iir_Design_File;
+      Unit : Iir_Design_Unit;
+   begin
+      File := Get_Design_File_Chain (Lib);
+      while File /= Null_Iir loop
+         Unit := Get_First_Design_Unit (File);
+         while Unit /= Null_Iir loop
+            if Get_Elab_Flag (Unit) then
+               raise Internal_Error;
+            end if;
+            Unit := Get_Chain (Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Check_No_Elab_Flag;
+
+   function Build_Dependence (Prim : String_Access; Sec : String_Access)
+     return Iir_List
+   is
+      procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List)
+      is
+         El : Iir_Design_File;
+         Depend_List : Iir_List;
+      begin
+         if Get_Elab_Flag (File) then
+            return;
+         end if;
+
+         Set_Elab_Flag (File, True);
+         Depend_List := Get_File_Dependence_List (File);
+         if Depend_List /= Null_Iir_List then
+            for I in Natural loop
+               El := Get_Nth_Element (Depend_List, I);
+               exit when El = Null_Iir;
+               Build_Dependence_List (El, List);
+            end loop;
+         end if;
+         Append_Element (List, File);
+      end Build_Dependence_List;
+
+      use Configuration;
+      use Name_Table;
+
+      Top : Iir;
+      Primary_Id : Name_Id;
+      Secondary_Id : Name_Id;
+
+      File : Iir_Design_File;
+      Unit : Iir;
+
+      Files_List : Iir_List;
+   begin
+      Check_No_Elab_Flag (Libraries.Work_Library);
+
+      Primary_Id := Get_Identifier (Prim.all);
+      if Sec /= null then
+         Secondary_Id := Get_Identifier (Sec.all);
+      else
+         Secondary_Id := Null_Identifier;
+      end if;
+
+      if True then
+         Load_All_Libraries_And_Files;
+      else
+         --  Re-parse modified files in order configure could find all design
+         --  units.
+         declare
+            use Files_Map;
+            Fe : Source_File_Entry;
+            Next_File : Iir_Design_File;
+            Design_File : Iir_Design_File;
+         begin
+            File := Get_Design_File_Chain (Libraries.Work_Library);
+            while File /= Null_Iir loop
+               Next_File := Get_Chain (File);
+               Fe := Load_Source_File (Get_Design_File_Directory (File),
+                                       Get_Design_File_Filename (File));
+               if Fe = No_Source_File_Entry then
+                  --  FIXME: should remove all the design file from
+                  --  the library.
+                  null;
+               else
+                  if not Is_Eq (Get_File_Time_Stamp (Fe),
+                                Get_File_Time_Stamp (File))
+                  then
+                     --  FILE has been modified.
+                     Design_File := Libraries.Load_File (Fe);
+                     if Design_File /= Null_Iir then
+                        Libraries.Add_Design_File_Into_Library (Design_File);
+                     end if;
+                  end if;
+               end if;
+               File := Next_File;
+            end loop;
+         end;
+      end if;
+
+      Flags.Flag_Elaborate := True;
+      Flags.Flag_Elaborate_With_Outdated := True;
+      Flag_Load_All_Design_Units := True;
+      Flag_Build_File_Dependence := True;
+
+      Top := Configure (Primary_Id, Secondary_Id);
+      if Top = Null_Iir then
+         --Error ("cannot find primary unit " & Prim.all);
+         raise Option_Error;
+      end if;
+
+      --  Add unused design units.
+      declare
+         N : Natural;
+      begin
+         N := Design_Units.First;
+         while N <= Design_Units.Last loop
+            Unit := Design_Units.Table (N);
+            N := N + 1;
+            File := Get_Design_File (Unit);
+            if not Get_Elab_Flag (File) then
+               Set_Elab_Flag (File, True);
+               Unit := Get_First_Design_Unit (File);
+               while Unit /= Null_Iir loop
+                  if not Get_Elab_Flag (Unit) then
+                     Add_Design_Unit (Unit, Null_Iir);
+                  end if;
+                  Unit := Get_Chain (Unit);
+               end loop;
+            end if;
+         end loop;
+      end;
+
+      --  Clear elab flag on design files.
+      for I in reverse Design_Units.First .. Design_Units.Last loop
+         Unit := Design_Units.Table (I);
+         File := Get_Design_File (Unit);
+         Set_Elab_Flag (File, False);
+      end loop;
+
+      --  Create a list of files, from the last to the first.
+      Files_List := Create_Iir_List;
+      for I in Design_Units.First .. Design_Units.Last loop
+         Unit := Design_Units.Table (I);
+         File := Get_Design_File (Unit);
+         Build_Dependence_List (File, Files_List);
+      end loop;
+
+      return Files_List;
+   end Build_Dependence;
+
+   --  Convert NAME to lower cases, unless it is an extended identifier.
+   function Convert_Name (Name : String_Access) return String_Access
+   is
+      use Name_Table;
+
+      function Is_Bad_Unit_Name return Boolean is
+      begin
+         if Name_Length = 0 then
+            return True;
+         end if;
+         --  Don't try to handle extended identifier.
+         if Name_Buffer (1) = '\' then
+            return False;
+         end if;
+         --  Look for suspicious characters.
+         --  Do not try to be exhaustive as the correct check will be done
+         --  by convert_identifier.
+         for I in 1 .. Name_Length loop
+            case Name_Buffer (I) is
+               when '.' | '/' | '\' =>
+                  return True;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         return False;
+      end Is_Bad_Unit_Name;
+
+      function Is_A_File_Name return Boolean is
+      begin
+         --  Check .vhd
+         if Name_Length > 4
+           and then Name_Buffer (Name_Length - 3 .. Name_Length) = ".vhd"
+         then
+            return True;
+         end if;
+         --  Check .vhdl
+         if Name_Length > 5
+           and then Name_Buffer (Name_Length - 4 .. Name_Length) = ".vhdl"
+         then
+            return True;
+         end if;
+         --  Check ../
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "../"
+         then
+            return True;
+         end if;
+         --  Check ..\
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "..\"
+         then
+            return True;
+         end if;
+         --  Should try to find the file ?
+         return False;
+      end Is_A_File_Name;
+   begin
+      Name_Length := Name'Length;
+      Name_Buffer (1 .. Name_Length) := Name.all;
+
+      --  Try to identifier bad names (such as file names), so that
+      --  friendly message can be displayed.
+      if Is_Bad_Unit_Name then
+         Errorout.Error_Msg_Option_NR ("bad unit name '" & Name.all & "'");
+         if Is_A_File_Name then
+            Errorout.Error_Msg_Option_NR
+              ("(a unit name is required instead of a filename)");
+         end if;
+         raise Option_Error;
+      end if;
+      Scanner.Convert_Identifier;
+      return new String'(Name_Buffer (1 .. Name_Length));
+   end Convert_Name;
+
+   procedure Extract_Elab_Unit
+     (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural)
+   is
+   begin
+      if Args'Length = 0 then
+         Error ("command '" & Cmd_Name & "' required an unit name");
+         raise Option_Error;
+      end if;
+
+      Prim_Name := Convert_Name (Args (Args'First));
+      Next_Arg := Args'First + 1;
+      Sec_Name := null;
+
+      if Args'Length >= 2 then
+         declare
+            Sec : constant String_Access := Args (Next_Arg);
+         begin
+            if Sec (Sec'First) /= '-' then
+               Sec_Name := Convert_Name (Sec);
+               Next_Arg := Args'First + 2;
+            end if;
+         end;
+      end if;
+   end Extract_Elab_Unit;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Import);
+      Register_Command (new Command_Check_Syntax);
+      Register_Command (new Command_Dir);
+      Register_Command (new Command_Find);
+      Register_Command (new Command_Clean);
+      Register_Command (new Command_Remove);
+      Register_Command (new Command_Copy);
+      Register_Command (new Command_Disp_Standard);
+   end Register_Commands;
+end Ghdllocal;
diff --git a/src/translate/ghdldrv/ghdllocal.ads b/src/translate/ghdldrv/ghdllocal.ads
new file mode 100644
index 000000000..2c7018adc
--- /dev/null
+++ b/src/translate/ghdldrv/ghdllocal.ads
@@ -0,0 +1,116 @@
+--  GHDL driver - local commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ghdlmain; use Ghdlmain;
+with Iirs; use Iirs;
+
+package Ghdllocal is
+   type Command_Lib is abstract new Command_Type with null record;
+
+   --  Setup GHDL.
+   procedure Init (Cmd : in out Command_Lib);
+
+   --  Handle:
+   --  --std=xx, --work=xx, -Pxxx, --workdir=x, --ieee=x, -Px, and -v
+   procedure Decode_Option (Cmd : in out Command_Lib;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   --  Disp detailled help.
+   procedure Disp_Long_Help (Cmd : Command_Lib);
+
+   --  Value of --PREFIX
+   Switch_Prefix_Path : String_Access := null;
+
+   --  getenv ("GHDL_PREFIX").  Set by Setup_Libraries.
+   Prefix_Env : String_Access := null;
+
+   --  Installation prefix (deduced from executable path).
+   Exec_Prefix : String_Access;
+
+   --  Path prefix for libraries.
+   Lib_Prefix_Path : String_Access := null;
+
+   --  Set with -v option.
+   Flag_Verbose : Boolean := False;
+
+   --  Suffix for asm files.
+   Asm_Suffix : constant String := ".s";
+
+   --  Suffix for llvm byte-code files.
+   Llvm_Suffix : constant String := ".bc";
+
+   --  Suffix for post files.
+   Post_Suffix : constant String := ".on";
+
+   --  Suffix for list files.
+   List_Suffix : constant String := ".lst";
+
+   --  Prefix for elab files.
+   Elab_Prefix : constant String := "e~";
+
+   Nul : constant Character := Character'Val (0);
+
+   --  Return FILENAME without the extension.
+   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
+                          return String;
+
+   --  Get the position of the last directory separator or 0 if none.
+   function Get_Basename_Pos (Pathname : String) return Natural;
+
+   function Append_Suffix (File : String; Suffix : String)
+                          return String_Access;
+
+   --  Return TRUE is UNIT can be at the apex of a design hierarchy.
+   function Is_Top_Entity (Unit : Iir) return Boolean;
+
+   --  Display the name of library unit UNIT.
+   procedure Disp_Library_Unit (Unit : Iir);
+
+   --  Translate vhdl version into a path element.
+   --  Used to search Std and IEEE libraries.
+   function Get_Version_Path return String;
+
+   -- Get Prefix_Path, but with 32 added if -m32 is requested
+   function Get_Machine_Path_Prefix return String;
+
+   --  Setup standard libaries path.  If LOAD is true, then load them now.
+   procedure Setup_Libraries (Load : Boolean);
+
+   --  Setup library, analyze FILES, and if SAVE_LIBRARY is set save the
+   --  work library only
+   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean);
+
+   --  Load and parse all libraries and files, starting from the work library.
+   --  The work library must already be loaded.
+   --  Raise errorout.compilation_error in case of error (parse error).
+   procedure Load_All_Libraries_And_Files;
+
+   function Build_Dependence (Prim : String_Access; Sec : String_Access)
+     return Iir_List;
+
+   Prim_Name : String_Access;
+   Sec_Name : String_Access;
+
+   --  Set PRIM_NAME and SEC_NAME.
+   procedure Extract_Elab_Unit
+     (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural);
+
+   procedure Register_Commands;
+end Ghdllocal;
diff --git a/src/translate/ghdldrv/ghdlmain.adb b/src/translate/ghdldrv/ghdlmain.adb
new file mode 100644
index 000000000..45d9615f9
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlmain.adb
@@ -0,0 +1,359 @@
+--  GHDL driver - main part.
+--  Copyright (C) 2002 - 2010 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 Ada.Text_IO;
+with Ada.Command_Line;
+with Version;
+with Bug;
+with Options;
+
+package body Ghdlmain is
+   procedure Init (Cmd : in out Command_Type)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      null;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Type;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Option);
+      pragma Unreferenced (Arg);
+   begin
+      Res := Option_Bad;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Type)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      Put_Line ("This command does not accept options.");
+   end Disp_Long_Help;
+
+   First_Cmd : Command_Acc := null;
+   Last_Cmd : Command_Acc := null;
+
+   procedure Register_Command (Cmd : Command_Acc) is
+   begin
+      if First_Cmd = null then
+         First_Cmd := Cmd;
+      else
+         Last_Cmd.Next := Cmd;
+      end if;
+      Last_Cmd := Cmd;
+   end Register_Command;
+
+   --  Find the command.
+   function Find_Command (Action : String) return Command_Acc
+   is
+      Cmd : Command_Acc;
+   begin
+      Cmd := First_Cmd;
+      while Cmd /= null loop
+         if Decode_Command (Cmd.all, Action) then
+            return Cmd;
+         end if;
+         Cmd := Cmd.Next;
+      end loop;
+      return null;
+   end Find_Command;
+
+   --  Command help.
+   type Command_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Help; Name : String) return Boolean;
+   procedure Decode_Option (Cmd : in out Command_Help;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   function Get_Short_Help (Cmd : Command_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Help; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Help; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-h" or else Name = "--help";
+   end Decode_Command;
+
+   procedure Decode_Option (Cmd : in out Command_Help;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Option);
+      pragma Unreferenced (Arg);
+   begin
+      Res := Option_End;
+   end Decode_Option;
+
+   function Get_Short_Help (Cmd : Command_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-h or --help [CMD] Disp this help or [help on CMD]";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Help; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Ada.Text_IO;
+      use Ada.Command_Line;
+      C : Command_Acc;
+   begin
+      if Args'Length = 0 then
+         Put_Line ("usage: " & Command_Name & " COMMAND [OPTIONS] ...");
+         Put_Line ("COMMAND is one of:");
+         C := First_Cmd;
+         while C /= null loop
+            Put_Line (Get_Short_Help (C.all));
+            C := C.Next;
+         end loop;
+         New_Line;
+         Put_Line ("To display the options of a GHDL program,");
+         Put_Line ("  run your program with the --help option.");
+         Put_Line ("Also see --options-help for analyzer options.");
+         New_Line;
+         Put_Line ("Please, refer to the GHDL manual for more information.");
+         Put_Line ("Report bugs on http://gna.org/projects/ghdl");
+      elsif Args'Length = 1 then
+         C := Find_Command (Args (1).all);
+         if C = null then
+            Error ("Command '" & Args (1).all & "' is unknown.");
+            raise Option_Error;
+         end if;
+         Put_Line (Get_Short_Help (C.all));
+         Disp_Long_Help (C.all);
+      else
+         Error ("Command '--help' accepts at most one argument.");
+         raise Option_Error;
+      end if;
+   end Perform_Action;
+
+   --  Command options help.
+   type Command_Option_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Option_Help; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Option_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Option_Help;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Option_Help; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--options-help";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Option_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--options-help     Disp help for analyzer options";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Option_Help;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error
+           ("warning: command '--option-help' does not accept any argument");
+      end if;
+      Options.Disp_Options_Help;
+   end Perform_Action;
+
+   --  Command Version
+   type Command_Version is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Version; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Version) return String;
+   procedure Perform_Action (Cmd : in out Command_Version;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Version; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-v" or Name = "--version";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Version) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-v or --version    Disp ghdl version";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Version;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      Put_Line (Version.Ghdl_Release);
+      Put_Line (" Compiled with " & Bug.Get_Gnat_Version);
+      if Version_String /= null then
+         Put (" ");
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("Written by Tristan Gingold.");
+      New_Line;
+      --  Display copyright.  Assume 80 cols terminal.
+      Put_Line ("Copyright (C) 2003 - 2014 Tristan Gingold.");
+      Put_Line ("GHDL is free software, covered by the "
+                & "GNU General Public License.  There is NO");
+      Put_Line ("warranty; not even for MERCHANTABILITY or"
+                & " FITNESS FOR A PARTICULAR PURPOSE.");
+      if Args'Length /= 0 then
+         Error ("warning: command '--version' does not accept any argument");
+      end if;
+   end Perform_Action;
+
+   --  Disp MSG on the standard output with the command name.
+   procedure Error (Msg : String)
+   is
+      use Ada.Command_Line;
+      use Ada.Text_IO;
+   begin
+      Put (Standard_Error, Command_Name);
+      Put (Standard_Error, ": ");
+      Put_Line (Standard_Error, Msg);
+      --Has_Error := True;
+   end Error;
+
+   procedure Main
+   is
+      use Ada.Command_Line;
+      Cmd : Command_Acc;
+      Arg_Index : Natural;
+      First_Arg : Natural;
+
+   begin
+      if Argument_Count = 0 then
+         Error ("missing command, try " & Command_Name & " --help");
+         raise Option_Error;
+      end if;
+
+      Cmd := Find_Command (Argument (1));
+      if Cmd = null then
+         Error ("unknown command '" & Argument (1) & "', try --help");
+         raise Option_Error;
+      end if;
+
+      Init (Cmd.all);
+
+      --  decode options.
+
+      First_Arg := 0;
+      Arg_Index := 2;
+      while Arg_Index <= Argument_Count loop
+         declare
+            Arg : constant String := Argument (Arg_Index);
+            Res : Option_Res;
+         begin
+            if Arg (1) = '-' then
+               --  Argument is an option.
+
+               if First_Arg > 0 then
+                  Error ("options after file");
+                  raise Option_Error;
+               end if;
+
+               Decode_Option (Cmd.all, Arg, "", Res);
+               case Res is
+                  when Option_Bad =>
+                     Error ("unknown option '" & Arg & "' for command '"
+                            & Argument (1) & "'");
+                     raise Option_Error;
+                  when Option_Ok =>
+                     Arg_Index := Arg_Index + 1;
+                  when Option_Arg_Req =>
+                     if Arg_Index + 1 > Argument_Count then
+                        Error ("option '" & Arg & "' requires an argument");
+                        raise Option_Error;
+                     end if;
+                     Decode_Option
+                       (Cmd.all, Arg, Argument (Arg_Index + 1), Res);
+                     if Res /= Option_Arg then
+                        raise Program_Error;
+                     end if;
+                     Arg_Index := Arg_Index + 2;
+                  when Option_Arg =>
+                     raise Program_Error;
+                  when Option_End =>
+                     First_Arg := Arg_Index;
+                     exit;
+               end case;
+            else
+               First_Arg := Arg_Index;
+               exit;
+            end if;
+         end;
+      end loop;
+
+      if First_Arg = 0 then
+         First_Arg := Argument_Count + 1;
+      end if;
+
+      declare
+         Args : Argument_List (1 .. Argument_Count - First_Arg + 1);
+      begin
+         for I in Args'Range loop
+            Args (I) := new String'(Argument (First_Arg + I - 1));
+         end loop;
+         Perform_Action (Cmd.all, Args);
+         for I in Args'Range loop
+            Free (Args (I));
+         end loop;
+      end;
+      --if Flags.Dump_Stats then
+      --   Name_Table.Disp_Stats;
+      --   Iirs.Disp_Stats;
+      --end if;
+      Set_Exit_Status (Success);
+   exception
+      when Option_Error
+        | Compile_Error
+        | Errorout.Compilation_Error =>
+         Set_Exit_Status (Failure);
+      when Exec_Error =>
+         Set_Exit_Status (3);
+      when E: others =>
+         Bug.Disp_Bug_Box (E);
+         Set_Exit_Status (2);
+   end Main;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Help);
+      Register_Command (new Command_Version);
+      Register_Command (new Command_Option_Help);
+   end Register_Commands;
+end Ghdlmain;
+
diff --git a/src/translate/ghdldrv/ghdlmain.ads b/src/translate/ghdldrv/ghdlmain.ads
new file mode 100644
index 000000000..c01f1d63e
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlmain.ads
@@ -0,0 +1,85 @@
+--  GHDL driver - main part.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+with Errorout;
+
+package Ghdlmain is
+   type Command_Type;
+
+   type Command_Acc is access all Command_Type'Class;
+
+   type Command_Type is abstract tagged record
+      Next : Command_Acc;
+   end record;
+
+   --  Return TRUE iff CMD handle action ACTION.
+   function Decode_Command (Cmd : Command_Type; Name : String) return Boolean
+     is abstract;
+
+   --  Initialize the command, before decoding actions.
+   procedure Init (Cmd : in out Command_Type);
+
+   --  Option_OK: OPTION is handled.
+   --  Option_Bad: OPTION is unknown.
+   --  Option_Arg_Req: OPTION requires an argument.  Must be set only when
+   --     ARG = "", the manager will recall Decode_Option.
+   --  Option_Arg: OPTION used the argument.
+   type Option_Res is
+     (Option_Bad, Option_Ok, Option_Arg, Option_Arg_Req, Option_End);
+   procedure Decode_Option (Cmd : in out Command_Type;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   --  Get a one-line help for the command.
+   function Get_Short_Help (Cmd : Command_Type) return String
+     is abstract;
+
+   --  Disp detailled help.
+   procedure Disp_Long_Help (Cmd : Command_Type);
+
+   --  Perform the action.
+   procedure Perform_Action (Cmd : in out Command_Type; Args : Argument_List)
+     is abstract;
+
+   --  Register a command.
+   procedure Register_Command (Cmd : Command_Acc);
+
+   --  Disp MSG on the standard output with the command name.
+   procedure Error (Msg : String);
+
+   --  May be raise by perform_action if the arguments are bad.
+   Option_Error : exception renames Errorout.Option_Error;
+
+   --  Action failed.
+   Compile_Error : exception;
+
+   --  Exec failed: either the program was not found, or failed.
+   Exec_Error : exception;
+
+   procedure Main;
+
+   --  Additionnal one-line message displayed by the --version command,
+   --  if defined.
+   --  Used to customize.
+   type String_Cst_Acc is access constant String;
+   Version_String : String_Cst_Acc := null;
+
+   --  Registers all commands in this package.
+   procedure Register_Commands;
+end Ghdlmain;
diff --git a/src/translate/ghdldrv/ghdlprint.adb b/src/translate/ghdldrv/ghdlprint.adb
new file mode 100644
index 000000000..45e70e118
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlprint.adb
@@ -0,0 +1,1757 @@
+--  GHDL driver - print commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ada.Characters.Latin_1;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Table;
+with Types; use Types;
+with Flags;
+with Name_Table; use Name_Table;
+with Files_Map;
+with Libraries;
+with Errorout; use Errorout;
+with Iirs; use Iirs;
+with Iirs_Utils; use Iirs_Utils;
+with Tokens;
+with Scanner;
+with Parse;
+with Version;
+with Xrefs;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with Disp_Vhdl;
+with Back_End;
+
+package body Ghdlprint is
+   type Html_Format_Type is (Html_2, Html_Css);
+   Html_Format : Html_Format_Type := Html_2;
+
+   procedure Put_Html (C : Character) is
+   begin
+      case C is
+         when '>' =>
+            Put ("&gt;");
+         when '<' =>
+            Put ("&lt;");
+         when '&' =>
+            Put ("&amp;");
+         when others =>
+            Put (C);
+      end case;
+   end Put_Html;
+
+   procedure Put_Html (S : String) is
+   begin
+      for I in S'Range loop
+         Put_Html (S (I));
+      end loop;
+   end Put_Html;
+
+   package Nat_IO is new Ada.Text_IO.Integer_IO (Num => Natural);
+   procedure Put_Nat (N : Natural) is
+   begin
+      Nat_IO.Put (N, Width => 0);
+   end Put_Nat;
+
+   type Filexref_Info_Type is record
+      Output : String_Acc;
+      Referenced : Boolean;
+   end record;
+   type Filexref_Info_Arr is array (Source_File_Entry range <>)
+     of Filexref_Info_Type;
+   type Filexref_Info_Arr_Acc is access Filexref_Info_Arr;
+   Filexref_Info : Filexref_Info_Arr_Acc := null;
+
+   --  If True, at least one xref is missing.
+   Missing_Xref : Boolean := False;
+
+   procedure PP_Html_File (File : Source_File_Entry)
+   is
+      use Flags;
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Line : Natural;
+      Buf : File_Buffer_Acc;
+      Prev_Tok : Token_Type;
+
+      --  Current logical column number.  Used to expand TABs.
+      Col : Natural;
+
+      --  Position just after the last token.
+      Last_Tok : Source_Ptr;
+
+      --  Position just before the current token.
+      Bef_Tok : Source_Ptr;
+
+      --  Position just after the current token.
+      Aft_Tok : Source_Ptr;
+
+      procedure Disp_Ln
+      is
+         N : Natural;
+         Str : String (1 .. 5);
+      begin
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font size=-1>");
+            when Html_Css =>
+               Put ("<i>");
+         end case;
+         N := Line;
+         for I in reverse Str'Range loop
+            if N = 0 then
+               Str (I) := ' ';
+            else
+               Str (I) := Character'Val (48 + N mod 10);
+               N := N / 10;
+            end if;
+         end loop;
+         Put (Str);
+         case Html_Format is
+            when Html_2 =>
+               Put ("</font>");
+            when Html_Css =>
+               Put ("</i>");
+         end case;
+         Put (" ");
+         Col := 0;
+      end Disp_Ln;
+
+      procedure Disp_Spaces
+      is
+         C : Character;
+         P : Source_Ptr;
+         N_Col : Natural;
+      begin
+         P := Last_Tok;
+         while P < Bef_Tok loop
+            C := Buf (P);
+            if C = HT then
+               --  Expand TABS.
+               N_Col := Col + 8;
+               N_Col := N_Col - N_Col mod 8;
+               while Col < N_Col loop
+                  Put (' ');
+                  Col := Col + 1;
+               end loop;
+            else
+               Put (' ');
+               Col := Col + 1;
+            end if;
+            P := P + 1;
+         end loop;
+      end Disp_Spaces;
+
+      procedure Disp_Text
+      is
+         P : Source_Ptr;
+      begin
+         P := Bef_Tok;
+         while P < Aft_Tok loop
+            Put_Html (Buf (P));
+            Col := Col + 1;
+            P := P + 1;
+         end loop;
+      end Disp_Text;
+
+      procedure Disp_Reserved is
+      begin
+         Disp_Spaces;
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font color=red>");
+               Disp_Text;
+               Put ("</font>");
+            when Html_Css =>
+               Put ("<em>");
+               Disp_Text;
+               Put ("</em>");
+         end case;
+      end Disp_Reserved;
+
+      procedure Disp_Href (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put (" href=""");
+         if L_File /= File then
+            --  External reference.
+            if Filexref_Info (L_File).Output /= null then
+               Put (Filexref_Info (L_File).Output.all);
+               Put ("#");
+               Put_Nat (Natural (L_Pos));
+            else
+               --  Reference to an unused file.
+               Put ("index.html#f");
+               Put_Nat (Natural (L_File));
+               Filexref_Info (L_File).Referenced := True;
+            end if;
+         else
+            --  Local reference.
+            Put ("#");
+            Put_Nat (Natural (L_Pos));
+         end if;
+         Put ("""");
+      end Disp_Href;
+
+      procedure Disp_Anchor (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Put (" name=""");
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put_Nat (Natural (L_Pos));
+         Put ("""");
+      end Disp_Anchor;
+
+      procedure Disp_Identifier
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Bod : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+            if Ref = Bad_Xref then
+               Disp_Text;
+               Warning_Msg_Sem ("cannot find xref", Loc);
+               Missing_Xref := True;
+               return;
+            end if;
+         else
+            Disp_Text;
+            return;
+         end if;
+         case Get_Xref_Kind (Ref) is
+            when Xref_Decl =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Decl := Get_Xref_Node (Ref);
+               case Get_Kind (Decl) is
+                  when Iir_Kind_Function_Declaration
+                    | Iir_Kind_Procedure_Declaration =>
+                     Bod := Get_Subprogram_Body (Decl);
+                  when Iir_Kind_Package_Declaration =>
+                     Bod := Get_Package_Body (Decl);
+                  when Iir_Kind_Type_Declaration =>
+                     Decl := Get_Type (Decl);
+                     case Get_Kind (Decl) is
+                        when Iir_Kind_Protected_Type_Declaration =>
+                           Bod := Get_Protected_Type_Body (Decl);
+                        when Iir_Kind_Incomplete_Type_Definition =>
+                           Bod := Get_Type_Declarator (Decl);
+                        when others =>
+                           Bod := Null_Iir;
+                     end case;
+                  when others =>
+                     Bod := Null_Iir;
+               end case;
+               if Bod /= Null_Iir then
+                  Disp_Href (Get_Location (Bod));
+               end if;
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+            when Xref_Ref
+              | Xref_End =>
+               Decl := Get_Xref_Node (Ref);
+               Loc := Get_Location (Decl);
+               if Loc /= Location_Nil then
+                  Put ("<a");
+                  Disp_Href (Loc);
+                  Put (">");
+                  Disp_Text;
+                  Put ("</a>");
+               else
+                  --  This may happen for overload list, in use clauses.
+                  Disp_Text;
+               end if;
+            when Xref_Body =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Disp_Href (Get_Location (Get_Xref_Node (Ref)));
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+         end case;
+      end Disp_Identifier;
+
+      procedure Disp_Attribute
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+         else
+            Ref := Bad_Xref;
+         end if;
+         if Ref = Bad_Xref then
+            case Html_Format is
+               when Html_2 =>
+                  Put ("<font color=orange>");
+                  Disp_Text;
+                  Put ("</font>");
+               when Html_Css =>
+                  Put ("<var>");
+                  Disp_Text;
+                  Put ("</var>");
+            end case;
+         else
+            Decl := Get_Xref_Node (Ref);
+            Loc := Get_Location (Decl);
+            Put ("<a");
+            Disp_Href (Loc);
+            Put (">");
+            Disp_Text;
+            Put ("</a>");
+         end if;
+      end Disp_Attribute;
+   begin
+      Scanner.Flag_Comment := True;
+      Scanner.Flag_Newline := True;
+
+      Set_File (File);
+      Buf := Get_File_Source (File);
+
+      Put_Line ("<pre>");
+      Line := 1;
+      Disp_Ln;
+      Last_Tok := Source_Ptr_Org;
+      Prev_Tok := Tok_Invalid;
+      loop
+         Scan;
+         Bef_Tok := Get_Token_Position;
+         Aft_Tok := Get_Position;
+         case Current_Token is
+            when Tok_Eof =>
+               exit;
+            when Tok_Newline =>
+               New_Line;
+               Line := Line + 1;
+               Disp_Ln;
+            when Tok_Comment =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=green>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<tt>");
+                     Disp_Text;
+                     Put ("</tt>");
+               end case;
+            when Tok_Access .. Tok_Elsif
+              | Tok_Entity .. Tok_With
+              | Tok_Mod .. Tok_Rem
+              | Tok_And .. Tok_Not =>
+               Disp_Reserved;
+            when Tok_End =>
+               Disp_Reserved;
+            when Tok_Semi_Colon =>
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_Xnor .. Tok_Ror =>
+               Disp_Reserved;
+            when Tok_Protected =>
+               Disp_Reserved;
+            when Tok_Across .. Tok_Tolerance =>
+               Disp_Reserved;
+            when Tok_Psl_Default
+              | Tok_Psl_Clock
+              | Tok_Psl_Property
+              | Tok_Psl_Sequence
+              | Tok_Psl_Endpoint
+              | Tok_Psl_Assert
+              | Tok_Psl_Cover
+              | Tok_Psl_Boolean
+              | Tok_Psl_Const
+              | Tok_Inf
+              | Tok_Within
+              | Tok_Abort
+              | Tok_Before
+              | Tok_Always
+              | Tok_Never
+              | Tok_Eventually
+              | Tok_Next_A
+              | Tok_Next_E
+              | Tok_Next_Event
+              | Tok_Next_Event_A
+              | Tok_Next_Event_E =>
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_String
+              | Tok_Bit_String
+              | Tok_Character =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=blue>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<kbd>");
+                     Disp_Text;
+                     Put ("</kbd>");
+               end case;
+            when Tok_Identifier =>
+               if Prev_Tok = Tok_Tick then
+                  Disp_Attribute;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_Left_Paren .. Tok_Colon
+              | Tok_Comma .. Tok_Dot
+              | Tok_Equal_Equal
+              | Tok_Integer
+              | Tok_Real
+              | Tok_Equal .. Tok_Slash
+              | Tok_Invalid =>
+               Disp_Spaces;
+               Disp_Text;
+         end case;
+         Last_Tok := Aft_Tok;
+         Prev_Tok := Current_Token;
+      end loop;
+      Close_File;
+      New_Line;
+      Put_Line ("</pre>");
+      Put_Line ("<hr/>");
+   end PP_Html_File;
+
+   procedure Put_Html_Header
+   is
+   begin
+      Put ("<html>");
+      Put_Line (" <head>");
+      case Html_Format is
+         when Html_2 =>
+            null;
+         when Html_Css =>
+            Put_Line (" <link rel=stylesheet type=""text/css""");
+            Put_Line ("  href=""ghdl.css"" title=""default""/>");
+      end case;
+      --Put_Line ("<?xml version=""1.0"" encoding=""utf-8"" ?>");
+      --Put_Line("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN""");
+      --Put_Line ("""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">");
+      --Put_Line ("<html xmlns=""http://www.w3.org/1999/xhtml"""
+      --         & " xml:lang=""en"">");
+      --Put_Line ("<head>");
+   end Put_Html_Header;
+
+   procedure Put_Css is
+   begin
+      Put_Line ("/* EM is used for reserved words */");
+      Put_Line ("EM { color : red; font-style: normal }");
+      New_Line;
+      Put_Line ("/* TT is used for comments */");
+      Put_Line ("TT { color : green; font-style: normal }");
+      New_Line;
+      Put_Line ("/* KBD is used for literals and strings */");
+      Put_Line ("KBD { color : blue; font-style: normal }");
+      New_Line;
+      Put_Line ("/* I is used for line numbers */");
+      Put_Line ("I { color : gray; font-size: 50% }");
+      New_Line;
+      Put_Line ("/* VAR is used for attributes name */");
+      Put_Line ("VAR { color : orange; font-style: normal }");
+      New_Line;
+      Put_Line ("/* A is used for identifiers.  */");
+      Put_Line ("A { color: blue; font-style: normal;");
+      Put_Line ("    text-decoration: none }");
+   end Put_Css;
+
+   procedure Put_Html_Foot
+   is
+   begin
+      Put_Line ("<p>");
+      Put ("<small>This page was generated using ");
+      Put ("<a href=""http://ghdl.free.fr"">");
+      Put (Version.Ghdl_Release);
+      Put ("</a>, a program written by");
+      Put (" Tristan Gingold");
+      New_Line;
+      Put_Line ("</p>");
+      Put_Line ("</body>");
+      Put_Line ("</html>");
+   end Put_Html_Foot;
+
+   function Create_Output_Filename (Name : String; Num : Natural)
+                                   return String_Acc
+   is
+      --  Position of the extension.  0 if none.
+      Ext_Pos : Natural;
+
+      Num_Str : String := Natural'Image (Num);
+   begin
+      --  Search for the extension.
+      Ext_Pos := 0;
+      for I in reverse Name'Range loop
+         exit when Name (I) = Directory_Separator;
+         if Name (I) = '.' then
+            Ext_Pos := I - 1;
+            exit;
+         end if;
+      end loop;
+      if Ext_Pos = 0 then
+         Ext_Pos := Name'Last;
+      end if;
+      Num_Str (1) := '.';
+      return new String'(Name (Name'First .. Ext_Pos) & Num_Str & ".html");
+   end Create_Output_Filename;
+
+   --  Command --chop.
+   type Command_Chop is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Chop) return String;
+   procedure Perform_Action (Cmd : in out Command_Chop;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--chop";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Chop) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--chop [OPTS] FILEs  Chop FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Chop; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Characters.Latin_1;
+
+      function Build_File_Name_Length (Lib : Iir) return Natural
+      is
+         Id : constant Name_Id := Get_Identifier (Lib);
+         Len : Natural;
+         Id1 : Name_Id;
+      begin
+         Len := Get_Name_Length (Id);
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Instantiation_Declaration =>
+               null;
+            when Iir_Kind_Package_Body =>
+               Len := Len + 1 + 4; -- add -body
+            when Iir_Kind_Architecture_Body =>
+               Id1 := Get_Entity_Identifier_Of_Architecture (Lib);
+               Len := Len + 1 + Get_Name_Length (Id1);
+            when others =>
+               Error_Kind ("build_file_name", Lib);
+         end case;
+         Len := Len + 1 + 4; --  add .vhdl
+         return Len;
+      end Build_File_Name_Length;
+
+      procedure Build_File_Name (Lib : Iir; Res : out String)
+      is
+         Id : constant Name_Id := Get_Identifier (Lib);
+         P : Natural;
+
+         procedure Append (Str : String) is
+         begin
+            Res (P + 1 .. P + Str'Length) := Str;
+            P := P + Str'Length;
+         end Append;
+      begin
+         P := Res'First - 1;
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Instantiation_Declaration =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when Iir_Kind_Package_Body =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-body");
+            when Iir_Kind_Architecture_Body =>
+               Image (Get_Entity_Identifier_Of_Architecture (Lib));
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-");
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when others =>
+               raise Internal_Error;
+         end case;
+         Append (".vhdl");
+      end Build_File_Name;
+
+      --  Scan source file BUF+START until end of line.
+      --  Return line kind to KIND and position of next line to NEXT.
+      type Line_Type is (Line_Blank, Line_Comment, Line_Text);
+      procedure Find_Eol (Buf : File_Buffer_Acc;
+                          Start : Source_Ptr;
+                          Next : out Source_Ptr;
+                          Kind : out Line_Type)
+      is
+         P : Source_Ptr;
+      begin
+         P := Start;
+
+         Kind := Line_Blank;
+
+         --  Skip blanks.
+         while Buf (P) = ' ' or Buf (P) = HT loop
+            P := P + 1;
+         end loop;
+
+         --  Skip comment if any.
+         if Buf (P) = '-' and Buf (P + 1) = '-' then
+            Kind := Line_Comment;
+            P := P + 2;
+         elsif Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT then
+            Kind := Line_Text;
+         end if;
+
+         --  Skip until end of line.
+         while Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT loop
+            P := P + 1;
+         end loop;
+
+         if Buf (P) = CR then
+            P := P + 1;
+            if Buf (P) = LF then
+               P := P + 1;
+            end if;
+         elsif Buf (P) = LF then
+            P := P + 1;
+            if Buf (P) = CR then
+               P := P + 1;
+            end if;
+         end if;
+
+         Next := P;
+      end Find_Eol;
+
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Lib : Iir;
+      Len : Natural;
+   begin
+      Flags.Bootstrap := True;
+      --  Load word library.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      --  First loop: parse source file, check destination file does not
+      --  exist.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File = Null_Iir then
+            raise Compile_Error;
+         end if;
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            Lib := Get_Library_Unit (Unit);
+            Len := Build_File_Name_Length (Lib);
+            declare
+               Filename : String (1 .. Len + 1);
+            begin
+               Build_File_Name (Lib, Filename);
+               Filename (Len + 1) := Ghdllocal.Nul;
+               if Is_Regular_File (Filename) then
+                  Error ("file '" & Filename (1 .. Len) & "' already exists");
+                  raise Compile_Error;
+               end if;
+               Put (Filename (1 .. Len));
+               Put ("  (for ");
+               Disp_Library_Unit (Lib);
+               Put (")");
+               New_Line;
+            end;
+            Unit := Get_Chain (Unit);
+         end loop;
+      end loop;
+
+      --  Second loop: do the real work.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         Unit := Get_First_Design_Unit (Design_File);
+         declare
+            use Files_Map;
+
+            File_Entry : Source_File_Entry;
+            Buffer : File_Buffer_Acc;
+
+            Start : Source_Ptr;
+            Lend : Source_Ptr;
+            First : Source_Ptr;
+            Next : Source_Ptr;
+            Kind : Line_Type;
+         begin
+            --  A design_file must have at least one design unit.
+            if Unit = Null_Iir then
+               raise Compile_Error;
+            end if;
+
+            Location_To_File_Pos
+              (Get_Location (Unit), File_Entry, Start);
+            Buffer := Get_File_Source (File_Entry);
+
+            First := Source_Ptr_Org;
+            if Get_Chain (Unit) /= Null_Iir then
+               --  If there is only one unit, then the whole file is written.
+               --  First last blank line.
+               Next := Source_Ptr_Org;
+               loop
+                  Start := Next;
+                  Find_Eol (Buffer, Start, Next, Kind);
+                  exit when Kind = Line_Text;
+                  if Kind = Line_Blank then
+                     First := Next;
+                  end if;
+               end loop;
+
+               --  FIXME: write header.
+            end if;
+
+            while Unit /= Null_Iir loop
+               Lib := Get_Library_Unit (Unit);
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               if Lend < First then
+                  raise Internal_Error;
+               end if;
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               --  Find the ';'.
+               while Buffer (Lend) /= ';' loop
+                  Lend := Lend + 1;
+               end loop;
+               Lend := Lend + 1;
+               --  Find end of line.
+               Find_Eol (Buffer, Lend, Next, Kind);
+               if Kind = Line_Text then
+                  --  There is another unit on the same line.
+                  Next := Lend;
+                  --  Skip blanks.
+                  while Buffer (Next) = ' ' or Buffer (Next) = HT loop
+                     Next := Next + 1;
+                  end loop;
+               else
+                  --  Find first blank line.
+                  loop
+                     Start := Next;
+                     Find_Eol (Buffer, Start, Next, Kind);
+                     exit when Kind /= Line_Comment;
+                  end loop;
+                  if Kind = Line_Text then
+                     --  There is not blank lines.
+                     --  All the comments are supposed to belong to the next
+                     --  unit.
+                     Find_Eol (Buffer, Lend, Next, Kind);
+                     Lend := Next;
+                  else
+                     Lend := Start;
+                  end if;
+               end if;
+
+               if Get_Chain (Unit) = Null_Iir then
+                  --  Last unit.
+                  --  Put the end of the file in it.
+                  Lend := Get_File_Length (File_Entry);
+               end if;
+
+               --  FIXME: file with only one unit.
+               --  FIXME: set extension.
+               Len := Build_File_Name_Length (Lib);
+               declare
+                  Filename : String (1 .. Len + 1);
+                  Fd : File_Descriptor;
+
+                  Wlen : Integer;
+               begin
+                  Build_File_Name (Lib, Filename);
+                  Filename (Len + 1) := Character'Val (0);
+                  Fd := Create_File (Filename, Binary);
+                  if Fd = Invalid_FD then
+                     Error
+                       ("cannot create file '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Wlen := Integer (Lend - First);
+                  if Write (Fd, Buffer (First)'Address, Wlen) /= Wlen then
+                     Error ("cannot write to '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Close (Fd);
+               end;
+               First := Next;
+
+               Unit := Get_Chain (Unit);
+            end loop;
+         end;
+      end loop;
+   end Perform_Action;
+
+   --  Command --lines.
+   type Command_Lines is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Lines) return String;
+   procedure Perform_Action (Cmd : in out Command_Lines;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--lines";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Lines) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--lines FILEs      Precede line with its number";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Lines; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+      Line : Natural;
+      File : Source_File_Entry;
+      Buf : File_Buffer_Acc;
+      Ptr : Source_Ptr;
+      Eptr : Source_Ptr;
+      C : Character;
+      N : Natural;
+      Log : Natural;
+      Str : String (1 .. 10);
+   begin
+      Local_Id := Get_Identifier ("");
+      for I in Args'Range loop
+         --  Load the file.
+         Id := Get_Identifier (Args (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Args (I).all);
+            raise Compile_Error;
+         end if;
+         Set_File (Fe);
+
+         --  Scan the content, to compute the number of lines.
+         loop
+            Scan;
+            exit when Current_Token = Tok_Eof;
+         end loop;
+         File := Get_Current_Source_File;
+         Line := Get_Current_Line;
+         Close_File;
+
+         --  Compute log10 of line.
+         N := Line;
+         Log := 0;
+         loop
+            N := N / 10;
+            Log := Log + 1;
+            exit when N = 0;
+         end loop;
+
+         --  Disp file name.
+         Put (Args (I).all);
+         Put (':');
+         New_Line;
+
+         Buf := Get_File_Source (File);
+         for J in 1 .. Line loop
+            Ptr := Line_To_Position (File, J);
+            exit when Ptr = Source_Ptr_Bad;
+            exit when Buf (Ptr) = Files_Map.EOT;
+
+            --  Disp line number.
+            N := J;
+            for K in reverse 1 .. Log loop
+               if N = 0 then
+                  Str (K) := ' ';
+               else
+                  Str (K) := Character'Val (48 + N mod 10);
+                  N := N / 10;
+               end if;
+            end loop;
+            Put (Str (1 .. Log));
+            Put (": ");
+
+            --  Search for end of line (or end of file).
+            Eptr := Ptr;
+            loop
+               C := Buf (Eptr);
+               exit when C = Files_Map.EOT or C = LF or C = CR;
+               Eptr := Eptr + 1;
+            end loop;
+
+            --  Disp line.
+            if Eptr > Ptr then
+               --  Avoid constraint error on conversion of nul array.
+               Put (String (Buf (Ptr .. Eptr - 1)));
+            end if;
+            New_Line;
+         end loop;
+      end loop;
+   end Perform_Action;
+
+   --  Command Reprint.
+   type Command_Reprint is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Reprint) return String;
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--reprint";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Reprint) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--reprint [OPTS] FILEs    Redisplay FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+
+      Id : Name_Id;
+      Next_Unit : Iir;
+   begin
+      Setup_Libraries (True);
+      Parse.Flag_Parse_Parenthesis := True;
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File = Null_Iir then
+            raise Errorout.Compilation_Error;
+         end if;
+
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            --  Analyze the design unit.
+            Back_End.Finish_Compilation (Unit, True);
+
+            Next_Unit := Get_Chain (Unit);
+            if Errorout.Nbr_Errors = 0 then
+               Disp_Vhdl.Disp_Vhdl (Unit);
+               Set_Chain (Unit, Null_Iir);
+               Libraries.Add_Design_Unit_Into_Library (Unit);
+            end if;
+
+            Unit := Next_Unit;
+         end loop;
+
+         if Errorout.Nbr_Errors > 0 then
+            raise Errorout.Compilation_Error;
+         end if;
+      end loop;
+   end Perform_Action;
+
+   --  Command compare tokens.
+   type Command_Compare_Tokens is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Compare_Tokens; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Compare_Tokens) return String;
+   procedure Perform_Action (Cmd : in out Command_Compare_Tokens;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Compare_Tokens; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--compare-tokens";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Compare_Tokens) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--compare-tokens [OPTS] REF FILEs    Compare FILEs with REF";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Compare_Tokens;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Tokens;
+      use Scanner;
+
+      package Ref_Tokens is new GNAT.Table
+        (Table_Component_Type => Token_Type,
+         Table_Index_Type => Integer,
+         Table_Low_Bound => 0,
+         Table_Initial => 1024,
+         Table_Increment => 100);
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+      Tok_Idx : Natural;
+   begin
+      if Args'Length < 1 then
+         Error ("missing ref file");
+         raise Compile_Error;
+      end if;
+
+      Local_Id := Get_Identifier ("");
+
+      for I in Args'Range loop
+         --  Load the file.
+         Id := Get_Identifier (Args (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Args (I).all);
+            raise Compile_Error;
+         end if;
+         Set_File (Fe);
+
+         if I = Args'First then
+            --  Scan ref file
+            loop
+               Scan;
+               Ref_Tokens.Append (Current_Token);
+               exit when Current_Token = Tok_Eof;
+            end loop;
+         else
+            --  Scane file
+            Tok_Idx := Ref_Tokens.First;
+            loop
+               Scan;
+               if Ref_Tokens.Table (Tok_Idx) /= Current_Token then
+                  Error_Msg_Parse ("token mismatch");
+                  exit;
+               end if;
+               case Current_Token is
+                  when Tok_Eof =>
+                     exit;
+                  when others =>
+                     null;
+               end case;
+               Tok_Idx := Tok_Idx + 1;
+            end loop;
+         end if;
+         Close_File;
+      end loop;
+
+      Ref_Tokens.Free;
+
+      if Nbr_Errors /= 0 then
+         raise Compilation_Error;
+      end if;
+   end Perform_Action;
+
+   --  Command html.
+   type Command_Html is abstract new Command_Lib with null record;
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Disp_Long_Help (Cmd : Command_Html);
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--format=css" then
+         Html_Format := Html_Css;
+         Res := Option_Ok;
+      elsif Option = "--format=html2" then
+         Html_Format := Html_2;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Html) is
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Put_Line ("--format=html2  Use FONT attributes");
+      Put_Line ("--format=css    Use ghdl.css file");
+   end Disp_Long_Help;
+
+   --  Command --pp-html.
+   type Command_PP_Html is new Command_Html with null record;
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_PP_Html) return String;
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List);
+
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--pp-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_PP_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--pp-html FILEs    Pretty-print FILEs in HTML";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+   begin
+      Local_Id := Get_Identifier ("");
+      Put_Html_Header;
+      Put_Line ("  <title>");
+      for I in Files'Range loop
+         Put ("    ");
+         Put_Line (Files (I).all);
+      end loop;
+      Put_Line ("  </title>");
+      Put_Line ("</head>");
+      New_Line;
+      Put_Line ("<body>");
+
+      for I in Files'Range loop
+         Id := Get_Identifier (Files (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Files (I).all);
+            raise Compile_Error;
+         end if;
+         Put ("  <h1>");
+         Put (Files (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Fe);
+      end loop;
+      Put_Html_Foot;
+   end Perform_Action;
+
+   --  Command --xref-html.
+   type Command_Xref_Html is new Command_Html with record
+      Output_Dir : String_Access := null;
+      Check_Missing : Boolean := False;
+   end record;
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String;
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html);
+
+   procedure Perform_Action (Cmd : in out Command_Xref_Html;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref-html FILEs  Display FILEs in HTML with xrefs";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-o" then
+         if Arg = "" then
+            Res := Option_Arg_Req;
+         else
+            Cmd.Output_Dir := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      elsif Option = "--check-missing" then
+         Cmd.Check_Missing := True;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Html (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html) is
+   begin
+      Disp_Long_Help (Command_Html (Cmd));
+      Put_Line ("-o DIR          Put generated files into DIR (def: html/)");
+      Put_Line ("--check-missing Fail if a reference is missing");
+      New_Line;
+      Put_Line ("When format is css, the CSS file 'ghdl.css' "
+                & "is never overwritten.");
+   end Disp_Long_Help;
+
+   procedure Analyze_Design_File_Units (File : Iir_Design_File)
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (File);
+      while Unit /= Null_Iir loop
+         case Get_Date_State (Unit) is
+            when Date_Extern
+              | Date_Disk =>
+               raise Internal_Error;
+            when Date_Parse =>
+               Libraries.Load_Design_Unit (Unit, Null_Iir);
+            when Date_Analyze =>
+               null;
+         end case;
+         Unit := Get_Chain (Unit);
+      end loop;
+   end Analyze_Design_File_Units;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref_Html; Files_Name : Argument_List)
+   is
+      use GNAT.Directory_Operations;
+
+      Id : Name_Id;
+      File : Source_File_Entry;
+
+      type File_Data is record
+         Fe : Source_File_Entry;
+         Design_File : Iir;
+         Output : String_Acc;
+      end record;
+      type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+      Files : File_Data_Array;
+      Output : File_Type;
+   begin
+      Xrefs.Init;
+      Flags.Flag_Xref := True;
+
+      --  Load work library.
+      Setup_Libraries (True);
+
+      if Cmd.Output_Dir = null then
+         Cmd.Output_Dir := new String'("html");
+      elsif Cmd.Output_Dir.all = "-" then
+         Cmd.Output_Dir := null;
+      end if;
+
+      --  Try to create the directory.
+      if Cmd.Output_Dir /= null
+        and then not Is_Directory (Cmd.Output_Dir.all)
+      then
+         declare
+         begin
+            Make_Dir (Cmd.Output_Dir.all);
+         exception
+            when Directory_Error =>
+               Error ("cannot create directory " & Cmd.Output_Dir.all);
+               return;
+         end;
+      end if;
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Get_Identifier (Files_Name (I).all);
+         File := Files_Map.Load_Source_File (Libraries.Local_Directory, Id);
+         if File = No_Source_File_Entry then
+            Error ("cannot open " & Image (Id));
+            return;
+         end if;
+         Files (I).Fe := File;
+         Files (I).Design_File := Libraries.Load_File (File);
+         if Files (I).Design_File = Null_Iir then
+            return;
+         end if;
+         Files (I).Output := Create_Output_Filename
+           (Base_Name (Files_Name (I).all), I);
+         if Is_Regular_File (Files (I).Output.all) then
+            --  Prevent overwrite.
+            null;
+         end if;
+         --  Put units in library.
+         Libraries.Add_Design_File_Into_Library (Files (I).Design_File);
+      end loop;
+
+      --  Analyze all files.
+      for I in Files'Range loop
+         Analyze_Design_File_Units (Files (I).Design_File);
+      end loop;
+
+      Xrefs.Sort_By_Location;
+
+      if False then
+         for I in 1 .. Xrefs.Get_Last_Xref loop
+            declare
+               use Xrefs;
+
+               procedure Put_Loc (L : Location_Type)
+               is
+                  use Files_Map;
+
+                  L_File : Source_File_Entry;
+                  L_Pos : Source_Ptr;
+               begin
+                  Files_Map.Location_To_File_Pos (L, L_File, L_Pos);
+                  Put_Nat (Natural (L_File));
+                  --Image (Get_File_Name (L_File));
+                  --Put (Name_Buffer (1 .. Name_Length));
+                  Put (":");
+                  Put_Nat (Natural (L_Pos));
+               end Put_Loc;
+            begin
+               Put_Loc (Get_Xref_Location (I));
+               case Get_Xref_Kind (I) is
+                  when Xref_Decl =>
+                     Put (" decl ");
+                     Put (Image (Get_Identifier (Get_Xref_Node (I))));
+                  when Xref_Ref =>
+                     Put (" use ");
+                     Put_Loc (Get_Location (Get_Xref_Node (I)));
+                  when Xref_End =>
+                     Put (" end ");
+                  when Xref_Body =>
+                     Put (" body ");
+               end case;
+               New_Line;
+            end;
+         end loop;
+      end if;
+
+      --  Create filexref_info.
+      Filexref_Info := new Filexref_Info_Arr
+        (No_Source_File_Entry .. Files_Map.Get_Last_Source_File_Entry);
+      Filexref_Info.all := (others => (Output => null,
+                                       Referenced => False));
+      for I in Files'Range loop
+         Filexref_Info (Files (I).Fe).Output := Files (I).Output;
+      end loop;
+
+      for I in Files'Range loop
+         if Cmd.Output_Dir /= null then
+            Create (Output, Out_File,
+                    Cmd.Output_Dir.all & Directory_Separator
+                    & Files (I).Output.all);
+
+            Set_Output (Output);
+         end if;
+
+         Put_Html_Header;
+         Put_Line ("  <title>");
+         Put_Html (Files_Name (I).all);
+         Put ("</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+
+         Put ("<h1>");
+         Put_Html (Files_Name (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Files (I).Fe);
+         Put_Html_Foot;
+
+         if Cmd.Output_Dir /= null then
+            Close (Output);
+         end if;
+      end loop;
+
+      --  Create indexes.
+      if Cmd.Output_Dir /= null then
+         Create (Output, Out_File,
+                 Cmd.Output_Dir.all & Directory_Separator & "index.html");
+         Set_Output (Output);
+
+         Put_Html_Header;
+         Put_Line ("  <title>Xrefs indexes</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+         Put_Line ("<p>list of files:");
+         Put_Line ("<ul>");
+         for I in Files'Range loop
+            Put ("<li>");
+            Put ("<a href=""");
+            Put (Files (I).Output.all);
+            Put (""">");
+            Put_Html (Files_Name (I).all);
+            Put ("</a>");
+            Put ("</li>");
+            New_Line;
+         end loop;
+         Put_Line ("</ul></p>");
+         Put_Line ("<hr>");
+
+         --  TODO: list of design units.
+
+         Put_Line ("<p>list of files referenced but not available:");
+         Put_Line ("<ul>");
+         for I in No_Source_File_Entry + 1 .. Filexref_Info'Last loop
+            if Filexref_Info (I).Output = null
+              and then Filexref_Info (I).Referenced
+            then
+               Put ("<li><a name=""f");
+               Put_Nat (Natural (I));
+               Put (""">");
+               Put_Html (Image (Files_Map.Get_File_Name (I)));
+               Put ("</a></li>");
+               New_Line;
+            end if;
+         end loop;
+         Put_Line ("</ul></p><hr>");
+         Put_Html_Foot;
+
+         Close (Output);
+      end if;
+
+      if Html_Format = Html_Css
+        and then Cmd.Output_Dir /= null
+      then
+         declare
+            Css_Filename : constant String :=
+              Cmd.Output_Dir.all & Directory_Separator & "ghdl.css";
+         begin
+            if not Is_Regular_File (Css_Filename & Nul) then
+               Create (Output, Out_File, Css_Filename);
+               Set_Output (Output);
+               Put_Css;
+               Close (Output);
+            end if;
+         end;
+      end if;
+
+      if Missing_Xref and Cmd.Check_Missing then
+         Error ("missing xrefs");
+         raise Compile_Error;
+      end if;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+
+   --  Command --xref
+   type Command_Xref is new Command_Lib with null record;
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Xref;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref FILEs  Generate xrefs";
+   end Get_Short_Help;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref; Files_Name : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Files_Map;
+
+      Id : Name_Id;
+      File : Source_File_Entry;
+
+      type File_Data is record
+         Fe : Source_File_Entry;
+         Design_File : Iir;
+      end record;
+      type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+      Files : File_Data_Array;
+   begin
+      --  Load work library.
+      Setup_Libraries (True);
+
+      Xrefs.Init;
+      Flags.Flag_Xref := True;
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Get_Identifier (Files_Name (I).all);
+         File := Load_Source_File (Libraries.Local_Directory, Id);
+         if File = No_Source_File_Entry then
+            Error ("cannot open " & Image (Id));
+            return;
+         end if;
+         Files (I).Fe := File;
+         Files (I).Design_File := Libraries.Load_File (File);
+         if Files (I).Design_File = Null_Iir then
+            return;
+         end if;
+         --  Put units in library.
+         --  Note: design_units stay while design_file get empty.
+         Libraries.Add_Design_File_Into_Library (Files (I).Design_File);
+      end loop;
+
+      --  Analyze all files.
+      for I in Files'Range loop
+         Analyze_Design_File_Units (Files (I).Design_File);
+      end loop;
+
+      Xrefs.Fix_End_Xrefs;
+      Xrefs.Sort_By_Node_Location;
+
+      for F in Files'Range loop
+
+         Put ("GHDL-XREF V0");
+
+         declare
+            use Xrefs;
+
+            Cur_Decl : Iir;
+            Cur_File : Source_File_Entry;
+
+            procedure Emit_Loc (Loc : Location_Type; C : Character)
+            is
+               L_File : Source_File_Entry;
+               L_Pos : Source_Ptr;
+               L_Line : Natural;
+               L_Off : Natural;
+            begin
+               Location_To_Coord (Loc, L_File, L_Pos, L_Line, L_Off);
+               --Put_Nat (Natural (L_File));
+               --Put (':');
+               Put_Nat (L_Line);
+               Put (C);
+               Put_Nat (L_Off);
+            end Emit_Loc;
+
+            procedure Emit_Decl (N : Iir)
+            is
+               Loc : Location_Type;
+               Loc_File : Source_File_Entry;
+               Loc_Pos : Source_Ptr;
+               C : Character;
+               Dir : Name_Id;
+            begin
+               New_Line;
+               Cur_Decl := N;
+               Loc := Get_Location (N);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File /= Cur_File then
+                  Cur_File := Loc_File;
+                  Put ("XFILE: ");
+                  Dir := Get_Source_File_Directory (Cur_File);
+                  if Dir /= Null_Identifier then
+                     Image (Dir);
+                     Put (Name_Buffer (1 .. Name_Length));
+                  end if;
+                  Image (Get_File_Name (Cur_File));
+                  Put (Name_Buffer (1 .. Name_Length));
+                  New_Line;
+               end if;
+
+               --  Letters:
+               --   b d fgh jk  no qr  uvwxyz
+               --     D   H JK MNO QR  U WXYZ
+               case Get_Kind (N) is
+                  when Iir_Kind_Type_Declaration =>
+                     C := 'T';
+                  when Iir_Kind_Subtype_Declaration =>
+                     C := 't';
+                  when Iir_Kind_Entity_Declaration =>
+                     C := 'E';
+                  when Iir_Kind_Architecture_Body =>
+                     C := 'A';
+                  when Iir_Kind_Library_Declaration =>
+                     C := 'L';
+                  when Iir_Kind_Package_Declaration =>
+                     C := 'P';
+                  when Iir_Kind_Package_Body =>
+                     C := 'B';
+                  when Iir_Kind_Function_Declaration =>
+                     C := 'F';
+                  when Iir_Kind_Procedure_Declaration =>
+                     C := 'p';
+                  when Iir_Kind_Interface_Signal_Declaration =>
+                     C := 's';
+                  when Iir_Kind_Signal_Declaration =>
+                     C := 'S';
+                  when Iir_Kind_Interface_Constant_Declaration =>
+                     C := 'c';
+                  when Iir_Kind_Constant_Declaration =>
+                     C := 'C';
+                  when Iir_Kind_Variable_Declaration =>
+                     C := 'V';
+                  when Iir_Kind_Element_Declaration =>
+                     C := 'e';
+                  when Iir_Kind_Iterator_Declaration =>
+                     C := 'i';
+                  when Iir_Kind_Attribute_Declaration =>
+                     C := 'a';
+                  when Iir_Kind_Enumeration_Literal =>
+                     C := 'l';
+                  when Iir_Kind_Component_Declaration =>
+                     C := 'm';
+                  when Iir_Kind_Component_Instantiation_Statement =>
+                     C := 'I';
+                  when Iir_Kind_Generate_Statement =>
+                     C := 'G';
+                  when others =>
+                     C := '?';
+               end case;
+               Emit_Loc (Loc, C);
+               --Disp_Tree.Disp_Iir_Address (N);
+               Put (' ');
+               case Get_Kind (N) is
+                  when Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body =>
+                     null;
+                  when others =>
+                     Image (Get_Identifier (N));
+                     Put (Name_Buffer (1 .. Name_Length));
+               end case;
+            end Emit_Decl;
+
+            procedure Emit_Ref (R : Xref; T : Character)
+            is
+               N : Iir;
+            begin
+               N := Get_Xref_Node (R);
+               if N /= Cur_Decl then
+                  Emit_Decl (N);
+               end if;
+               Put (' ');
+               Emit_Loc (Get_Xref_Location (R), T);
+            end Emit_Ref;
+
+            Loc : Location_Type;
+            Loc_File : Source_File_Entry;
+            Loc_Pos : Source_Ptr;
+         begin
+            Cur_Decl := Null_Iir;
+            Cur_File := No_Source_File_Entry;
+
+            for I in First_Xref .. Get_Last_Xref loop
+               Loc := Get_Xref_Location (I);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File = Files (F).Fe then
+                  --  This is a local location.
+                  case Get_Xref_Kind (I) is
+                     when Xref_Decl =>
+                        Emit_Decl (Get_Xref_Node (I));
+                     when Xref_End =>
+                        Emit_Ref (I, 'e');
+                     when Xref_Ref =>
+                        Emit_Ref (I, 'r');
+                     when Xref_Body =>
+                        Emit_Ref (I, 'b');
+                  end case;
+               end if;
+            end loop;
+            New_Line;
+         end;
+      end loop;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Chop);
+      Register_Command (new Command_Lines);
+      Register_Command (new Command_Reprint);
+      Register_Command (new Command_Compare_Tokens);
+      Register_Command (new Command_PP_Html);
+      Register_Command (new Command_Xref_Html);
+      Register_Command (new Command_Xref);
+   end Register_Commands;
+end Ghdlprint;
diff --git a/src/translate/ghdldrv/ghdlprint.ads b/src/translate/ghdldrv/ghdlprint.ads
new file mode 100644
index 000000000..82c3e6072
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlprint.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - print commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+package Ghdlprint is
+   procedure Register_Commands;
+end Ghdlprint;
diff --git a/src/translate/ghdldrv/ghdlrun.adb b/src/translate/ghdldrv/ghdlrun.adb
new file mode 100644
index 000000000..f6237214e
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlrun.adb
@@ -0,0 +1,661 @@
+--  GHDL driver - JIT commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Interfaces.C;
+
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with Ada.Unchecked_Conversion;
+with Ada.Command_Line;
+with Ada.Text_IO;
+
+with Ortho_Jit;
+with Ortho_Nodes; use Ortho_Nodes;
+with Interfaces;
+with System; use System;
+with Trans_Decls;
+with Iirs; use Iirs;
+with Flags;
+with Errorout; use Errorout;
+with Libraries;
+with Canon;
+with Trans_Be;
+with Translation;
+with Ieee.Std_Logic_1164;
+
+with Lists;
+with Str_Table;
+with Nodes;
+with Files_Map;
+with Name_Table;
+
+with Grt.Main;
+with Grt.Modules;
+with Grt.Lib;
+with Grt.Processes;
+with Grt.Rtis;
+with Grt.Files;
+with Grt.Signals;
+with Grt.Options;
+with Grt.Types;
+with Grt.Images;
+with Grt.Values;
+with Grt.Names;
+with Grt.Std_Logic_1164;
+
+with Ghdlcomp;
+with Foreigns;
+with Grtlink;
+
+package body Ghdlrun is
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode);
+
+   procedure Compile_Init (Analyze_Only : Boolean) is
+   begin
+      if Analyze_Only then
+         return;
+      end if;
+
+      Translation.Foreign_Hook := Foreign_Hook'Access;
+
+      --  FIXME: add a flag to force unnesting.
+      --  Translation.Flag_Unnest_Subprograms := True;
+
+      --  The design is always analyzed in whole.
+      Flags.Flag_Whole_Analyze := True;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+
+      Ortho_Jit.Init;
+
+      Translation.Initialize;
+      Canon.Canon_Flag_Add_Labels := True;
+   end Compile_Init;
+
+   procedure Compile_Elab
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
+   is
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
+      if Sec_Name = null then
+         Sec_Name := new String'("");
+      end if;
+
+      Flags.Flag_Elaborate := True;
+      Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True);
+
+      if Errorout.Nbr_Errors > 0 then
+         --  This may happen (bad entity for example).
+         raise Compilation_Error;
+      end if;
+   end Compile_Elab;
+
+   --  Set options.
+   --  This is a little bit over-kill: from C to Ada and then again to C...
+   procedure Set_Run_Options (Args : Argument_List)
+   is
+      use Interfaces.C;
+      use Grt.Options;
+      use Grt.Types;
+
+      function Malloc (Size : size_t) return Argv_Type;
+      pragma Import (C, Malloc);
+
+      function Strdup (Str : String) return Ghdl_C_String;
+      pragma Import (C, Strdup);
+--        is
+--           T : Grt.Types.String_Access;
+--        begin
+--           T := new String'(Str & Ghdllocal.Nul);
+--           return To_Ghdl_C_String (T.all'Address);
+--        end Strdup;
+   begin
+      Argc := 1 + Args'Length;
+      Argv := Malloc
+        (size_t (Argc * (Ghdl_C_String'Size / System.Storage_Unit)));
+      Argv (0) := Strdup (Ada.Command_Line.Command_Name & Ghdllocal.Nul);
+      Progname := Argv (0);
+      for I in Args'Range loop
+         Argv (1 + I - Args'First) := Strdup (Args (I).all & Ghdllocal.Nul);
+      end loop;
+   end Set_Run_Options;
+
+   procedure Ghdl_Elaborate;
+   pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   type Elaborate_Acc is access procedure;
+   pragma Convention (C, Elaborate_Acc);
+   Elaborate_Proc : Elaborate_Acc := null;
+
+   procedure Ghdl_Elaborate is
+   begin
+      --Ada.Text_IO.Put_Line (Standard_Error, "ghdl_elaborate");
+      Elaborate_Proc.all;
+   end Ghdl_Elaborate;
+
+   procedure Def (Decl : O_Dnode; Addr : Address)
+     renames Ortho_Jit.Set_Address;
+
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode)
+   is
+      use Translation;
+      Res : Address;
+   begin
+      case Info.Kind is
+         when Foreign_Vhpidirect =>
+            declare
+               Name : constant String :=
+                 Name_Table.Name_Buffer (Info.Subprg_First
+                                           .. Info.Subprg_Last);
+            begin
+               Res := Foreigns.Find_Foreign (Name);
+               if Res /= Null_Address then
+                  Def (Ortho, Res);
+               else
+                  Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'",
+                                 Decl);
+               end if;
+            end;
+         when Foreign_Intrinsic =>
+            Name_Table.Image (Get_Identifier (Decl));
+            declare
+               Name : constant String :=
+                 Name_Table.Name_Buffer (1 .. Name_Table.Name_Length);
+            begin
+               if Name = "untruncated_text_read" then
+                  Def (Ortho, Grt.Files.Ghdl_Untruncated_Text_Read'Address);
+               elsif Name = "control_simulation" then
+                  Def (Ortho, Grt.Lib.Ghdl_Control_Simulation'Address);
+               elsif Name = "get_resolution_limit" then
+                  Def (Ortho, Grt.Lib.Ghdl_Get_Resolution_Limit'Address);
+               else
+                  Error_Msg_Sem ("unknown foreign intrinsic '" & Name & "'",
+                                 Decl);
+               end if;
+            end;
+         when Foreign_Unknown =>
+            null;
+      end case;
+   end Foreign_Hook;
+
+   procedure Run
+   is
+      use Interfaces;
+      --use Ortho_Code.Binary;
+
+      function Conv is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Elaborate_Acc);
+      Err : Boolean;
+      Decl : O_Dnode;
+   begin
+      if Flag_Verbose then
+         Ada.Text_IO.Put_Line ("Linking in memory");
+      end if;
+
+      Def (Trans_Decls.Ghdl_Memcpy,
+           Grt.Lib.Ghdl_Memcpy'Address);
+      Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1,
+           Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address);
+      Def (Trans_Decls.Ghdl_Malloc0,
+           Grt.Lib.Ghdl_Malloc0'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_To_Boolean_Array,
+           Grt.Lib.Ghdl_Std_Ulogic_To_Boolean_Array'Address);
+
+      Def (Trans_Decls.Ghdl_Report,
+           Grt.Lib.Ghdl_Report'Address);
+      Def (Trans_Decls.Ghdl_Assert_Failed,
+           Grt.Lib.Ghdl_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Ieee_Assert_Failed,
+           Grt.Lib.Ghdl_Ieee_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Psl_Assert_Failed,
+           Grt.Lib.Ghdl_Psl_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Psl_Cover,
+           Grt.Lib.Ghdl_Psl_Cover'Address);
+      Def (Trans_Decls.Ghdl_Psl_Cover_Failed,
+           Grt.Lib.Ghdl_Psl_Cover_Failed'Address);
+      Def (Trans_Decls.Ghdl_Program_Error,
+           Grt.Lib.Ghdl_Program_Error'Address);
+      Def (Trans_Decls.Ghdl_Malloc,
+           Grt.Lib.Ghdl_Malloc'Address);
+      Def (Trans_Decls.Ghdl_Deallocate,
+           Grt.Lib.Ghdl_Deallocate'Address);
+      Def (Trans_Decls.Ghdl_Real_Exp,
+           Grt.Lib.Ghdl_Real_Exp'Address);
+      Def (Trans_Decls.Ghdl_Integer_Exp,
+           Grt.Lib.Ghdl_Integer_Exp'Address);
+
+      Def (Trans_Decls.Ghdl_Sensitized_Process_Register,
+           Grt.Processes.Ghdl_Sensitized_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Process_Register,
+           Grt.Processes.Ghdl_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Postponed_Sensitized_Process_Register,
+           Grt.Processes.Ghdl_Postponed_Sensitized_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Postponed_Process_Register,
+           Grt.Processes.Ghdl_Postponed_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Finalize_Register,
+           Grt.Processes.Ghdl_Finalize_Register'Address);
+
+      Def (Trans_Decls.Ghdl_Stack2_Allocate,
+           Grt.Processes.Ghdl_Stack2_Allocate'Address);
+      Def (Trans_Decls.Ghdl_Stack2_Mark,
+           Grt.Processes.Ghdl_Stack2_Mark'Address);
+      Def (Trans_Decls.Ghdl_Stack2_Release,
+           Grt.Processes.Ghdl_Stack2_Release'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Exit,
+           Grt.Processes.Ghdl_Process_Wait_Exit'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Suspend,
+           Grt.Processes.Ghdl_Process_Wait_Suspend'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Timeout,
+           Grt.Processes.Ghdl_Process_Wait_Timeout'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Set_Timeout,
+           Grt.Processes.Ghdl_Process_Wait_Set_Timeout'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Add_Sensitivity,
+           Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Close,
+           Grt.Processes.Ghdl_Process_Wait_Close'Address);
+
+      Def (Trans_Decls.Ghdl_Process_Add_Sensitivity,
+           Grt.Processes.Ghdl_Process_Add_Sensitivity'Address);
+
+      Def (Trans_Decls.Ghdl_Now,
+           Grt.Types.Current_Time'Address);
+
+      Def (Trans_Decls.Ghdl_Process_Add_Driver,
+           Grt.Signals.Ghdl_Process_Add_Driver'Address);
+      Def (Trans_Decls.Ghdl_Signal_Add_Direct_Driver,
+           Grt.Signals.Ghdl_Signal_Add_Direct_Driver'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Add_Source,
+           Grt.Signals.Ghdl_Signal_Add_Source'Address);
+      Def (Trans_Decls.Ghdl_Signal_In_Conversion,
+           Grt.Signals.Ghdl_Signal_In_Conversion'Address);
+      Def (Trans_Decls.Ghdl_Signal_Out_Conversion,
+           Grt.Signals.Ghdl_Signal_Out_Conversion'Address);
+      Def (Trans_Decls.Ghdl_Signal_Effective_Value,
+           Grt.Signals.Ghdl_Signal_Effective_Value'Address);
+      Def (Trans_Decls.Ghdl_Signal_Create_Resolution,
+           Grt.Signals.Ghdl_Signal_Create_Resolution'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Disconnect,
+           Grt.Signals.Ghdl_Signal_Disconnect'Address);
+      Def (Trans_Decls.Ghdl_Signal_Set_Disconnect,
+           Grt.Signals.Ghdl_Signal_Set_Disconnect'Address);
+      Def (Trans_Decls.Ghdl_Signal_Merge_Rti,
+           Grt.Signals.Ghdl_Signal_Merge_Rti'Address);
+      Def (Trans_Decls.Ghdl_Signal_Name_Rti,
+           Grt.Signals.Ghdl_Signal_Name_Rti'Address);
+      Def (Trans_Decls.Ghdl_Signal_Read_Port,
+           Grt.Signals.Ghdl_Signal_Read_Port'Address);
+      Def (Trans_Decls.Ghdl_Signal_Read_Driver,
+           Grt.Signals.Ghdl_Signal_Read_Driver'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Driving,
+           Grt.Signals.Ghdl_Signal_Driving'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_B1,
+           Grt.Signals.Ghdl_Signal_Driving_Value_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8,
+           Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_E32,
+           Grt.Signals.Ghdl_Signal_Driving_Value_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32,
+           Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64,
+           Grt.Signals.Ghdl_Signal_Driving_Value_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_F64,
+           Grt.Signals.Ghdl_Signal_Driving_Value_F64'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Create_Guard,
+           Grt.Signals.Ghdl_Signal_Create_Guard'Address);
+      Def (Trans_Decls.Ghdl_Signal_Guard_Dependence,
+           Grt.Signals.Ghdl_Signal_Guard_Dependence'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_Error'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Start_Assign_Error'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Next_Assign_Error'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null,
+           Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Direct_Assign,
+           Grt.Signals.Ghdl_Signal_Direct_Assign'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_B1,
+           Grt.Signals.Ghdl_Create_Signal_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_B1,
+           Grt.Signals.Ghdl_Signal_Init_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Start_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Next_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_B1,
+           Grt.Signals.Ghdl_Signal_Associate_B1'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_E8,
+           Grt.Signals.Ghdl_Create_Signal_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_E8,
+           Grt.Signals.Ghdl_Signal_Init_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Start_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Next_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_E8,
+           Grt.Signals.Ghdl_Signal_Associate_E8'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_E32,
+           Grt.Signals.Ghdl_Create_Signal_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_E32,
+           Grt.Signals.Ghdl_Signal_Init_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Start_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_E32,
+           Grt.Signals.Ghdl_Signal_Associate_E32'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_I32,
+           Grt.Signals.Ghdl_Create_Signal_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_I32,
+           Grt.Signals.Ghdl_Signal_Init_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Start_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Next_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_I32,
+           Grt.Signals.Ghdl_Signal_Associate_I32'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_I64,
+           Grt.Signals.Ghdl_Create_Signal_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_I64,
+           Grt.Signals.Ghdl_Signal_Init_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Start_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Next_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_I64,
+           Grt.Signals.Ghdl_Signal_Associate_I64'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_F64,
+           Grt.Signals.Ghdl_Create_Signal_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_F64,
+           Grt.Signals.Ghdl_Signal_Init_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Start_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Next_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_F64,
+           Grt.Signals.Ghdl_Signal_Associate_F64'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Attribute_Register_Prefix,
+           Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix'Address);
+      Def (Trans_Decls.Ghdl_Create_Stable_Signal,
+           Grt.Signals.Ghdl_Create_Stable_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Quiet_Signal,
+           Grt.Signals.Ghdl_Create_Quiet_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Transaction_Signal,
+           Grt.Signals.Ghdl_Create_Transaction_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Delayed_Signal,
+           Grt.Signals.Ghdl_Create_Delayed_Signal'Address);
+
+      Def (Trans_Decls.Ghdl_Rti_Add_Package,
+           Grt.Rtis.Ghdl_Rti_Add_Package'Address);
+      Def (Trans_Decls.Ghdl_Rti_Add_Top,
+           Grt.Rtis.Ghdl_Rti_Add_Top'Address);
+
+      Def (Trans_Decls.Ghdl_Protected_Enter,
+           Grt.Processes.Ghdl_Protected_Enter'Address);
+      Def (Trans_Decls.Ghdl_Protected_Leave,
+           Grt.Processes.Ghdl_Protected_Leave'Address);
+      Def (Trans_Decls.Ghdl_Protected_Init,
+           Grt.Processes.Ghdl_Protected_Init'Address);
+      Def (Trans_Decls.Ghdl_Protected_Fini,
+           Grt.Processes.Ghdl_Protected_Fini'Address);
+
+      Def (Trans_Decls.Ghdl_Text_File_Elaborate,
+           Grt.Files.Ghdl_Text_File_Elaborate'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Finalize,
+           Grt.Files.Ghdl_Text_File_Finalize'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Open,
+           Grt.Files.Ghdl_Text_File_Open'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Open_Status,
+           Grt.Files.Ghdl_Text_File_Open_Status'Address);
+      Def (Trans_Decls.Ghdl_Text_Write,
+           Grt.Files.Ghdl_Text_Write'Address);
+      Def (Trans_Decls.Ghdl_Text_Read_Length,
+           Grt.Files.Ghdl_Text_Read_Length'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Close,
+           Grt.Files.Ghdl_Text_File_Close'Address);
+
+      Def (Trans_Decls.Ghdl_File_Elaborate,
+           Grt.Files.Ghdl_File_Elaborate'Address);
+      Def (Trans_Decls.Ghdl_File_Finalize,
+           Grt.Files.Ghdl_File_Finalize'Address);
+      Def (Trans_Decls.Ghdl_File_Open,
+           Grt.Files.Ghdl_File_Open'Address);
+      Def (Trans_Decls.Ghdl_File_Open_Status,
+           Grt.Files.Ghdl_File_Open_Status'Address);
+      Def (Trans_Decls.Ghdl_File_Close,
+           Grt.Files.Ghdl_File_Close'Address);
+      Def (Trans_Decls.Ghdl_File_Flush,
+           Grt.Files.Ghdl_File_Flush'Address);
+      Def (Trans_Decls.Ghdl_Write_Scalar,
+           Grt.Files.Ghdl_Write_Scalar'Address);
+      Def (Trans_Decls.Ghdl_Read_Scalar,
+           Grt.Files.Ghdl_Read_Scalar'Address);
+
+      Def (Trans_Decls.Ghdl_File_Endfile,
+           Grt.Files.Ghdl_File_Endfile'Address);
+
+      Def (Trans_Decls.Ghdl_Image_B1,
+           Grt.Images.Ghdl_Image_B1'Address);
+      Def (Trans_Decls.Ghdl_Image_E8,
+           Grt.Images.Ghdl_Image_E8'Address);
+      Def (Trans_Decls.Ghdl_Image_E32,
+           Grt.Images.Ghdl_Image_E32'Address);
+      Def (Trans_Decls.Ghdl_Image_I32,
+           Grt.Images.Ghdl_Image_I32'Address);
+      Def (Trans_Decls.Ghdl_Image_F64,
+           Grt.Images.Ghdl_Image_F64'Address);
+      Def (Trans_Decls.Ghdl_Image_P64,
+           Grt.Images.Ghdl_Image_P64'Address);
+      Def (Trans_Decls.Ghdl_Image_P32,
+           Grt.Images.Ghdl_Image_P32'Address);
+
+      Def (Trans_Decls.Ghdl_Value_B1,
+           Grt.Values.Ghdl_Value_B1'Address);
+      Def (Trans_Decls.Ghdl_Value_E8,
+           Grt.Values.Ghdl_Value_E8'Address);
+      Def (Trans_Decls.Ghdl_Value_E32,
+           Grt.Values.Ghdl_Value_E32'Address);
+      Def (Trans_Decls.Ghdl_Value_I32,
+           Grt.Values.Ghdl_Value_I32'Address);
+      Def (Trans_Decls.Ghdl_Value_F64,
+           Grt.Values.Ghdl_Value_F64'Address);
+      Def (Trans_Decls.Ghdl_Value_P32,
+           Grt.Values.Ghdl_Value_P32'Address);
+      Def (Trans_Decls.Ghdl_Value_P64,
+           Grt.Values.Ghdl_Value_P64'Address);
+
+      Def (Trans_Decls.Ghdl_Get_Path_Name,
+           Grt.Names.Ghdl_Get_Path_Name'Address);
+      Def (Trans_Decls.Ghdl_Get_Instance_Name,
+           Grt.Names.Ghdl_Get_Instance_Name'Address);
+
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Eq,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Eq'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Ne,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Ne'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Lt,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Lt'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Le,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Le'Address);
+
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Array_Match_Eq,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Array_Match_Eq'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Array_Match_Ne,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Array_Match_Ne'Address);
+
+      Def (Trans_Decls.Ghdl_To_String_I32,
+           Grt.Images.Ghdl_To_String_I32'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64,
+           Grt.Images.Ghdl_To_String_F64'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64_Digits,
+           Grt.Images.Ghdl_To_String_F64_Digits'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64_Format,
+           Grt.Images.Ghdl_To_String_F64_Format'Address);
+      Def (Trans_Decls.Ghdl_To_String_B1,
+           Grt.Images.Ghdl_To_String_B1'Address);
+      Def (Trans_Decls.Ghdl_To_String_E8,
+           Grt.Images.Ghdl_To_String_E8'Address);
+      Def (Trans_Decls.Ghdl_To_String_E32,
+           Grt.Images.Ghdl_To_String_E32'Address);
+      Def (Trans_Decls.Ghdl_To_String_Char,
+           Grt.Images.Ghdl_To_String_Char'Address);
+      Def (Trans_Decls.Ghdl_To_String_P32,
+           Grt.Images.Ghdl_To_String_P32'Address);
+      Def (Trans_Decls.Ghdl_To_String_P64,
+           Grt.Images.Ghdl_To_String_P64'Address);
+      Def (Trans_Decls.Ghdl_Time_To_String_Unit,
+           Grt.Images.Ghdl_Time_To_String_Unit'Address);
+      Def (Trans_Decls.Ghdl_BV_To_Ostring,
+           Grt.Images.Ghdl_BV_To_Ostring'Address);
+      Def (Trans_Decls.Ghdl_BV_To_Hstring,
+           Grt.Images.Ghdl_BV_To_Hstring'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_B1,
+           Grt.Images.Ghdl_Array_Char_To_String_B1'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_E8,
+           Grt.Images.Ghdl_Array_Char_To_String_E8'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_E32,
+           Grt.Images.Ghdl_Array_Char_To_String_E32'Address);
+
+      Ortho_Jit.Link (Err);
+      if Err then
+         raise Compile_Error;
+      end if;
+
+      Grtlink.Std_Standard_Boolean_RTI_Ptr :=
+        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
+      Grtlink.Std_Standard_Bit_RTI_Ptr :=
+        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
+      if Ieee.Std_Logic_1164.Resolved /= Null_Iir then
+         Decl := Translation.Get_Resolv_Ortho_Decl
+           (Ieee.Std_Logic_1164.Resolved);
+         if Decl /= O_Dnode_Null then
+            Grtlink.Ieee_Std_Logic_1164_Resolved_Resolv_Ptr :=
+              Ortho_Jit.Get_Address (Decl);
+         end if;
+      end if;
+
+      Grtlink.Flag_String := Flags.Flag_String;
+
+      Elaborate_Proc :=
+        Conv (Ortho_Jit.Get_Address (Trans_Decls.Ghdl_Elaborate));
+
+      Ortho_Jit.Finish;
+
+      Translation.Finalize;
+      Lists.Initialize;
+      Str_Table.Initialize;
+      Nodes.Initialize;
+      Files_Map.Initialize;
+      Name_Table.Initialize;
+
+      if Flag_Verbose then
+         Ada.Text_IO.Put_Line ("Starting simulation");
+      end if;
+
+      Grt.Main.Run;
+      --V := Ghdl_Main (1, Gnat_Argv);
+   end Run;
+
+
+   --  Command run help.
+   type Command_Run_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Run_Help; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Run_Help;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run_Help; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--run-help";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--run-help         Disp help for RUNOPTS options";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Run_Help;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      if Args'Length /= 0 then
+         Error
+           ("warning: command '--run-help' does not accept any argument");
+      end if;
+      Put_Line ("These options can only be placed at [RUNOPTS]");
+      --  Register modules, since they add commands.
+      Grt.Modules.Register_Modules;
+      --  Bypass usual help header.
+      Grt.Options.Argc := 0;
+      Grt.Options.Help;
+   end Perform_Action;
+
+   procedure Register_Commands
+   is
+   begin
+      Ghdlcomp.Hooks := (Compile_Init'Access,
+                         Compile_Elab'Access,
+                         Set_Run_Options'Access,
+                         Run'Access,
+                         Ortho_Jit.Decode_Option'Access,
+                         Ortho_Jit.Disp_Help'Access);
+      Ghdlcomp.Register_Commands;
+      Register_Command (new Command_Run_Help);
+      Trans_Be.Register_Translation_Back_End;
+   end Register_Commands;
+end Ghdlrun;
diff --git a/src/translate/ghdldrv/ghdlrun.ads b/src/translate/ghdldrv/ghdlrun.ads
new file mode 100644
index 000000000..07095bd5d
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlrun.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - JIT commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+package Ghdlrun is
+   procedure Register_Commands;
+end Ghdlrun;
diff --git a/src/translate/ghdldrv/ghdlsimul.adb b/src/translate/ghdldrv/ghdlsimul.adb
new file mode 100644
index 000000000..17cece726
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlsimul.adb
@@ -0,0 +1,209 @@
+--  GHDL driver - simulator commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ada.Text_IO;
+with Ada.Command_Line;
+
+with Ghdllocal; use Ghdllocal;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with Types;
+with Iirs; use Iirs;
+with Flags;
+with Back_End;
+with Name_Table;
+with Errorout; use Errorout;
+with Std_Package;
+with Libraries;
+with Canon;
+with Configuration;
+with Iirs_Utils;
+with Annotations;
+with Elaboration;
+with Sim_Be;
+with Simulation;
+with Execution;
+
+with Ghdlcomp;
+
+with Grt.Vpi;
+pragma Unreferenced (Grt.Vpi);
+with Grt.Types;
+with Grt.Options;
+with Grtlink;
+
+package body Ghdlsimul is
+
+   --  FIXME: reuse simulation.top_config
+   Top_Conf : Iir;
+
+   procedure Compile_Init (Analyze_Only : Boolean) is
+   begin
+      if Analyze_Only then
+         return;
+      end if;
+
+      -- Initialize.
+      Back_End.Finish_Compilation := Sim_Be.Finish_Compilation'Access;
+      Back_End.Sem_Foreign := null;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+
+      -- Here, time_base can be set.
+      Annotations.Annotate (Std_Package.Std_Standard_Unit);
+
+      Canon.Canon_Flag_Add_Labels := True;
+      Canon.Canon_Flag_Sequentials_Stmts := True;
+      Canon.Canon_Flag_Expressions := True;
+      Canon.Canon_Flag_All_Sensitivity := True;
+   end Compile_Init;
+
+   procedure Compile_Elab
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
+   is
+      use Name_Table;
+      use Types;
+
+      First_Id : Name_Id;
+      Sec_Id : Name_Id;
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
+
+      Flags.Flag_Elaborate := True;
+      -- Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True);
+
+      if Errorout.Nbr_Errors > 0 then
+         --  This may happen (bad entity for example).
+         raise Compilation_Error;
+      end if;
+
+      First_Id := Get_Identifier (Prim_Name.all);
+      if Sec_Name = null then
+         Sec_Id := Null_Identifier;
+      else
+         Sec_Id := Get_Identifier (Sec_Name.all);
+      end if;
+      Top_Conf := Configuration.Configure (First_Id, Sec_Id);
+      if Top_Conf = Null_Iir then
+         raise Compilation_Error;
+      end if;
+
+      --  Check (and possibly abandon) if entity can be at the top of the
+      --  hierarchy.
+      declare
+         Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf);
+         Arch : constant Iir :=
+           Get_Block_Specification (Get_Block_Configuration (Conf_Unit));
+         Entity : constant Iir := Iirs_Utils.Get_Entity (Arch);
+      begin
+         Configuration.Check_Entity_Declaration_Top (Entity);
+         if Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+      end;
+   end Compile_Elab;
+
+   --  Set options.
+   procedure Set_Run_Options (Args : Argument_List)
+   is
+      use Grt.Options;
+      use Types;
+      Arg : String_Access;
+      Status : Decode_Option_Status;
+      Argv0 : String_Acc;
+   begin
+      --  Set progname (used for grt error messages)
+      Argv0 := new String'(Ada.Command_Line.Command_Name & ASCII.Nul);
+      Grt.Options.Progname := Grt.Types.To_Ghdl_C_String (Argv0.all'Address);
+
+      for I in Args'Range loop
+         Arg := Args (I);
+         if Arg.all = "--disp-tree" then
+            Simulation.Disp_Tree := True;
+         elsif Arg.all = "--expect-failure" then
+            Decode_Option (Arg.all, Status);
+            pragma Assert (Status = Decode_Option_Ok);
+         elsif Arg.all = "--trace-elab" then
+            Elaboration.Trace_Elaboration := True;
+         elsif Arg.all = "--trace-drivers" then
+            Elaboration.Trace_Drivers := True;
+         elsif Arg.all = "--trace-annotation" then
+            Annotations.Trace_Annotation := True;
+         elsif Arg.all = "--trace-simu" then
+            Simulation.Trace_Simulation := True;
+         elsif Arg.all = "--trace-stmt" then
+            Execution.Trace_Statements := True;
+         elsif Arg.all = "--stats" then
+            Simulation.Disp_Stats := True;
+         elsif Arg.all = "-i" then
+            Simulation.Flag_Interractive := True;
+         else
+            Decode_Option (Arg.all, Status);
+            case Status is
+               when Decode_Option_Last =>
+                  exit;
+               when Decode_Option_Help =>
+                  --  FIXME: is that correct ?
+                  exit;
+               when Decode_Option_Ok =>
+                  null;
+            end case;
+            --  Ghdlmain.Error ("unknown run options '" & Arg.all & "'");
+            --  raise Option_Error;
+         end if;
+      end loop;
+   end Set_Run_Options;
+
+   procedure Run is
+   begin
+      Grtlink.Flag_String := Flags.Flag_String;
+
+      Simulation.Simulation_Entity (Top_Conf);
+   end Run;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+   begin
+      if Option = "--debug" then
+         Simulation.Flag_Debugger := True;
+      else
+         return False;
+      end if;
+      return True;
+   end Decode_Option;
+
+   procedure Disp_Long_Help
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line (" --debug        Run with debugger");
+   end Disp_Long_Help;
+
+   procedure Register_Commands
+   is
+   begin
+      Ghdlcomp.Hooks := (Compile_Init'Access,
+                         Compile_Elab'Access,
+                         Set_Run_Options'Access,
+                         Run'Access,
+                         Decode_Option'Access,
+                         Disp_Long_Help'Access);
+      Ghdlcomp.Register_Commands;
+   end Register_Commands;
+end Ghdlsimul;
diff --git a/src/translate/ghdldrv/ghdlsimul.ads b/src/translate/ghdldrv/ghdlsimul.ads
new file mode 100644
index 000000000..264cbf8c6
--- /dev/null
+++ b/src/translate/ghdldrv/ghdlsimul.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - simulator commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+package Ghdlsimul is
+   procedure Register_Commands;
+end Ghdlsimul;
diff --git a/src/translate/ghdldrv/grtlink.ads b/src/translate/ghdldrv/grtlink.ads
new file mode 100644
index 000000000..4b3951e78
--- /dev/null
+++ b/src/translate/ghdldrv/grtlink.ads
@@ -0,0 +1,39 @@
+--  GHDL driver - shared variables with grt.
+--  Copyright (C) 2011 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; use System;
+
+package Grtlink is
+
+   Flag_String : String (1 .. 5);
+   pragma Export (C, Flag_String, "__ghdl_flag_string");
+
+   Std_Standard_Bit_RTI_Ptr : Address := Null_Address;
+
+   Std_Standard_Boolean_RTI_Ptr : Address := Null_Address;
+
+   pragma Export (C, Std_Standard_Bit_RTI_Ptr,
+                  "std__standard__bit__RTI_ptr");
+
+   pragma Export (C, Std_Standard_Boolean_RTI_Ptr,
+                  "std__standard__boolean__RTI_ptr");
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address := Null_Address;
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+end Grtlink;
diff --git a/src/translate/grt/Makefile b/src/translate/grt/Makefile
new file mode 100644
index 000000000..107aef7bf
--- /dev/null
+++ b/src/translate/grt/Makefile
@@ -0,0 +1,56 @@
+#  -*- Makefile -*- for the GHDL Run Time library.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+GRT_FLAGS=-g -O
+GRT_ADAFLAGS=-gnatn
+
+ADAC=gcc
+CC=gcc
+GNATFLAGS=$(CFLAGS) -gnatf -gnaty3befhkmr -gnatwlu
+GHDL1=../ghdl1-gcc
+GRTSRCDIR=.
+GRT_RANLIB=ranlib
+
+INSTALL=install
+INSTALL_DATA=$(INSTALL) -m 644
+
+prefix=/usr/local
+exec_prefix=$(prefix)
+libdir=$(exec_prefix)/lib
+grt_libdir=$(libdir)
+
+target:=$(shell $(CC) -dumpmachine)
+
+all: grt-all
+install: grt-install
+clean: grt-clean
+	$(RM) *~
+
+show_target:
+	echo "Target is $(target)"
+
+include Makefile.inc
+
+
+GRT_CFLAGS=$(GRT_FLAGS) -Wall
+ghwdump: ghwdump.o ghwlib.o
+	$(CC) $(GRT_CFLAGS) -o $@ ghwdump.o ghwlib.o
+
+ghwlib.o: ghwlib.c ghwlib.h
+	$(CC) -c $(GRT_CFLAGS) -o $@ $<
+ghwdump.o: ghwdump.c ghwlib.h
+	$(CC) -c $(GRT_CFLAGS) -o $@ $<
diff --git a/src/translate/grt/Makefile.inc b/src/translate/grt/Makefile.inc
new file mode 100644
index 000000000..ec1b0df09
--- /dev/null
+++ b/src/translate/grt/Makefile.inc
@@ -0,0 +1,226 @@
+#  -*- Makefile -*- for the GHDL Run Time library.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+# Variables used:
+# AR: ar command
+# RM
+# CC
+# ADAC: the GNAT compiler
+# GHDL1: the ghdl compiler
+# GRT_RANLIB: the ranlib tool for the grt library.
+# grt_libdir: the place to put grt.
+# GRTSRCDIR: the source directory of grt.
+# target: GCC target
+# GRT_FLAGS: common (Ada + C + asm) compilation flags.
+# GRT_ADAFLAGS: compilation flags for Ada
+
+# Convert the target variable into a space separated list of architecture,
+# manufacturer, and operating system and assign each of those to its own
+# variable.
+
+target1:=$(subst -gnu,,$(target))
+targ:=$(subst -, ,$(target1))
+arch:=$(word 1,$(targ))
+ifeq ($(words $(targ)),2)
+  osys:=$(word 2,$(targ))
+else
+  osys:=$(word 3,$(targ))
+endif
+
+GRT_ELF_OPTS:=-Wl,--version-script=@/grt.ver -Wl,--export-dynamic
+
+# Set target files.
+ifeq ($(filter-out i%86 linux,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=i386.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+endif
+ifeq ($(filter-out x86_64 linux,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=amd64.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+endif
+ifeq ($(filter-out i%86 freebsd%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=i386.o linux.o times.o
+  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
+  ADAC=ada
+endif
+ifeq ($(filter-out x86_64 freebsd%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=amd64.o linux.o times.o
+  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
+  ADAC=ada
+endif
+ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=i386.o linux.o times.o
+  GRT_EXTRA_LIB=
+endif
+ifeq ($(filter-out x86_64 darwin%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=amd64.o linux.o times.o
+  GRT_EXTRA_LIB=
+endif
+ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=sparc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl -lm
+endif
+ifeq ($(filter-out powerpc linux%,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=ppc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+endif
+ifeq ($(filter-out ia64 linux,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=ia64.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+endif
+ifeq ($(filter-out i%86 mingw32,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=win32.o clock.o
+endif
+# Doesn't work for unknown reasons.
+#ifeq ($(filter-out i%86 cygwin,$(arch) $(osys)),)
+#  GRT_TARGET_OBJS=win32.o clock.o
+#endif
+# Fall-back: use a generic implementation based on pthreads.
+ifndef GRT_TARGET_OBJS
+  GRT_TARGET_OBJS=pthread.o times.o
+  GRT_EXTRA_LIB=-lpthread -ldl -lm
+endif
+
+# Additionnal object files (C or asm files).
+GRT_ADD_OBJS:=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o
+
+#GRT_USE_PTHREADS=y
+ifeq ($(GRT_USE_PTHREADS),y)
+ GRT_CFLAGS+=-DUSE_THREADS
+ GRT_ADD_OBJS+=grt-cthreads.o
+ GRT_EXTRA_LIB+=-lpthread
+endif
+
+GRT_ARCH?=None
+
+# Configuration pragmas.
+GRT_PRAGMA_FLAG=-gnatec$(GRTSRCDIR)/grt.adc -gnat05
+
+# Rule to compile an Ada file.
+GRT_ADACOMPILE=$(ADAC) -c $(GRT_FLAGS) $(GRT_PRAGMA_FLAG) -o $@ $<
+
+grt-all: libgrt.a grt.lst
+
+libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files # grt-arch.ads
+	$(RM) -f $@
+	$(AR) rcv $@ `sed -e "/^-/d" < grt-files` $(GRT_ADD_OBJS) \
+	 run-bind.o main.o
+	$(GRT_RANLIB) $@
+
+run-bind.adb: grt-force
+	gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) \
+	  ghdl_main $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS)
+	gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
+
+#system.ads:
+#	sed -e "/Configurable_Run_Time/s/False/True/" \
+#	 -e "/Suppress_Standard_Library/s/False/True/" \
+#	  < `$(ADAC) -print-file-name=adainclude/system.ads` > $@
+
+run-bind.o: run-bind.adb
+	$(GRT_ADACOMPILE)
+
+main.o: $(GRTSRCDIR)/main.adb
+	$(GRT_ADACOMPILE)
+
+i386.o: $(GRTSRCDIR)/config/i386.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+chkstk.o: $(GRTSRCDIR)/config/chkstk.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+sparc.o: $(GRTSRCDIR)/config/sparc.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+ppc.o: $(GRTSRCDIR)/config/ppc.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+ia64.o: $(GRTSRCDIR)/config/ia64.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+amd64.o: $(GRTSRCDIR)/config/amd64.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+linux.o: $(GRTSRCDIR)/config/linux.c
+	$(CC) -c $(GRT_FLAGS) $(GRT_CFLAGS) -o $@ $<
+
+win32.o: $(GRTSRCDIR)/config/win32.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+win32thr.o: $(GRTSRCDIR)/config/win32thr.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+pthread.o: $(GRTSRCDIR)/config/pthread.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+times.o : $(GRTSRCDIR)/config/times.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+clock.o : $(GRTSRCDIR)/config/clock.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-cbinding.o: $(GRTSRCDIR)/grt-cbinding.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-cvpi.o: $(GRTSRCDIR)/grt-cvpi.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-cthreads.o: $(GRTSRCDIR)/grt-cthreads.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-disp-config:
+	@echo "target: $(target)"
+	@echo "targ: $(targ)"
+	@echo "arch: $(arch)"
+	@echo "osys: $(osys)"
+
+grt-files: run-bind.adb
+	sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \
+	  -e "s/   --   //" < $< > $@
+
+grt-arch.ads:
+	echo "With Grt.Arch_$(GRT_ARCH);" > $@
+	echo "Package Grt.Arch renames Grt.Arch_$(GRT_ARCH);" >> $@
+
+# Remove local files (they are now in the libgrt library).
+# Also, remove the -shared option, in order not to build a shared library
+#  instead of an executable.
+# Also remove -lgnat and its associated -L flags.  This appears to be required
+#  with GNAT GPL 2005.
+grt-files.in: grt-files
+	sed -e "\!^./!d" -e "/-shared/d" -e "/-static/d" -e "/-lgnat/d" \
+	  -e "\X-L/Xd" < $< > $@
+
+grt.lst: grt-files.in
+	echo "@/libgrt.a" > $@
+ifdef GRT_EXTRA_LIB
+	for i in $(GRT_EXTRA_LIB); do echo $$i >> $@; done
+endif
+	cat $< >> $@
+
+grt-install: libgrt.a grt.lst
+	$(INSTALL_DATA) libgrt.a $(DESTDIR)$(grt_libdir)/libgrt.a
+	$(INSTALL_DATA) grt.lst $(DESTDIR)$(grt_libdir)/grt.lst
+
+grt-force:
+
+grt-clean: grt-force
+	$(RM) *.o *.ali run-bind.adb run-bind.ads *.a std_standard.s
+	$(RM) grt-files grt-files.in grt.lst
+
+.PHONY: grt-all grt-force grt-clean grt-install
diff --git a/src/translate/grt/config/Makefile b/src/translate/grt/config/Makefile
new file mode 100644
index 000000000..7d5f57def
--- /dev/null
+++ b/src/translate/grt/config/Makefile
@@ -0,0 +1,14 @@
+CFLAGS=-Wall -g
+
+#ARCH_OBJS=i386.o linux.o
+ARCH_OBJS=ppc.o linux.o
+
+teststack: teststack.o $(ARCH_OBJS)
+	$(CC) -o $@ $< $(ARCH_OBJS)
+
+ppc.o: ppc.S
+	$(CC) -c -o $@ -g $<
+
+clean:
+	$(RM) -f *.o *~ teststack
+
diff --git a/src/translate/grt/config/amd64.S b/src/translate/grt/config/amd64.S
new file mode 100644
index 000000000..0a7f0044b
--- /dev/null
+++ b/src/translate/grt/config/amd64.S
@@ -0,0 +1,131 @@
+/*  GRT stack implementation for amd64 (x86_64)
+    Copyright (C) 2005 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file		"amd64.S"
+
+#ifdef __ELF__
+#define ENTRY(func) .align 4; .globl func; .type func,@function; func:
+#define END(func) .size func, . - func
+#define NAME(name) name
+#elif __APPLE__
+#define ENTRY(func) .align 4; .globl _##func; _##func:
+#define END(func)
+#define NAME(name) _##name
+#else
+#define ENTRY(func) .align 4; func:
+#define END(func)
+#define NAME(name) name
+#endif
+	.text
+
+	/* Function called to loop on the process.  */
+ENTRY(grt_stack_loop)
+	mov	0(%rsp),%rdi
+	call	*8(%rsp)
+	jmp	NAME(grt_stack_loop)
+END(grt_stack_loop)
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+ 	                          return Stack_Type;
+           Args: FUNC (RDI), ARG (RSI)
+	*/
+ENTRY(grt_stack_create)
+	/* Standard prologue.  */
+	pushq	%rbp
+	movq	%rsp,%rbp
+	/* Save args.  */
+	sub	$0x10,%rsp
+	mov	%rdi,-8(%rbp)
+	mov	%rsi,-16(%rbp)
+
+	/* Allocate the stack, and exit in case of failure  */
+	callq	NAME(grt_stack_allocate)
+	test	%rax,%rax
+	je	.Ldone
+
+	/* Note: %RAX contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+
+	/* Prepare stack.  */
+	/* The function to be executed.  */
+	mov	-8(%rbp), %rdi
+	mov	%rdi, -8(%rax)
+	/* The argument.  */
+	mov	-16(%rbp), %rsi
+	mov	%rsi, -16(%rax)
+	/* The return function.  Must be 8 mod 16.  */
+#if __APPLE__
+	movq	_grt_stack_loop@GOTPCREL(%rip), %rsi
+	movq	%rsi, -24(%rax)
+#else
+	movq	$grt_stack_loop, -24(%rax)
+#endif
+	/* The context.  */
+	mov	%rbp, -32(%rax)
+	mov	%rbx, -40(%rax)
+	mov	%r12, -48(%rax)
+	mov	%r13, -56(%rax)
+	mov	%r14, -64(%rax)
+	mov	%r15, -72(%rax)
+
+	/* Save the new stack pointer to the stack context.  */
+	lea	-72(%rax), %rsi
+	mov	%rsi, (%rax)
+
+.Ldone:
+	leave
+	ret
+END(grt_stack_create)
+
+
+
+	/* Arguments:	TO (RDI), FROM (RSI) [VAL (RDX)]
+	   Both are pointers to a stack_context.  */
+ENTRY(grt_stack_switch)
+	/* Save call-used registers.  */
+	pushq	%rbp
+	pushq	%rbx
+	pushq	%r12
+	pushq	%r13
+	pushq	%r14
+	pushq	%r15
+	/* Save the current stack.  */
+	movq	%rsp, (%rsi)
+	/* Stack switch.  */
+	movq	(%rdi), %rsp
+	/* Restore call-used registers.  */
+	popq	%r15
+	popq	%r14
+	popq	%r13
+	popq	%r12
+	popq	%rbx
+	popq	%rbp
+	/* Return val.  */
+	movq	%rdx, %rax
+	/* Run.  */
+	ret
+END(grt_stack_switch)
+
+	.ident	"Written by T.Gingold"
diff --git a/src/translate/grt/config/chkstk.S b/src/translate/grt/config/chkstk.S
new file mode 100644
index 000000000..ab244d0cd
--- /dev/null
+++ b/src/translate/grt/config/chkstk.S
@@ -0,0 +1,53 @@
+/*  GRT stack implementation for x86.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file		"chkstk.S"
+	.version	"01.01"
+	
+	.text
+
+#ifdef __APPLE__
+#define __chkstk ___chkstk
+#endif
+	
+	/* Function called to loop on the process.  */
+	.align 4
+#ifdef __ELF__
+	.type	__chkstk,@function
+#endif
+	.globl __chkstk
+__chkstk:
+	testl	%eax,%eax
+	je	0f
+	subl	$4,%eax		/* 4 bytes already used by call.  */
+	subl	%eax,%esp
+	jmp	*(%esp,%eax)
+0:
+	ret
+#ifdef __ELF__
+	.size	__chkstk, . - __chkstk
+#endif
+
+	.ident	"Written by T.Gingold"
diff --git a/src/translate/grt/config/clock.c b/src/translate/grt/config/clock.c
new file mode 100644
index 000000000..242af604b
--- /dev/null
+++ b/src/translate/grt/config/clock.c
@@ -0,0 +1,43 @@
+/*  GRT C bindings for time.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+#include <time.h>
+
+int
+grt_get_clk_tck (void)
+{
+  return CLOCKS_PER_SEC;
+}
+
+void
+grt_get_times (int *wall, int *user, int *sys)
+{
+  clock_t res;
+
+  *wall = clock ();
+  *user = 0;
+  *sys = 0;
+}
+
diff --git a/src/translate/grt/config/i386.S b/src/translate/grt/config/i386.S
new file mode 100644
index 000000000..00d4719ac
--- /dev/null
+++ b/src/translate/grt/config/i386.S
@@ -0,0 +1,141 @@
+/*  GRT stack implementation for x86.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file		"i386.S"
+	.version	"01.01"
+
+	.text
+
+#ifdef __ELF__
+#define ENTRY(func) .align 4; .globl func; .type func,@function; func:
+#define END(func) .size func, . - func
+#define NAME(name) name
+#elif __APPLE__
+#define ENTRY(func) .align 4; .globl _##func; _##func:
+#define END(func)
+#define NAME(name) _##name
+#else
+#define ENTRY(func) .align 4; func:
+#define END(func)
+#define NAME(name) name
+#endif
+
+	/* Function called to loop on the process.  */
+ENTRY(grt_stack_loop)
+	call	*4(%esp)
+	jmp	NAME(grt_stack_loop)
+END(grt_stack_loop)
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+ 	                          return Stack_Type;
+	*/
+ENTRY(grt_stack_create)
+	/* Standard prologue.  */
+	pushl	%ebp
+	movl	%esp,%ebp
+	/* Keep aligned (call + pushl + 8 = 16 bytes).  */
+	subl	$8,%esp
+
+	/* Allocate the stack, and exit in case of failure  */
+	call	NAME(grt_stack_allocate)
+	testl	%eax,%eax
+	je	.Ldone
+
+	/* Note: %EAX contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+
+	/* Prepare stack.  */
+	/* The function to be executed.  */
+	movl	8(%ebp), %ecx
+	movl	%ecx, -4(%eax)
+	/* The argument.  */
+	movl	12(%ebp), %ecx
+	movl	%ecx, -8(%eax)
+	/* The return function.  */
+#if __APPLE__
+	call	___x86.get_pc_thunk.cx
+L1$pb:
+	movl	L_grt_stack_loop$non_lazy_ptr-L1$pb(%ecx), %ecx
+	movl	%ecx,-12(%eax)
+#else
+	movl	$NAME(grt_stack_loop), -12(%eax)
+#endif
+	/* The context.  */
+	movl	%ebx, -16(%eax)
+	movl	%esi, -20(%eax)
+	movl	%edi, -24(%eax)
+	movl	%ebp, -28(%eax)
+
+	/* Save the new stack pointer to the stack context.  */
+	leal	-28(%eax), %ecx
+	movl	%ecx, (%eax)
+
+.Ldone:
+	leave
+	ret
+END(grt_stack_create)
+
+
+	/* Arguments:	TO, FROM
+	   Both are pointers to a stack_context.  */
+ENTRY(grt_stack_switch)
+	/* TO -> ECX.  */
+	movl	4(%esp), %ecx
+	/* FROM -> EDX.  */
+	movl	8(%esp), %edx
+	/* Save call-used registers.  */
+	pushl	%ebx
+	pushl	%esi
+	pushl	%edi
+	pushl	%ebp
+	/* Save the current stack.  */
+	movl	%esp, (%edx)
+	/* Stack switch.  */
+	movl	(%ecx), %esp
+	/* Restore call-used registers.  */
+	popl	%ebp
+	popl	%edi
+	popl	%esi
+	popl	%ebx
+	/* Run.  */
+	ret
+END(grt_stack_switch)
+
+
+#if __APPLE__
+	.section __TEXT,__textcoal_nt,coalesced,pure_instructions
+	.weak_definition ___x86.get_pc_thunk.cx
+	.private_extern	___x86.get_pc_thunk.cx
+___x86.get_pc_thunk.cx:
+	movl	(%esp), %ecx
+	ret
+
+	.section __IMPORT,__pointers,non_lazy_symbol_pointers
+L_grt_stack_loop$non_lazy_ptr:
+	.indirect_symbol _grt_stack_loop
+	.long	0
+#endif
+
+	.ident	"Written by T.Gingold"
diff --git a/src/translate/grt/config/ia64.S b/src/translate/grt/config/ia64.S
new file mode 100644
index 000000000..9ce3800bb
--- /dev/null
+++ b/src/translate/grt/config/ia64.S
@@ -0,0 +1,331 @@
+/*  GRT stack implementation for ia64.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file	"ia64.S"
+	.pred.safe_across_calls p1-p5,p16-p63
+	
+	.text
+	.align 16
+	.proc grt_stack_loop
+grt_stack_loop:
+	alloc r32 = ar.pfs, 0, 1, 1, 0
+	.body
+	;;
+1:	mov r33 = r4	
+	br.call.sptk.many b0 = b1
+	;;
+	br 1b
+	.endp
+
+	frame_size = 480
+	
+	.global grt_stack_switch#
+	.proc grt_stack_switch#
+	/* r32:	struct stack_context *TO, r33:  struct stack_context *FROM.  */
+	//  Registers to be saved:
+	//  ar.rsc, ar.bsp, ar.pfs, ar.lc, ar.rnat [5]
+	//  gp, r4-r7 (+ Nat)                      [6]
+	//  f2-f5, f16-f31                         [20]
+	//  p1-p5, p16-p63                         [1] ???
+	//  b1-b5                                  [5]
+	//  f2-f5, f16-f31			   [20*16]
+grt_stack_switch:
+	.prologue 2, 2
+	.vframe r2
+	{
+	alloc r31=ar.pfs, 2, 0, 0, 0
+	mov r14 = ar.rsc
+	adds r12 = -frame_size, r12
+	.body
+	;;
+	}
+	// Save ar.rsc, ar.bsp, ar.pfs
+	{
+	st8 [r12] = r14      		// sp + 0  <- ar.rsc
+	mov r15 = ar.bsp
+	adds r22 = (5*8), r12
+	;;
+	}
+	{
+	st8.spill [r22] = r1, 8		// sp + 40 <- r1
+	;; 
+	st8.spill [r22] = r4, 8		// sp + 48 <- r4
+	adds r20 = 8, r12
+	;;
+	}
+	st8 [r20] = r15, 8		// sp + 8  <- ar.bsp
+	st8.spill [r22] = r5, 8		// sp + 56 <- r5
+	mov r15 = ar.lc
+	;;
+	{
+	st8 [r20] = r31, 8		// sp + 16 <- ar.pfs
+	//  Flush dirty registers to the backing store
+	flushrs
+	mov r14 = b0
+	;;
+	}
+	{
+	st8 [r20] = r15, 8		// sp + 24 <- ar.lc
+	//  Set the RSE in enforced lazy mode.
+	mov ar.rsc = 0
+	;;
+	}
+	{
+	//  Save sp.
+	st8 [r33] = r12
+	mov r15 = ar.rnat
+	mov r16 = b1
+	;;
+	}
+	{
+	st8.spill [r22] = r6, 8		// sp + 64 <- r6
+	st8 [r20] = r15, 64		// sp + 32 <- ar.rnat
+	;;
+	}
+	{
+	st8.spill [r22] = r7, 16	// sp + 72 <- r7
+	st8 [r20] = r14, 8		// sp + 96 <- b0
+	mov r15 = b2
+	;;
+	}
+	{
+	mov r17 = ar.unat
+	;;
+	st8 [r22] = r17, 24		// sp + 88 <- ar.unat
+	mov r14 = b3
+	;; 
+	}
+	{
+	st8 [r20] = r16, 16		// sp + 104 <- b1
+	st8 [r22] = r15, 16		// sp + 112 <- b2
+	mov r17 = b4
+	;;
+	}
+	{
+	st8 [r20] = r14, 16		// sp + 120 <- b3
+	st8 [r22] = r17, 16		// sp + 128 <- b4
+	mov r15 = b5
+	;; 
+	}
+	{
+	//  Read new sp.
+	ld8 r21 = [r32]
+	;; 
+	st8 [r20] = r15, 24		// sp + 136 <- b5
+	mov r14 = pr
+	;; 
+	}
+	;;
+	st8 [r22] = r14, 32		// sp + 144 <- pr
+	stf.spill [r20] = f2, 32	// sp + 160 <- f2
+	;;
+	stf.spill [r22] = f3, 32	// sp + 176 <- f3
+	stf.spill [r20] = f4, 32	// sp + 192 <- f4
+	;;
+	stf.spill [r22] = f5, 32	// sp + 208 <- f5
+	stf.spill [r20] = f16, 32	// sp + 224 <- f16
+	;;
+	stf.spill [r22] = f17, 32	// sp + 240 <- f17
+	stf.spill [r20] = f18, 32	// sp + 256 <- f18
+	;;
+	stf.spill [r22] = f19, 32	// sp + 272 <- f19
+	stf.spill [r20] = f20, 32	// sp + 288 <- f20
+	;;
+	stf.spill [r22] = f21, 32	// sp + 304 <- f21
+	stf.spill [r20] = f22, 32	// sp + 320 <- f22
+	;;
+	stf.spill [r22] = f23, 32	// sp + 336 <- f23
+	stf.spill [r20] = f24, 32	// sp + 352 <- f24
+	;;
+	stf.spill [r22] = f25, 32	// sp + 368 <- f25
+	stf.spill [r20] = f26, 32	// sp + 384 <- f26
+	;;
+	stf.spill [r22] = f27, 32	// sp + 400 <- f27
+	stf.spill [r20] = f28, 32	// sp + 416 <- f28
+	;;
+	stf.spill [r22] = f29, 32	// sp + 432 <- f29
+	stf.spill [r20] = f30, 32	// sp + 448 <- f30
+	;;
+	{
+	stf.spill [r22] = f31, 32	// sp + 464 <- f31
+	invala	
+	adds r20 = 8, r21
+	;;
+	}
+	ld8 r14 = [r21], 88		// sp + 0 (ar.rsc)
+	ld8 r16 = [r20], 8		// sp + 8 (ar.bsp)
+	;; 
+	ld8 r15 = [r21], -56		// sp + 88 (ar.unat)
+	;; 
+	ld8 r18 = [r20], 8		// sp + 16 (ar.pfs)
+	mov ar.unat = r15
+	ld8 r17 = [r21], 8		// sp + 32 (ar.rnat)
+	;;
+	ld8 r15 = [r20], 72		// sp + 24 (ar.lc)
+	ld8.fill r1 = [r21], 8		// sp + 40 (r1)
+	mov ar.bspstore = r16
+	;; 
+	ld8.fill r4 = [r21], 8		// sp + 48 (r4)
+	mov ar.pfs = r18
+	mov ar.rnat = r17
+	;;
+	mov ar.rsc = r14
+	mov ar.lc = r15
+	ld8 r17 = [r20], 8		// sp + 96 (b0)
+	;;
+	{
+	ld8.fill r5 = [r21], 8		// sp + 56 (r5)
+	ld8 r14 = [r20], 8		// sp + 104 (b1)
+	mov b0 = r17
+	;;
+	}
+	{
+	ld8.fill r6 = [r21], 8		// sp + 64 (r6)
+	ld8 r15 = [r20], 8		// sp + 112 (b2)
+	mov b1 = r14
+	;;
+	}
+	ld8.fill r7 = [r21], 64		// sp + 72 (r7)
+	ld8 r14 = [r20], 8		// sp + 120 (b3)
+	mov b2 = r15
+	;;
+	ld8 r15 = [r20], 16		// sp + 128 (b4)
+	ld8 r16 = [r21], 40		// sp + 136 (b5)
+	mov b3 = r14
+	;;
+	{
+	ld8 r14 = [r20], 16		// sp + 144 (pr)
+	;;
+	ldf.fill f2 = [r20], 32		// sp + 160 (f2)
+	mov b4 = r15
+	;;
+	}
+	ldf.fill f3 = [r21], 32		// sp + 176 (f3)
+	ldf.fill f4 = [r20], 32		// sp + 192 (f4)
+	mov b5 = r16
+	;;
+	ldf.fill f5 = [r21], 32		// sp + 208 (f5)
+	ldf.fill f16 = [r20], 32	// sp + 224 (f16)
+	mov pr = r14, -1
+	;;
+	ldf.fill f17 = [r21], 32	// sp + 240 (f17)
+	ldf.fill f18 = [r20], 32	// sp + 256 (f18)
+	;;
+	ldf.fill f19 = [r21], 32	// sp + 272 (f19)
+	ldf.fill f20 = [r20], 32	// sp + 288 (f20)
+	;;
+	ldf.fill f21 = [r21], 32	// sp + 304 (f21)
+	ldf.fill f22 = [r20], 32	// sp + 320 (f22)
+	;;
+	ldf.fill f23 = [r21], 32	// sp + 336 (f23)
+	ldf.fill f24 = [r20], 32	// sp + 352 (f24)
+	;;
+	ldf.fill f25 = [r21], 32	// sp + 368 (f25)
+	ldf.fill f26 = [r20], 32	// sp + 384 (f26)
+	;;
+	ldf.fill f27 = [r21], 32	// sp + 400 (f27)
+	ldf.fill f28 = [r20], 32	// sp + 416 (f28)
+	;;
+	ldf.fill f29 = [r21], 32	// sp + 432 (f29)
+	ldf.fill f30 = [r20], 32	// sp + 448 (f30)
+	;;
+	ldf.fill f31 = [r21], 32	// sp + 464 (f31)
+	mov r12 = r20
+	br.ret.sptk.many b0
+	;;
+	.endp grt_stack_switch#
+	
+	.align 16
+	// r32:	 func, r33: arg
+	.global grt_stack_create#
+	.proc grt_stack_create#
+grt_stack_create:
+	.prologue 14, 34
+	.save ar.pfs, r35
+	alloc r35 = ar.pfs, 2, 3, 0, 0
+	.save rp, r34
+	//  Compute backing store.
+	movl r14 = stack_max_size
+	;; 
+	.body
+	{
+	ld4 r36 = [r14]		// r14: bsp
+	mov r34 = b0
+	br.call.sptk.many b0 = grt_stack_allocate#
+	;;
+	}
+	{
+	ld8 r22 = [r32], 8	// read ip (-> b1)
+	;;
+	ld8 r23 = [r32]		// read r1 from func
+	adds r21 = -(frame_size + 16) + 32, r8
+	;;
+	}
+	{
+	st8 [r21] = r0, -32	// sp + 32 (ar.rnat = 0)
+	;; 
+	st8 [r8] = r21		// Save cur_sp
+	mov r18 = 0x0f		// ar.rsc: LE, PL=3, Eager
+	;;
+	}
+	{
+	st8 [r21] = r18, 40	// sp + 0 (ar.rsc)
+	;;
+	st8 [r21] = r23, 64	// sp + 40 (r1 = func.r1)
+	mov b0 = r34
+	;;
+	}
+	{
+	st8 [r21] = r22, -96	// sp + 104 (b1 = func.ip)
+	movl r15 = grt_stack_loop
+	;; 
+	}	
+	sub r14 = r8, r36	// Backing store base
+	;;
+	adds r14 = 16, r14	// Add sizeof (stack_context)
+	adds r20 = 40, r21
+	;;
+	{
+	st8 [r21] = r14, 88	// sp + 8 (ar.bsp)
+	;; 
+	st8 [r21] = r15, -80	// sp + 96 (b0 = grt_stack_loop)
+	mov r16 = (0 << 7) | 1	// CFM:	sol=0, sof=1
+	;;
+	}
+	{
+	st8 [r21] = r16, 8	// sp + 16 (ar.pfs)
+	;; 
+	st8 [r21] = r0, 24	// sp + 24 (ar.lc)
+	mov ar.pfs = r35
+	;;
+	}
+	{
+	st8 [r20] = r0, 8	// sp + 32 (ar.rnat)
+	st8 [r21] = r33		// sp + 48 (r4 = arg)
+	br.ret.sptk.many b0
+	;;
+	}
+	.endp grt_stack_create#
+	.ident	"GCC: (GNU) 4.0.2"
diff --git a/src/translate/grt/config/linux.c b/src/translate/grt/config/linux.c
new file mode 100644
index 000000000..74dce0903
--- /dev/null
+++ b/src/translate/grt/config/linux.c
@@ -0,0 +1,361 @@
+/*  GRT stacks implementation for linux and other *nix.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+#define _GNU_SOURCE
+#include <unistd.h>
+#include <sys/mman.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <sys/ucontext.h>
+#include <stdlib.h>
+//#include <stdint.h>
+
+#ifdef __APPLE__
+#define MAP_ANONYMOUS MAP_ANON
+#endif
+
+/* On x86, the stack growns downward.  */
+#define STACK_GROWNS_DOWNWARD 1
+
+#ifdef __linux__
+/* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
+#define EXTEND_STACK 1
+#define STACK_SIGNAL SIGSEGV
+#endif
+#ifdef __FreeBSD__
+/* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
+#define EXTEND_STACK 1
+#define STACK_SIGNAL SIGSEGV
+#endif
+#ifdef __APPLE__
+/* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
+#define EXTEND_STACK 1
+#define STACK_SIGNAL SIGBUS
+#endif
+
+/* Defined in Grt.Options.  */
+extern unsigned int stack_size;
+extern unsigned int stack_max_size;
+
+/* Size of a memory page.  */
+static size_t page_size;
+
+extern void grt_stack_error_grow_failed (void);
+extern void grt_stack_error_null_access (void);
+extern void grt_stack_error_memory_access (void);
+extern void grt_overflow_error (void);
+
+/* Definitions:
+   The base of the stack is the address before the first available byte on the
+     stack.  If the stack grows downward, the base is equal to the high bound.
+*/
+   
+/* Per stack context.
+   This context is allocated at the top (or bottom if the stack grows
+   upward) of the stack.
+   Therefore, the base of the stack can be easily deduced from the context.  */
+struct stack_context
+{
+  /* The current stack pointer.  */
+  void *cur_sp;
+  /* The current stack length.  */
+  size_t cur_length;
+};
+
+/* If MAP_ANONYMOUS is not defined, use /dev/zero. */
+#ifndef MAP_ANONYMOUS
+#define USE_DEV_ZERO
+static int dev_zero_fd;
+#define MAP_ANONYMOUS 0
+#define MMAP_FILEDES dev_zero_fd
+#else
+#define MMAP_FILEDES -1
+#endif
+
+#if EXTEND_STACK
+/* This is the current process being run.  */
+extern struct stack_context *grt_get_current_process (void);
+
+/* Stack used for signals.
+   The stack must be different from the running stack, because we want to be
+   able to extend the running stack.  When the stack need to be extended, the
+   current stack pointer does not point to a valid address.  Therefore, the
+   stack cannot be used or else a second SIGSEGV is generated while the
+   arguments are pushed.  */
+static unsigned long sig_stack[SIGSTKSZ / sizeof (long)];
+
+/* Signal stack descriptor.  */
+static stack_t sig_stk;
+
+static struct sigaction prev_sigsegv_act;
+static struct sigaction sigsegv_act;
+
+/* The following code assumes stack grows downward.  */
+#if !STACK_GROWNS_DOWNWARD
+#error "Not implemented"
+#endif
+
+#ifdef __APPLE__
+/* Handler for SIGFPE signal, raised in case of overflow (i386).  */
+static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
+{
+  grt_overflow_error ();
+}
+#endif
+
+/* Handler for SIGSEGV signal, which grow the stack.  */
+static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
+{
+  static int in_handler;
+  void *addr;
+  struct stack_context *ctxt;
+  void *stack_high;
+  void *stack_low;
+  void *n_low;
+  size_t n_len;
+  ucontext_t *uctxt = (ucontext_t *)ptr;
+
+  in_handler++;
+
+#ifdef __linux__
+#ifdef __i386__
+  /* Linux generates a SIGSEGV (!) for an overflow exception.  */
+  if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+    {
+      grt_overflow_error ();
+    }
+#endif
+#endif
+
+  if (info == NULL || grt_get_current_process () == NULL || in_handler > 1)
+    {
+      /* We loose.  */
+      sigaction (STACK_SIGNAL, &prev_sigsegv_act, NULL);
+      return;
+    }
+
+  addr = info->si_addr;
+
+  /* Check ADDR belong to the stack.  */
+  ctxt = grt_get_current_process ()->cur_sp;
+  stack_high = (void *)(ctxt + 1);
+  stack_low = stack_high - stack_max_size;
+  if (addr > stack_high || addr < stack_low)
+    {
+      /* Out of the stack.  */
+      if (addr < (void *)page_size)
+	grt_stack_error_null_access ();
+      else
+	grt_stack_error_memory_access ();
+    }
+  /* Compute the address of the faulting page.  */
+  n_low = (void *)((unsigned long)addr & ~(page_size - 1));
+
+  /* Should not happen.  */
+  if (n_low < stack_low)
+    abort ();
+
+  /*  Allocate one more page, if possible.  */
+  if (n_low != stack_low)
+    n_low -= page_size;
+
+  /* Compute the new length.  */
+  n_len = stack_high - n_low;
+
+  if (mmap (n_low, n_len - ctxt->cur_length,  PROT_READ | PROT_WRITE,
+	    MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0)
+      != n_low)
+    {
+      /* Cannot grow the stack.  */
+      grt_stack_error_grow_failed ();
+    }
+
+  ctxt->cur_length = n_len;
+
+  sigaction (STACK_SIGNAL, &sigsegv_act, NULL);
+
+  in_handler--;
+
+  /* Hopes we can resume!  */
+  return;
+}
+
+static void grt_signal_setup (void)
+{
+  sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
+  sigemptyset (&sigsegv_act.sa_mask);
+  sigsegv_act.sa_flags = SA_ONSTACK | SA_SIGINFO;
+#ifdef SA_ONESHOT
+  sigsegv_act.sa_flags |= SA_ONESHOT;
+#elif defined (SA_RESETHAND)
+  sigsegv_act.sa_flags |= SA_RESETHAND;
+#endif
+
+  /* Use an alternate stack during signals.  */
+  sig_stk.ss_sp = sig_stack;
+  sig_stk.ss_size = sizeof (sig_stack);
+  sig_stk.ss_flags = 0;
+  sigaltstack (&sig_stk, NULL);
+
+  /* We don't care about the return status.
+     If the handler is not installed, then some feature are lost.  */
+  sigaction (STACK_SIGNAL, &sigsegv_act, &prev_sigsegv_act);
+
+#ifdef __APPLE__
+  {
+    struct sigaction sig_ovf_act;
+
+    sig_ovf_act.sa_sigaction = &grt_overflow_handler;
+    sigemptyset (&sig_ovf_act.sa_mask);
+    sig_ovf_act.sa_flags = SA_SIGINFO;
+
+    sigaction (SIGFPE, &sig_ovf_act, NULL);
+  }
+#endif
+}
+#endif
+
+/* Context for the main stack.  */
+#ifdef USE_THREADS
+#define THREAD __thread
+#else
+#define THREAD
+#endif
+static THREAD struct stack_context main_stack_context;
+
+extern void grt_set_main_stack (struct stack_context *stack);
+
+void
+grt_stack_new_thread (void)
+{
+  main_stack_context.cur_sp = NULL;
+  main_stack_context.cur_length = 0;
+  grt_set_main_stack (&main_stack_context);
+}
+
+void
+grt_stack_init (void)
+{
+  size_t pg_round;
+
+  page_size = getpagesize ();
+  pg_round = page_size - 1;
+
+  /* Align size.  */
+  stack_size = (stack_size + pg_round) & ~pg_round;
+  stack_max_size = (stack_max_size + pg_round) & ~pg_round;
+
+  /* Set mimum values.  */
+  if (stack_size < 2 * page_size)
+    stack_size = 2 * page_size;
+  if (stack_max_size < (stack_size + 2 * page_size))
+    stack_max_size = stack_size + 2 * page_size;
+
+  /* Initialize the main stack context.  */
+  main_stack_context.cur_sp = NULL;
+  main_stack_context.cur_length = 0;
+  grt_set_main_stack (&main_stack_context);
+
+#ifdef USE_DEV_ZERO
+  dev_zero_fd = open ("/dev/zero", O_RDWR);
+  if (dev_zero_fd < 0)
+    abort ();
+#endif
+
+#if EXTEND_STACK
+  grt_signal_setup ();
+#endif
+}
+
+/* Allocate a stack.
+   Called by i386.S  */
+struct stack_context *
+grt_stack_allocate (void)
+{
+  struct stack_context *res;
+  void *r;
+  void *base;
+
+  /* Allocate the stack, but without any rights.  This is a guard.  */
+  base = (void *)mmap (NULL, stack_max_size, PROT_NONE,
+		       MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0);
+
+  if (base == (void *)-1)
+    return NULL;
+
+  /* Set rights on the allocated stack.  */
+#if STACK_GROWNS_DOWNWARD
+  r = base + stack_max_size - stack_size;
+#else
+  r = base;
+#endif
+  if (mmap (r, stack_size,  PROT_READ | PROT_WRITE,
+	    MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0)
+      != r)
+    return NULL;
+
+#if STACK_GROWNS_DOWNWARD
+  res = (struct stack_context *)
+    (base + stack_max_size - sizeof (struct stack_context));
+#else
+  res = (struct stack_context *)(base + sizeof (struct stack_context));
+#endif
+
+#ifdef __ia64__
+  /* Also allocate BSP.  */
+  if (mmap (base, page_size, PROT_READ | PROT_WRITE,
+	    MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0) != base)
+    return NULL;
+#endif
+
+  res->cur_sp = (void *)res;
+  res->cur_length = stack_size;
+  return res;
+}
+
+#include <setjmp.h>
+static int run_env_en;
+static jmp_buf run_env;
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (run_env_en)
+    longjmp (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
+}
+
diff --git a/src/translate/grt/config/ppc.S b/src/translate/grt/config/ppc.S
new file mode 100644
index 000000000..bedd48ab4
--- /dev/null
+++ b/src/translate/grt/config/ppc.S
@@ -0,0 +1,334 @@
+/*  GRT stack implementation for ppc.
+    Copyright (C) 2005 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file		"ppc.S"
+	
+	.section	".text"
+
+#define OFF 240
+
+#define GREG(x) x
+#define FREG(x) x
+	
+#define r0 GREG(0)
+#define r1 GREG(1)
+#define r2 GREG(2)
+#define r3 GREG(3)
+#define r4 GREG(4)
+#define r5 GREG(5)
+#define r6 GREG(6)
+#define r7 GREG(7)
+#define r8 GREG(8)
+#define r9 GREG(9)
+#define r10 GREG(10)
+#define r11 GREG(11)
+#define r12 GREG(12)
+#define r13 GREG(13)
+#define r14 GREG(14)
+#define r15 GREG(15)
+#define r16 GREG(16)
+#define r17 GREG(17)
+#define r18 GREG(18)
+#define r19 GREG(19)
+#define r20 GREG(20)
+#define r21 GREG(21)
+#define r22 GREG(22)
+#define r23 GREG(23)
+#define r24 GREG(24)
+#define r25 GREG(25)
+#define r26 GREG(26)
+#define r27 GREG(27)
+#define r28 GREG(28)
+#define r29 GREG(29)
+#define r30 GREG(30)
+#define r31 GREG(31)
+
+#define f0 FREG(0)
+#define f1 FREG(1)
+#define f2 FREG(2)
+#define f3 FREG(3)
+#define f4 FREG(4)
+#define f5 FREG(5)
+#define f6 FREG(6)
+#define f7 FREG(7)
+#define f8 FREG(8)
+#define f9 FREG(9)
+#define f10 FREG(10)
+#define f11 FREG(11)
+#define f12 FREG(12)
+#define f13 FREG(13)
+#define f14 FREG(14)
+#define f15 FREG(15)
+#define f16 FREG(16)
+#define f17 FREG(17)
+#define f18 FREG(18)
+#define f19 FREG(19)
+#define f20 FREG(20)
+#define f21 FREG(21)
+#define f22 FREG(22)
+#define f23 FREG(23)
+#define f24 FREG(24)
+#define f25 FREG(25)
+#define f26 FREG(26)
+#define f27 FREG(27)
+#define f28 FREG(28)
+#define f29 FREG(29)
+#define f30 FREG(30)
+#define f31 FREG(31)
+
+	/* Stack structure is:
+           +4 :	cur_length   \  Stack
+	   +0 :	cur_sp       /  Context
+	   -4 :	arg
+	   -8 :	func
+	
+	   -12:	pad
+	   -16: pad
+           -20: LR save word
+	   -24:	Back chain
+	
+	   -28: fp/gp saved registers. 
+	   -4 :	return address
+	   -8 :	process function to be executed
+           -12:	function argument
+	   ...
+           -72:	%sp
+	*/
+	
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,@function
+grt_stack_loop:
+	/* Get function.  */
+	lwz	r0,16(r1)
+	/* Get argument.  */
+	lwz	r3,20(r1)
+	mtlr	r0
+	blrl
+	b	grt_stack_loop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+	                         return Stack_Type;  */
+	.align	4
+	.global grt_stack_create
+	.type	 grt_stack_create,@function
+grt_stack_create:
+	/* Standard prologue.  */
+	stwu	r1,-32(r1)
+	mflr	r0
+	stw	r0,36(r1)
+
+	/* Save arguments.  */
+	stw	r3,24(r1)
+	stw	r4,28(r1)
+	
+	/* Allocate the stack, and exit in case of failure  */
+	bl	grt_stack_allocate
+	cmpwi	0,r3,0
+	beq-	.Ldone
+
+	/* Note: r3 contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+				
+	/* Prepare stack.  */
+	/* Align the stack.  */
+	addi	r5,r3,-24
+
+	/* Save the parameters.  */
+	lwz	r6,24(r1)
+	stw	r6,16(r5)
+	lwz	r7,28(r1)
+	stw	r7,20(r5)
+	
+	/* The return function.  */
+	lis	r4,grt_stack_loop@ha
+	la	r4,grt_stack_loop@l(r4)
+	stw	r4,4(r5)
+	/* Back-Chain.  */
+	addi	r4,r1,32
+	stw	r4,0(r5)
+
+	/* Save register.
+	   They should be considered as garbage.  */
+	addi	r4,r5,-OFF
+	
+	stfd	f31,(OFF - 8)(r4)
+	stfd	f30,(OFF - 16)(r4)
+	stfd	f29,(OFF - 24)(r4)
+	stfd	f28,(OFF - 32)(r4)
+	stfd	f27,(OFF - 40)(r4)
+	stfd	f26,(OFF - 48)(r4)
+	stfd	f25,(OFF - 56)(r4)
+	stfd	f24,(OFF - 64)(r4)
+	stfd	f23,(OFF - 72)(r4)
+	stfd	f22,(OFF - 80)(r4)
+	stfd	f21,(OFF - 88)(r4)
+	stfd	f20,(OFF - 96)(r4)
+	stfd	f19,(OFF - 104)(r4)
+	stfd	f18,(OFF - 112)(r4)
+	stfd	f17,(OFF - 120)(r4)
+	stfd	f16,(OFF - 128)(r4)
+	stfd	f15,(OFF - 136)(r4)
+	stfd	f14,(OFF - 144)(r4)
+	stw	r31,(OFF - 148)(r4)
+	stw	r30,(OFF - 152)(r4)
+	stw	r29,(OFF - 156)(r4)
+	stw	r28,(OFF - 160)(r4)
+	stw	r27,(OFF - 164)(r4)
+	stw	r26,(OFF - 168)(r4)
+	stw	r25,(OFF - 172)(r4)
+	stw	r24,(OFF - 176)(r4)
+	stw	r23,(OFF - 180)(r4)
+	stw	r22,(OFF - 184)(r4)
+	stw	r21,(OFF - 188)(r4)
+	stw	r20,(OFF - 192)(r4)
+	stw	r19,(OFF - 196)(r4)
+	stw	r18,(OFF - 200)(r4)
+	stw	r17,(OFF - 204)(r4)
+	stw	r16,(OFF - 208)(r4)
+	stw	r15,(OFF - 212)(r4)
+	stw	r14,(OFF - 216)(r4)
+	mfcr	r0
+	stw	r0, (OFF - 220)(r4)
+
+	/* Save stack pointer.  */
+	stw	r4, 0(r3)
+
+.Ldone:
+	lwz	r0,36(r1)
+	mtlr	r0
+	addi	r1,r1,32
+	blr
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+	.align 4
+	.global grt_stack_switch
+	/* Arguments:	TO, FROM.
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,@function
+grt_stack_switch:
+	/* Standard prologue, save return address.  */
+	stwu	r1,(-OFF)(r1)
+	mflr	r0
+	stw	r0,(OFF + 4)(r1)
+
+	/* Save r14-r31, f14-f31, CR
+	   This is 18 words + 18 double words, ie 216 bytes.  */
+	/* Maybe use the savefpr function ? */
+	stfd	f31,(OFF - 8)(r1)
+	stfd	f30,(OFF - 16)(r1)
+	stfd	f29,(OFF - 24)(r1)
+	stfd	f28,(OFF - 32)(r1)
+	stfd	f27,(OFF - 40)(r1)
+	stfd	f26,(OFF - 48)(r1)
+	stfd	f25,(OFF - 56)(r1)
+	stfd	f24,(OFF - 64)(r1)
+	stfd	f23,(OFF - 72)(r1)
+	stfd	f22,(OFF - 80)(r1)
+	stfd	f21,(OFF - 88)(r1)
+	stfd	f20,(OFF - 96)(r1)
+	stfd	f19,(OFF - 104)(r1)
+	stfd	f18,(OFF - 112)(r1)
+	stfd	f17,(OFF - 120)(r1)
+	stfd	f16,(OFF - 128)(r1)
+	stfd	f15,(OFF - 136)(r1)
+	stfd	f14,(OFF - 144)(r1)
+	stw	r31,(OFF - 148)(r1)
+	stw	r30,(OFF - 152)(r1)
+	stw	r29,(OFF - 156)(r1)
+	stw	r28,(OFF - 160)(r1)
+	stw	r27,(OFF - 164)(r1)
+	stw	r26,(OFF - 168)(r1)
+	stw	r25,(OFF - 172)(r1)
+	stw	r24,(OFF - 176)(r1)
+	stw	r23,(OFF - 180)(r1)
+	stw	r22,(OFF - 184)(r1)
+	stw	r21,(OFF - 188)(r1)
+	stw	r20,(OFF - 192)(r1)
+	stw	r19,(OFF - 196)(r1)
+	stw	r18,(OFF - 200)(r1)
+	stw	r17,(OFF - 204)(r1)
+	stw	r16,(OFF - 208)(r1)
+	stw	r15,(OFF - 212)(r1)
+	stw	r14,(OFF - 216)(r1)
+	mfcr	r0
+	stw	r0, (OFF - 220)(r1)
+	
+	/* Save stack pointer.  */
+	stw	r1, 0(r4)
+
+	/* Load stack pointer.  */
+	lwz	r1, 0(r3)
+			
+
+	lfd	f31,(OFF - 8)(r1)
+	lfd	f30,(OFF - 16)(r1)
+	lfd	f29,(OFF - 24)(r1)
+	lfd	f28,(OFF - 32)(r1)
+	lfd	f27,(OFF - 40)(r1)
+	lfd	f26,(OFF - 48)(r1)
+	lfd	f25,(OFF - 56)(r1)
+	lfd	f24,(OFF - 64)(r1)
+	lfd	f23,(OFF - 72)(r1)
+	lfd	f22,(OFF - 80)(r1)
+	lfd	f21,(OFF - 88)(r1)
+	lfd	f20,(OFF - 96)(r1)
+	lfd	f19,(OFF - 104)(r1)
+	lfd	f18,(OFF - 112)(r1)
+	lfd	f17,(OFF - 120)(r1)
+	lfd	f16,(OFF - 128)(r1)
+	lfd	f15,(OFF - 136)(r1)
+	lfd	f14,(OFF - 144)(r1)
+	lwz	r31,(OFF - 148)(r1)
+	lwz	r30,(OFF - 152)(r1)
+	lwz	r29,(OFF - 156)(r1)
+	lwz	r28,(OFF - 160)(r1)
+	lwz	r27,(OFF - 164)(r1)
+	lwz	r26,(OFF - 168)(r1)
+	lwz	r25,(OFF - 172)(r1)
+	lwz	r24,(OFF - 176)(r1)
+	lwz	r23,(OFF - 180)(r1)
+	lwz	r22,(OFF - 184)(r1)
+	lwz	r21,(OFF - 188)(r1)
+	lwz	r20,(OFF - 192)(r1)
+	lwz	r19,(OFF - 196)(r1)
+	lwz	r18,(OFF - 200)(r1)
+	lwz	r17,(OFF - 204)(r1)
+	lwz	r16,(OFF - 208)(r1)
+	lwz	r15,(OFF - 212)(r1)
+	lwz	r14,(OFF - 216)(r1)
+	lwz	r0, (OFF - 220)(r1)
+	mtcr	r0
+
+	lwz	r0,(OFF + 4)(r1)
+	mtlr	r0
+	addi	r1,r1,OFF
+	blr
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/src/translate/grt/config/pthread.c b/src/translate/grt/config/pthread.c
new file mode 100644
index 000000000..189ae90c8
--- /dev/null
+++ b/src/translate/grt/config/pthread.c
@@ -0,0 +1,239 @@
+/*  GRT stack implementation based on pthreads.
+    Copyright (C) 2003 - 2014 Felix Bertram & 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.
+*/
+//-----------------------------------------------------------------------------
+// Project:     GHDL - VHDL Simulator
+// Description: pthread port of stacks package, for use with MacOSX
+// Note:        Tristan's original i386/Linux used assembly-code
+//              to manually switch stacks for performance reasons.
+// History:     2003may22, FB, created.
+//-----------------------------------------------------------------------------
+
+#include <pthread.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <setjmp.h>
+#include <assert.h>
+
+//#define INFO printf
+#define INFO (void)
+
+// GHDL names an endless loop calling FUNC with ARG a 'stack'
+// at a given time, only one stack may be 'executed'
+typedef struct
+{
+  pthread_t           thread;         // stack's thread
+  pthread_mutex_t     mutex;          // mutex to suspend/resume thread
+#if defined(__CYGWIN__)
+  pthread_mutexattr_t mxAttr;
+#endif
+  void                (*Func)(void*); // stack's FUNC
+  void*               Arg;            // ARG passed to FUNC
+} Stack_Type_t, *Stack_Type;
+
+static Stack_Type_t      main_stack_context;
+static Stack_Type_t	 *current;
+extern void grt_set_main_stack (Stack_Type_t *stack);
+
+//----------------------------------------------------------------------------
+void grt_stack_init(void)
+// Initialize the stacks package.
+// This may adjust stack sizes.
+// Must be called after grt.options.decode.
+// => procedure Stack_Init;
+{
+  int res;
+  INFO("grt_stack_init\n");
+  INFO("  main_stack_context=0x%08x\n", &main_stack_context);
+
+
+#if defined(__CYGWIN__)
+  res = pthread_mutexattr_init (&main_stack_context.mxAttr);
+  assert (res == 0);
+  res = pthread_mutexattr_settype (&main_stack_context.mxAttr,
+				   PTHREAD_MUTEX_DEFAULT);
+  assert (res == 0);
+  res = pthread_mutex_init (&main_stack_context.mutex,
+			    &main_stack_context.mxAttr);
+  assert (res == 0);
+#else
+  res = pthread_mutex_init (&main_stack_context.mutex, NULL);
+  assert (res == 0);
+#endif
+  // lock the mutex, as we are currently running
+  res = pthread_mutex_lock (&main_stack_context.mutex);
+  assert (res == 0);
+
+  current = &main_stack_context;
+
+  grt_set_main_stack (&main_stack_context);
+}
+
+//----------------------------------------------------------------------------
+static void* grt_stack_loop(void* pv_myStack)
+{
+  Stack_Type myStack= (Stack_Type)pv_myStack;
+
+  INFO("grt_stack_loop\n");
+
+  INFO("  myStack=0x%08x\n", myStack);
+
+  // block until mutex becomes available again.
+  // this happens when this stack is enabled for the first time
+  pthread_mutex_lock(&(myStack->mutex));
+
+  // run stack's function in endless loop
+  while(1)
+    {
+      INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
+      myStack->Func(myStack->Arg);
+    }
+
+  // we never get here...
+  return 0;
+}
+
+//----------------------------------------------------------------------------
+Stack_Type grt_stack_create(void* Func, void* Arg)
+// Create a new stack, which on first execution will call FUNC with
+// an argument ARG.
+// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
+{
+  Stack_Type newStack;
+  int res;
+
+  INFO("grt_stack_create\n");
+  INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
+
+  newStack = malloc (sizeof(Stack_Type_t));
+
+  // init function and argument
+  newStack->Func = Func;
+  newStack->Arg = Arg;
+
+  // create mutex
+#if defined(__CYGWIN__)
+  res = pthread_mutexattr_init (&newStack->mxAttr);
+  assert (res == 0);
+  res = pthread_mutexattr_settype (&newStack->mxAttr, PTHREAD_MUTEX_DEFAULT);
+  assert (res == 0);
+  res = pthread_mutex_init (&newStack->mutex, &newStack->mxAttr);
+  assert (res == 0);
+#else
+  res = pthread_mutex_init (&newStack->mutex, NULL);
+  assert (res == 0);
+#endif
+
+  // block the mutex, so that thread will blocked in grt_stack_loop
+  res = pthread_mutex_lock (&newStack->mutex);
+  assert (res == 0);
+
+  INFO("  newStack=0x%08x\n", newStack);
+
+  // create thread, which executes grt_stack_loop
+  pthread_create (&newStack->thread, NULL, grt_stack_loop, newStack);
+
+  return newStack;
+}
+
+static int need_longjmp;
+static int run_env_en;
+static jmp_buf run_env;
+
+//----------------------------------------------------------------------------
+void grt_stack_switch(Stack_Type To, Stack_Type From)
+// Resume stack TO and save the current context to the stack pointed by
+// CUR.
+// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
+{
+  int res;
+  INFO("grt_stack_switch\n");
+  INFO("  from 0x%08x to 0x%08x\n", From, To);
+
+  current = To;
+
+  // unlock 'To' mutex. this will make the other thread either
+  // - starts for first time in grt_stack_loop
+  // - resumes at lock below
+  res = pthread_mutex_unlock (&To->mutex);
+  assert (res == 0);
+
+  // block until 'From' mutex becomes available again
+  // as we are running, our mutex is locked and we block here
+  // when stacks are switched, with above unlock, we may proceed
+  res = pthread_mutex_lock (&From->mutex);
+  assert (res == 0);
+
+  if (From == &main_stack_context && need_longjmp != 0)
+    longjmp (run_env, need_longjmp);
+}
+
+//----------------------------------------------------------------------------
+void grt_stack_delete(Stack_Type Stack)
+// Delete stack STACK, which must not be currently executed.
+// => procedure Stack_Delete (Stack : Stack_Type);
+{
+  INFO("grt_stack_delete\n");
+}
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (!run_env_en)
+    return;
+
+  if (current != &main_stack_context)
+    {
+      need_longjmp = val;
+      grt_stack_switch (&main_stack_context, current);
+    }
+  else
+    longjmp (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
+}
+
+
+//----------------------------------------------------------------------------
+
+#ifndef WITH_GNAT_RUN_TIME
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+#endif /* WITH_GNAT_RUN_TIME */
+
+//----------------------------------------------------------------------------
+// end of file
+
diff --git a/src/translate/grt/config/sparc.S b/src/translate/grt/config/sparc.S
new file mode 100644
index 000000000..0ffe412ed
--- /dev/null
+++ b/src/translate/grt/config/sparc.S
@@ -0,0 +1,141 @@
+/*  GRT stack implementation for x86.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+	.file		"sparc.S"
+	
+	.section	".text"
+
+	/* Stack structure is:
+           +4 :	cur_length
+	   +0 :	cur_sp
+	   -4 :	return address
+	   -8 :	process function to be executed
+           -12:	function argument
+	   ...
+           -72:	%sp
+	*/
+	
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,#function
+grt_stack_loop:
+	ld	[%sp + 64], %o1
+	jmpl	%o1 + 0, %o7
+	ld	[%sp + 68], %o0
+	ba	grt_stack_loop
+	nop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+	                         return Stack_Type;  */
+	.align	4
+	.global grt_stack_create
+	.type	 grt_stack_create,#function
+grt_stack_create:
+	/* Standard prologue.  */
+	save	%sp,-80,%sp
+	
+	/* Allocate the stack, and exit in case of failure  */
+	call	grt_stack_allocate
+	nop
+	cmp	%o0, 0
+	be	.Ldone
+	nop
+
+	/* Note: %o0 contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+				
+	/* Prepare stack.  */
+
+	/* The return function.  */
+	sethi	%hi(grt_stack_loop - 8), %l2
+	or	%lo(grt_stack_loop - 8), %l2, %l2
+
+	/* Create a frame for grt_stack_loop. */
+	sub	%o0, (64 + 8), %l1
+
+	/* The function to be executed.  */
+	st	%i0, [%l1 + 64]
+	/* The argument.  */
+	st	%i1, [%l1 + 68]
+
+	/* Create a frame for grt_stack_switch.  */
+	sub	%l1, 64, %l0
+
+	/* Save frame pointer.  */
+	st	%l1, [%l0 + 56]
+	/* Save return address.  */
+	st	%l2, [%l0 + 60]
+
+	/* Save stack pointer.  */
+	st	%l0, [%o0]
+
+.Ldone:
+	ret
+	restore %o0, %g0, %o0
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+	.align 4
+	.global grt_stack_switch
+	/* Arguments:	TO, FROM.
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,#function
+grt_stack_switch:
+	/* Standard prologue.  */
+	save	%sp,-80,%sp
+
+	/* Flush and invalidate windows.
+	   It is not clear wether the current window is saved or not,
+	    therefore, I assume it is not.
+	*/
+	ta	3
+
+	/* Only IN registers %fp and %i7 (return address) must be saved.
+	   Of course, I could use std/ldd, but it is not as clear
+	*/
+	/* Save current frame pointer.  */
+	st	%fp, [%sp + 56]
+	/* Save return address.  */
+	st	%i7, [%sp + 60]
+
+	/* Save stack pointer.  */
+	st	%sp, [%i1]
+
+	/* Load stack pointer.  */
+	ld	[%i0], %sp
+	
+	/* Load return address.  */
+	ld	[%sp + 60], %i7
+	/* Load frame pointer.  */
+	ld	[%sp + 56], %fp
+
+	/* Return.  */
+	ret
+	restore	
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/src/translate/grt/config/teststack.c b/src/translate/grt/config/teststack.c
new file mode 100644
index 000000000..6a6966d6f
--- /dev/null
+++ b/src/translate/grt/config/teststack.c
@@ -0,0 +1,174 @@
+#include <stdlib.h>
+#include <stdio.h>
+
+extern void grt_stack_init (void);
+extern void grt_stack_switch (void *from, void *to);
+extern void *grt_stack_create (void (*func)(void *), void *arg);
+
+int stack_size = 4096;
+int stack_max_size = 8 * 4096;
+
+static void *stack1;
+static void *stack2;
+void *grt_stack_main_stack;
+
+void *grt_cur_proc;
+
+static int step;
+
+void
+grt_overflow_error (void)
+{
+  abort ();
+}
+
+void
+grt_stack_error_null_access (void)
+{
+  abort ();
+}
+
+void
+grt_stack_error_memory_access (void)
+{
+  abort ();
+}
+
+void
+grt_stack_error_grow_failed (void)
+{
+  abort ();
+}
+
+void
+error (void)
+{
+  printf ("Test failure at step %d\n", step);
+  fflush (stdout);
+  exit (1);
+}
+
+static void
+func1 (void *ptr)
+{
+  if (ptr != (void *)1)
+    error ();
+
+  if (step != 0)
+    error ();
+
+  step = 1;
+
+  grt_stack_switch (grt_stack_main_stack, stack1);
+
+  if (step != 5)
+    error ();
+
+  step = 6;
+
+  grt_stack_switch (grt_stack_main_stack, stack1);
+
+  if (step != 7)
+    error ();
+
+  step = 8;
+
+  grt_stack_switch (stack2, stack1);
+
+  if (step != 9)
+    error ();
+
+  step = 10;
+
+  grt_stack_switch (grt_stack_main_stack, stack1);
+
+  error ();
+}
+
+static void
+func2 (void *ptr)
+{
+  if (ptr != (void *)2)
+    error ();
+
+  if (step == 11)
+    {
+      step = 12;
+
+      grt_stack_switch (grt_stack_main_stack, stack2);
+
+      error ();
+    }
+
+  if (step != 1)
+    error ();
+
+  step = 2;
+
+  grt_stack_switch (grt_stack_main_stack, stack2);
+
+  if (step != 3)
+    error ();
+
+  step = 4;
+
+  grt_stack_switch (grt_stack_main_stack, stack2);
+
+  if (step != 8)
+    error ();
+
+  step = 9;
+
+  grt_stack_switch (stack1, stack2);
+}
+
+int
+main (void)
+{
+  grt_stack_init ();
+
+  stack1 = grt_stack_create (&func1, (void *)1);
+  stack2 = grt_stack_create (&func2, (void *)2);
+
+  step = 0;
+  grt_stack_switch (stack1, grt_stack_main_stack);
+
+  if (step != 1)
+    error ();
+
+  grt_stack_switch (stack2, grt_stack_main_stack);
+
+  if (step != 2)
+    error ();
+
+  step = 3;
+
+  grt_stack_switch (stack2, grt_stack_main_stack);
+
+  if (step != 4)
+    error ();
+
+  step = 5;
+
+  grt_stack_switch (stack1, grt_stack_main_stack);
+
+  if (step != 6)
+    error ();
+
+  step = 7;
+
+  grt_stack_switch (stack1, grt_stack_main_stack);
+
+  if (step != 10)
+    error ();
+
+  step = 11;
+
+  grt_stack_switch (stack2, grt_stack_main_stack);
+
+  if (step != 12)
+    error ();
+
+  printf ("Test successful\n");
+  return 0;
+}
diff --git a/src/translate/grt/config/times.c b/src/translate/grt/config/times.c
new file mode 100644
index 000000000..9c0b4ebba
--- /dev/null
+++ b/src/translate/grt/config/times.c
@@ -0,0 +1,55 @@
+/*  GRT C bindings for time.
+    Copyright (C) 2002 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+#include <sys/times.h>
+#include <unistd.h>
+
+int
+grt_get_clk_tck (void)
+{
+  return sysconf (_SC_CLK_TCK);
+}
+
+void
+grt_get_times (int *wall, int *user, int *sys)
+{
+  clock_t res;
+  struct tms buf;
+
+  res = times (&buf);
+  if (res == (clock_t)-1)
+    {
+      *wall = 0;
+      *user = 0;
+      *sys = 0;
+    }
+  else
+    {
+      *wall = res;
+      *user = buf.tms_utime;
+      *sys = buf.tms_stime;
+    }
+}
+
diff --git a/src/translate/grt/config/win32.c b/src/translate/grt/config/win32.c
new file mode 100644
index 000000000..35322ba9f
--- /dev/null
+++ b/src/translate/grt/config/win32.c
@@ -0,0 +1,265 @@
+/*  GRT stack implementation for Win32 using fibers.
+    Copyright (C) 2005 - 2014 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.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+
+#include <windows.h>
+#include <stdio.h>
+#include <setjmp.h>
+#include <assert.h>
+#include <excpt.h>
+
+static EXCEPTION_DISPOSITION
+ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
+		  void *EstablisherFrame,
+		  struct _CONTEXT* ContextRecord,
+		  void *DispatcherContext);
+
+struct exception_registration
+{
+  struct exception_registration *prev;
+  void *handler;
+};
+
+struct stack_type
+{
+  LPVOID fiber; //  Win fiber.
+  void (*func)(void *);  // Function
+  void *arg; //  Function argument.
+};
+
+static struct stack_type main_stack_context;
+static struct stack_type *current;
+extern void grt_set_main_stack (struct stack_type *stack);
+
+void grt_stack_init(void)
+{
+  main_stack_context.fiber = ConvertThreadToFiber (NULL);
+  if (main_stack_context.fiber == NULL)
+    {
+      fprintf (stderr, "convertThreadToFiber failed (err=%lu)\n",
+	       GetLastError ());
+      abort ();
+    }
+  grt_set_main_stack (&main_stack_context);
+  current = &main_stack_context;
+}
+
+static VOID __stdcall
+grt_stack_loop (void *v_stack)
+{
+  struct stack_type *stack = (struct stack_type *)v_stack;
+  struct exception_registration er;
+  struct exception_registration *prev;
+
+  /* Get current handler.  */
+  asm ("mov %%fs:(0),%0" : "=r" (prev));
+
+  /* Build regisration.  */
+  er.prev = prev;
+  er.handler = ghdl_SEH_handler;
+
+  /* Register.  */
+  asm ("mov %0,%%fs:(0)" : : "r" (&er));
+
+  while (1)
+    {
+      (*stack->func)(stack->arg);
+    }
+}
+
+struct stack_type *
+grt_stack_create (void (*func)(void *), void *arg) 
+{
+  struct stack_type *res;
+
+  res = malloc (sizeof (struct stack_type));
+  if (res == NULL)
+    return NULL;
+  res->func = func;
+  res->arg = arg;
+  res->fiber = CreateFiber (0, &grt_stack_loop, res);
+  if (res->fiber == NULL)
+    {
+      free (res);
+      return NULL;
+    }
+  return res;
+}
+
+static int run_env_en;
+static jmp_buf run_env;
+static int need_longjmp;
+
+void
+grt_stack_switch (struct stack_type *to, struct stack_type *from)
+{
+  assert (current == from);
+  current = to;
+  SwitchToFiber (to->fiber);
+  if (from == &main_stack_context && need_longjmp)
+    {
+      /* We returned to do the longjump.  */
+      current = &main_stack_context;
+      longjmp (run_env, need_longjmp);
+    }
+}
+
+void
+grt_stack_delete (struct stack_type *stack)
+{
+  DeleteFiber (stack->fiber);
+  stack->fiber = NULL;
+}
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (!run_env_en)
+    return;
+
+  if (current != &main_stack_context)
+    {
+      /* We are allowed to jump only in the same stack.
+	 First switch back to the main thread.  */
+      need_longjmp = val;
+      SwitchToFiber (main_stack_context.fiber);
+    }
+  else
+    longjmp (run_env, val);
+}
+
+extern void grt_stack_error_grow_failed (void);
+extern void grt_stack_error_null_access (void);
+extern void grt_stack_error_memory_access (void);
+extern void grt_overflow_error (void);
+
+static EXCEPTION_DISPOSITION
+ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
+		  void *EstablisherFrame,
+		  struct _CONTEXT* ContextRecord,
+		  void *DispatcherContext)
+{
+  const char *msg = "";
+
+  switch (ExceptionRecord->ExceptionCode)
+    {
+    case EXCEPTION_ACCESS_VIOLATION:
+      if (ExceptionRecord->ExceptionInformation[1] == 0)
+	grt_stack_error_null_access ();
+      else
+	grt_stack_error_memory_access ();
+      break;
+          
+    case EXCEPTION_FLT_DENORMAL_OPERAND:
+    case EXCEPTION_FLT_DIVIDE_BY_ZERO:
+    case EXCEPTION_FLT_INVALID_OPERATION:
+    case EXCEPTION_FLT_OVERFLOW:
+    case EXCEPTION_FLT_STACK_CHECK:
+    case EXCEPTION_FLT_UNDERFLOW:
+      msg = "floating point error";
+      break;
+     
+    case EXCEPTION_INT_DIVIDE_BY_ZERO:
+      msg = "division by 0";
+      break;
+     
+    case EXCEPTION_INT_OVERFLOW:
+      grt_overflow_error ();
+      break;
+           
+    case EXCEPTION_STACK_OVERFLOW:
+      msg = "stack overflow";
+      break;
+     
+    default:
+      msg = "unknown reason";
+      break;
+    }
+
+  /* FIXME: is it correct?  */
+  fprintf (stderr, "exception raised: %s\n", msg);
+
+  __ghdl_maybe_return_via_longjump (1);
+  return 0; /* This is never reached, avoid compiler warning  */
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+  struct exception_registration er;
+  struct exception_registration *prev;
+
+  /* Get current handler.  */
+  asm ("mov %%fs:(0),%0" : "=r" (prev));
+
+  /* Build regisration.  */
+  er.prev = prev;
+  er.handler = ghdl_SEH_handler;
+
+  /* Register.  */
+  asm ("mov %0,%%fs:(0)" : : "r" (&er));
+
+  run_env_en = 1;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+
+  /* Restore.  */
+  asm ("mov %0,%%fs:(0)" : : "r" (prev));
+
+  return res;
+}
+
+#include <math.h>
+
+double acosh (double x)
+{
+  return log (x + sqrt (x*x - 1));
+}
+
+double asinh (double x)
+{
+  return log (x + sqrt (x*x + 1));
+}
+
+double atanh (double x)
+{
+  return log ((1 + x) / (1 - x)) / 2;
+}
+
+#ifndef WITH_GNAT_RUN_TIME
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+#endif
+
diff --git a/src/translate/grt/config/win32thr.c b/src/translate/grt/config/win32thr.c
new file mode 100644
index 000000000..bcebc49d5
--- /dev/null
+++ b/src/translate/grt/config/win32thr.c
@@ -0,0 +1,167 @@
+/*  GRT stack implementation for Win32
+    Copyright (C) 2004, 2005 Felix Bertram.
+
+    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.
+*/
+//-----------------------------------------------------------------------------
+// Project:     GHDL - VHDL Simulator
+// Description: Win32 port of stacks package
+// Note:        Tristan's original i386/Linux used assembly-code 
+//              to manually switch stacks for performance reasons.
+// History:     2004feb09, FB, created.
+//-----------------------------------------------------------------------------
+
+#include <windows.h>
+//#include <pthread.h>
+//#include <stdlib.h>
+//#include <stdio.h>
+
+
+//#define INFO printf
+#define INFO (void)
+
+// GHDL names an endless loop calling FUNC with ARG a 'stack'
+// at a given time, only one stack may be 'executed'
+typedef struct 
+{	HANDLE              thread;         // stack's thread
+	HANDLE              mutex;          // mutex to suspend/resume thread
+	void                (*Func)(void*); // stack's FUNC
+	void*               Arg;            // ARG passed to FUNC
+} Stack_Type_t, *Stack_Type;
+
+
+static Stack_Type_t      main_stack_context;
+extern void grt_set_main_stack (Stack_Type_t *stack);
+
+//------------------------------------------------------------------------------
+void grt_stack_init(void)
+// Initialize the stacks package.
+// This may adjust stack sizes.
+// Must be called after grt.options.decode.
+// => procedure Stack_Init;
+{	INFO("grt_stack_init\n");
+	INFO("  main_stack_context=0x%08x\n", &main_stack_context);
+
+	// create event. reset event, as we are currently running
+	main_stack_context.mutex = CreateEvent(NULL,  // lpsa
+	                                       FALSE, // fManualReset
+	                                       FALSE, // fInitialState
+	                                       NULL); // lpszEventName
+
+	grt_set_main_stack (&main_stack_context);
+}
+
+//------------------------------------------------------------------------------
+static unsigned long __stdcall grt_stack_loop(void* pv_myStack)
+{
+	Stack_Type myStack= (Stack_Type)pv_myStack;
+
+	INFO("grt_stack_loop\n");
+	
+	INFO("  myStack=0x%08x\n", myStack);
+
+	// block until event becomes set again.
+	// this happens when this stack is enabled for the first time
+	WaitForSingleObject(myStack->mutex, INFINITE);
+	
+	// run stack's function in endless loop
+	while(1)
+	{	INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
+		myStack->Func(myStack->Arg);
+	}
+	
+	// we never get here...
+	return 0;
+}
+
+//------------------------------------------------------------------------------
+Stack_Type grt_stack_create(void* Func, void* Arg) 
+// Create a new stack, which on first execution will call FUNC with
+// an argument ARG.
+// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
+{  	Stack_Type newStack;
+	DWORD      m_IDThread; // Thread's ID (dummy)
+
+	INFO("grt_stack_create\n");
+	INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
+			
+	newStack= malloc(sizeof(Stack_Type_t));
+	
+	// init function and argument
+	newStack->Func= Func;
+	newStack->Arg=  Arg;
+	
+	// create event. reset event, so that thread will blocked in grt_stack_loop
+	newStack->mutex= CreateEvent(NULL,  // lpsa
+	                             FALSE, // fManualReset
+	                             FALSE, // fInitialState
+	                             NULL); // lpszEventName
+	
+	INFO("  newStack=0x%08x\n", newStack);
+	
+	// create thread, which executes grt_stack_loop
+	newStack->thread= CreateThread(NULL,           // lpsa
+	                               0,              // cbStack
+	                               grt_stack_loop, // lpStartAddr
+	                               newStack,       // lpvThreadParm
+	                               0,              // fdwCreate
+	                               &m_IDThread);   // lpIDThread
+	
+	return newStack;
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_switch(Stack_Type To, Stack_Type From)
+// Resume stack TO and save the current context to the stack pointed by
+// CUR.
+// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
+{	INFO("grt_stack_switch\n");
+	INFO("  from 0x%08x to 0x%08x\n", From, To);
+	
+	// set 'To' event. this will make the other thread either
+	// - start for first time in grt_stack_loop
+	// - resume at WaitForSingleObject below
+	SetEvent(To->mutex);
+		
+	// block until 'From' event becomes set again
+	// as we are running, our event is reset and we block here
+	// when stacks are switched, with above SetEvent, we may proceed
+	WaitForSingleObject(From->mutex, INFINITE);
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_delete(Stack_Type Stack)
+// Delete stack STACK, which must not be currently executed.
+// => procedure Stack_Delete (Stack : Stack_Type);
+{	INFO("grt_stack_delete\n");
+}
+
+//----------------------------------------------------------------------------
+#ifndef WITH_GNAT_RUN_TIME
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+#endif
+
+//----------------------------------------------------------------------------
+// end of file
+
diff --git a/src/translate/grt/ghdl_main.adb b/src/translate/grt/ghdl_main.adb
new file mode 100644
index 000000000..ce5b67d7e
--- /dev/null
+++ b/src/translate/grt/ghdl_main.adb
@@ -0,0 +1,61 @@
+--  GHDL Run Time (GRT) entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Ada.Unchecked_Conversion;
+with Grt.Options; use Grt.Options;
+with Grt.Main;
+with Grt.Types; use Grt.Types;
+
+--  Some files are only referenced from compiled code.  With it here so that
+--  they get compiled during build (and elaborated).
+pragma Warnings (Off);
+with Grt.Rtis_Binding;
+with Grt.Std_Logic_1164;
+pragma Warnings (On);
+
+
+function Ghdl_Main (Argc : Integer; Argv : System.Address)
+                   return Integer
+is
+   --  Grt_Init corresponds to the 'adainit' subprogram for grt.
+   procedure Grt_Init;
+   pragma Import (C, Grt_Init, "grt_init");
+
+   function To_Argv_Type is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Grt.Options.Argv_Type);
+
+   Default_Progname : constant String := "ghdl_design" & NUL;
+begin
+   if Argc > 0 then
+      Grt.Options.Progname := To_Argv_Type (Argv)(0);
+   else
+      Grt.Options.Progname := To_Ghdl_C_String (Default_Progname'Address);
+   end if;
+   Grt.Options.Argc := Argc;
+   Grt.Options.Argv := To_Argv_Type (Argv);
+
+   Grt_Init;
+   Grt.Main.Run;
+   return 0;
+end Ghdl_Main;
diff --git a/src/translate/grt/ghdl_main.ads b/src/translate/grt/ghdl_main.ads
new file mode 100644
index 000000000..88d181a0a
--- /dev/null
+++ b/src/translate/grt/ghdl_main.ads
@@ -0,0 +1,33 @@
+--  GHDL Run Time (GRT) entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+
+--  'main' function for grt.
+--  Contrary to the C main function, ARGC can be 0 (in this case a fake argv[0]
+--  is used).
+function Ghdl_Main (Argc : Integer; Argv : System.Address)
+                   return Integer;
+pragma Export (C, Ghdl_Main, "ghdl_main");
+
diff --git a/src/translate/grt/ghwdump.c b/src/translate/grt/ghwdump.c
new file mode 100644
index 000000000..4affc2b5c
--- /dev/null
+++ b/src/translate/grt/ghwdump.c
@@ -0,0 +1,195 @@
+/*  Display a GHDL Wavefile for debugging.
+    Copyright (C) 2005 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.
+*/
+
+#include <stdio.h>
+#include <stdint.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include "ghwlib.h"
+
+static const char *progname;
+void
+usage (void)
+{
+  printf ("usage: %s [OPTIONS] FILEs...\n", progname);
+  printf ("Options are:\n"
+	  " -t  display types\n"
+	  " -h  display hierarchy\n"
+	  " -T  display time\n"
+	  " -s  display signals (and time)\n"
+	  " -l  display list of sections\n"
+	  " -v  verbose\n");
+}
+
+int
+main (int argc, char **argv)
+{
+  int i;
+  int flag_disp_types;
+  int flag_disp_hierarchy;
+  int flag_disp_time;
+  int flag_disp_signals;
+  int flag_list;
+  int flag_verbose;
+  int eof;
+  enum ghw_sm_type sm;
+
+  progname = argv[0];
+  flag_disp_types = 0;
+  flag_disp_hierarchy = 0;
+  flag_disp_time = 0;
+  flag_disp_signals = 0;
+  flag_list = 0;
+  flag_verbose = 0;
+
+  while (1)
+    {
+      int c;
+
+      c = getopt (argc, argv, "thTslv");
+      if (c == -1)
+	break;
+      switch (c)
+	{
+	case 't':
+	  flag_disp_types = 1;
+	  break;
+	case 'h':
+	  flag_disp_hierarchy = 1;
+	  break;
+	case 'T':
+	  flag_disp_time = 1;
+	  break;
+	case 's':
+	  flag_disp_signals = 1;
+	  flag_disp_time = 1;
+	  break;
+	case 'l':
+	  flag_list = 1;
+	  break;
+	case 'v':
+	  flag_verbose++;
+	  break;
+	default:
+	  usage ();
+	  exit (2);
+	}
+    }
+
+  if (optind >= argc)
+    {
+      usage ();
+      return 1;
+    }
+
+  for (i = optind; i < argc; i++)
+    {
+      struct ghw_handler h;
+      struct ghw_handler *hp = &h;
+
+      hp->flag_verbose = flag_verbose;
+
+      if (ghw_open (hp, argv[i]) != 0)
+	{
+	  fprintf (stderr, "cannot open ghw file %s\n", argv[i]);
+	  return 1;
+	}
+      if (flag_list)
+	{
+	  while (1)
+	    {
+	      int section;
+
+	      section = ghw_read_section (hp);
+	      if (section == -2)
+		{
+		  printf ("eof of file\n");
+		  break;
+		}
+	      else if (section < 0)
+		{
+		  printf ("Error in file\n");
+		  break;
+		}
+	      else if (section == 0)
+		{
+		  printf ("Unknown section\n");
+		  break;
+		}
+	      printf ("Section %s\n", ghw_sections[section].name);
+	      if ((*ghw_sections[section].handler)(hp) < 0)
+		break;
+	    }
+	}
+      else
+	{
+	  if (ghw_read_base (hp) < 0)
+	    {
+	      fprintf (stderr, "cannot read ghw file\n");
+	      return 2;
+	    }
+	  if (0)
+	    {
+	      int i;
+	      printf ("String table:\n");
+	      
+	      for (i = 1; i < hp->nbr_str; i++)
+		printf (" %s\n", hp->str_table[i]);
+	    }
+	  if (flag_disp_types)
+	    ghw_disp_types (hp);
+	  if (flag_disp_hierarchy)
+	    ghw_disp_hie (hp, hp->hie);
+	  
+#if 1
+	  sm = ghw_sm_init;
+	  eof = 0;
+	  while (!eof)
+	    {
+	      switch (ghw_read_sm (hp, &sm))
+		{
+		case ghw_res_snapshot:
+		case ghw_res_cycle:
+		  if (flag_disp_time)
+		    printf ("Time is %lld fs\n", hp->snap_time);
+		  if (flag_disp_signals)
+		    ghw_disp_values (hp);
+		  break;
+		case ghw_res_eof:
+		  eof = 1;
+		  break;
+		default:
+		  abort ();
+		}
+	    }
+	  
+#else
+	  if (ghw_read_dump (hp) < 0)
+	    {
+	      fprintf (stderr, "error in ghw dump\n");
+	      return 3;
+	    }
+#endif
+	}
+      ghw_close (&h);
+    }
+  return 0;
+}
diff --git a/src/translate/grt/ghwlib.c b/src/translate/grt/ghwlib.c
new file mode 100644
index 000000000..2db63d9c9
--- /dev/null
+++ b/src/translate/grt/ghwlib.c
@@ -0,0 +1,1746 @@
+/*  GHDL Wavefile reader library.
+    Copyright (C) 2005 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.
+*/
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include "ghwlib.h"
+
+int
+ghw_open (struct ghw_handler *h, const char *filename)
+{
+  char hdr[16];
+
+  h->stream = fopen (filename, "rb");
+  if (h->stream == NULL)
+    return -1;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+  /* Check magic.  */
+  if (memcmp (hdr, "GHDLwave\n", 9) != 0)
+    return -2;
+  /* Check version.  */
+  if (hdr[9] != 16
+      || hdr[10] != 0)
+    return -2;
+  h->version = hdr[11];
+  if (h->version > 1)
+    return -3;
+  if (hdr[12] == 1)
+    h->word_be = 0;
+  else if (hdr[12] == 2)
+    h->word_be = 1;
+  else
+    return -4;
+#if 0
+  /* Endianness.  */
+  {
+    int endian;
+    union { unsigned char b[4]; uint32_t i;} v;
+    v.i = 0x11223344;
+    if (v.b[0] == 0x11)
+      endian = 2;
+    else if (v.b[0] == 0x44)
+      endian = 1;
+    else
+      return -3;
+
+    if (hdr[12] != 1 && hdr[12] != 2)
+      return -3;
+    if (hdr[12] != endian)
+      h->swap_word = 1;
+    else
+      h->swap_word = 0;
+  }
+#endif
+  h->word_len = hdr[13];
+  h->off_len = hdr[14];
+
+  if (hdr[15] != 0)
+    return -5;
+
+  h->hie = NULL;
+  return 0;
+}
+
+int32_t
+ghw_get_i32 (struct ghw_handler *h, unsigned char *b)
+{
+  if (h->word_be)
+    return (b[0] << 24) | (b[1] << 16) | (b[2] << 8) | (b[3] << 0);
+  else
+    return (b[3] << 24) | (b[2] << 16) | (b[1] << 8) | (b[0] << 0);
+}
+
+int64_t
+ghw_get_i64 (struct ghw_handler *ghw_h, unsigned char *b)
+{
+  int l, h;
+
+  if (ghw_h->word_be)
+    {
+      h = (b[0] << 24) | (b[1] << 16) | (b[2] << 8) | (b[3] << 0);
+      l = (b[4] << 24) | (b[5] << 16) | (b[6] << 8) | (b[7] << 0);
+    }
+  else
+    {
+      l = (b[3] << 24) | (b[2] << 16) | (b[1] << 8) | (b[0] << 0);
+      h = (b[7] << 24) | (b[6] << 16) | (b[5] << 8) | (b[4] << 0);
+    }
+  return (((int64_t)h) << 32) | l;
+}
+
+int
+ghw_read_byte (struct ghw_handler *h, unsigned char *res)
+{
+  int v;
+
+  v = fgetc (h->stream);
+  if (v == EOF)
+    return -1;
+  *res = v;
+  return 0;
+}
+
+int
+ghw_read_uleb128 (struct ghw_handler *h, uint32_t *res)
+{
+  unsigned int r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= (v & 0x7f) << off;
+      if ((v & 0x80) == 0)
+	break;
+      off += 7;
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_sleb128 (struct ghw_handler *h, int32_t *res)
+{
+  int32_t r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= ((int32_t)(v & 0x7f)) << off;
+      off += 7;
+      if ((v & 0x80) == 0)
+	{
+	  if ((v & 0x40) && off < 32)
+	    r |= -1 << off;
+	  break;
+	}
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_lsleb128 (struct ghw_handler *h, int64_t *res)
+{
+  static const int64_t r_mask = -1;
+  int64_t r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= ((int64_t)(v & 0x7f)) << off;
+      off += 7;
+      if ((v & 0x80) == 0)
+	{
+	  if ((v & 0x40) && off < 64)
+	    r |= r_mask << off;
+	  break;
+	}
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_f64 (struct ghw_handler *h, double *res)
+{
+  /* FIXME: handle byte order.  */
+  if (fread (res, sizeof (*res), 1, h->stream) != 1)
+    return -1;
+  return 0;
+}
+
+const char *
+ghw_read_strid (struct ghw_handler *h)
+{
+  unsigned int id;
+  if (ghw_read_uleb128 (h, &id) != 0)
+    return NULL;
+  return h->str_table[id];
+}
+
+union ghw_type *
+ghw_read_typeid (struct ghw_handler *h)
+{
+  unsigned int id;
+  if (ghw_read_uleb128 (h, &id) != 0)
+    return NULL;
+  return h->types[id - 1];
+}
+
+union ghw_range *
+ghw_read_range (struct ghw_handler *h)
+{
+  int t = fgetc (h->stream);
+  if (t == EOF)
+    return NULL;
+  switch (t & 0x7f)
+    {
+    case ghdl_rtik_type_b2:
+      {
+	struct ghw_range_b2 *r;
+	r = malloc (sizeof (struct ghw_range_b2));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_byte (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_byte (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_e8:
+      {
+	struct ghw_range_e8 *r;
+	r = malloc (sizeof (struct ghw_range_e8));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_byte (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_byte (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      {
+	struct ghw_range_i32 *r;
+	r = malloc (sizeof (struct ghw_range_i32));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_sleb128 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_sleb128 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_p64:
+      {
+	struct ghw_range_i64 *r;
+	r = malloc (sizeof (struct ghw_range_i64));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_lsleb128 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_lsleb128 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_f64:
+      {
+	struct ghw_range_f64 *r;
+	r = malloc (sizeof (struct ghw_range_f64));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_f64 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_f64 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    default:
+      fprintf (stderr, "ghw_read_range: type %d unhandled\n", t & 0x7f);
+      return NULL;
+    }
+}
+
+int
+ghw_read_str (struct ghw_handler *h)
+{
+  unsigned char hdr[12];
+  int i;
+  char *p;
+  int prev_len;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->nbr_str = ghw_get_i32 (h, &hdr[4]);
+  h->nbr_str++;
+  h->str_size = ghw_get_i32 (h, &hdr[8]);
+  h->str_table = (char **)malloc ((h->nbr_str + 1) * sizeof (char *));
+  h->str_content = (char *)malloc (h->str_size + h->nbr_str + 1);
+
+  if (h->flag_verbose)
+    {
+      printf ("Number of strings: %d\n", h->nbr_str - 1);
+      printf ("String table size: %d\n", h->str_size);
+    }
+
+  h->str_table[0] = "<anon>";
+  p = h->str_content;
+  prev_len = 0;
+  for (i = 1; i < h->nbr_str; i++)
+    {
+      int j;
+      int c;
+      char *prev;
+      int sh;
+
+      h->str_table[i] = p;
+      prev = h->str_table[i - 1];
+      for (j = 0; j < prev_len; j++)
+	*p++ = prev[j];
+
+      while (1)
+	{
+	  c = fgetc (h->stream);
+	  if (c == EOF)
+	    return -1;
+	  if ((c >= 0 && c <= 31)
+	      || (c >= 128 && c <= 159))
+	    break;
+	  *p++ = c;
+	}
+      *p++ = 0;
+
+      if (h->flag_verbose > 1)
+	printf (" string %d (pl=%d): %s\n", i, prev_len, h->str_table[i]);
+
+      prev_len = c & 0x1f;
+      sh = 5;
+      while (c >= 128)
+	{
+	  c = fgetc (h->stream);
+	  if (c == EOF)
+	    return -1;
+	  prev_len |= (c & 0x1f) << sh;
+	  sh += 5;
+	}
+    }
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "EOS", 4) != 0)
+    return -1;
+  return 0;
+}
+
+union ghw_type *
+ghw_get_base_type (union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_f64:
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+      return t;
+    case ghdl_rtik_subtype_scalar:
+      return t->ss.base;
+    case ghdl_rtik_subtype_array:
+      return (union ghw_type*)(t->sa.base);
+    default:
+      fprintf (stderr, "ghw_get_base_type: cannot handle type %d\n", t->kind);
+      abort ();
+    }
+}
+
+int
+get_nbr_elements (union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_f64:
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+    case ghdl_rtik_subtype_scalar:
+      return 1;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      return t->sa.nbr_el;
+    case ghdl_rtik_type_record:
+      return t->rec.nbr_el;
+    default:
+      fprintf (stderr, "get_nbr_elements: unhandled type %d\n", t->kind);
+      abort ();
+    }
+}
+
+int
+get_range_length (union ghw_range *rng)
+{
+  switch (rng->kind)
+    {
+    case ghdl_rtik_type_i32:
+      if (rng->i32.dir)
+	return (rng->i32.left - rng->i32.right + 1);
+      else
+	return (rng->i32.right - rng->i32.left + 1);
+    default:
+      fprintf (stderr, "get_range_length: unhandled kind %d\n", rng->kind);
+      abort ();
+    }
+}
+
+int
+ghw_read_type (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->nbr_types = ghw_get_i32 (h, &hdr[4]);
+  h->types = (union ghw_type **)
+    malloc (h->nbr_types * sizeof (union ghw_type *));
+
+  for (i = 0; i < h->nbr_types; i++)
+    {
+      int t;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      /* printf ("type[%d]= %d\n", i, t); */
+      switch (t)
+	{
+	case ghdl_rtik_type_b2:
+	case ghdl_rtik_type_e8:
+	  {
+	    struct ghw_type_enum *e;
+	    int j;
+
+	    e = malloc (sizeof (struct ghw_type_enum));
+	    e->kind = t;
+	    e->wkt = ghw_wkt_unknown;
+	    e->name = ghw_read_strid (h);
+	    if (ghw_read_uleb128 (h, &e->nbr) != 0)
+	      return -1;
+	    e->lits = (const char **) malloc (e->nbr * sizeof (char *));
+	    if (h->flag_verbose > 1)
+	      printf ("enum %s:", e->name);
+	    for (j = 0; j < e->nbr; j++)
+	      {
+		e->lits[j] = ghw_read_strid (h);
+		if (h->flag_verbose > 1)
+		  printf (" %s", e->lits[j]);
+	      }
+	    if (h->flag_verbose > 1)
+	      printf ("\n");
+	    h->types[i] = (union ghw_type *)e;
+	  }
+	  break;
+	case ghdl_rtik_type_i32:
+	case ghdl_rtik_type_i64:
+	case ghdl_rtik_type_f64:
+	  {
+	    struct ghw_type_scalar *sc;
+
+	    sc = malloc (sizeof (struct ghw_type_scalar));
+	    sc->kind = t;
+	    sc->name = ghw_read_strid (h);
+	    if (h->flag_verbose > 1)
+	      printf ("scalar: %s\n", sc->name);
+	    h->types[i] = (union ghw_type *)sc;
+	  }
+	  break;
+	case ghdl_rtik_type_p32:
+	case ghdl_rtik_type_p64:
+	  {
+	    struct ghw_type_physical *ph;
+
+	    ph = malloc (sizeof (struct ghw_type_physical));
+	    ph->kind = t;
+	    ph->name = ghw_read_strid (h);
+	    if (h->version == 0)
+	      ph->nbr_units = 0;
+	    else
+	      {
+		int i;
+
+		if (ghw_read_uleb128 (h, &ph->nbr_units) != 0)
+		  return -1;
+		ph->units = malloc (ph->nbr_units * sizeof (struct ghw_unit));
+		for (i = 0; i < ph->nbr_units; i++)
+		  {
+		    ph->units[i].name = ghw_read_strid (h);
+		    if (ghw_read_lsleb128 (h, &ph->units[i].val) < 0)
+		      return -1;
+		  }
+	      }
+	    if (h->flag_verbose > 1)
+	      printf ("physical: %s\n", ph->name);
+	    h->types[i] = (union ghw_type *)ph;
+	  }
+	  break;
+	case ghdl_rtik_subtype_scalar:
+	  {
+	    struct ghw_subtype_scalar *ss;
+
+	    ss = malloc (sizeof (struct ghw_subtype_scalar));
+	    ss->kind = t;
+	    ss->name = ghw_read_strid (h);
+	    ss->base = ghw_read_typeid (h);
+	    ss->rng = ghw_read_range (h);
+	    if (h->flag_verbose > 1)
+	      printf ("subtype scalar: %s\n", ss->name);
+	    h->types[i] = (union ghw_type *)ss;
+	  }
+	  break;
+	case ghdl_rtik_type_array:
+	  {
+	    struct ghw_type_array *arr;
+	    int j;
+
+	    arr = malloc (sizeof (struct ghw_type_array));
+	    arr->kind = t;
+	    arr->name = ghw_read_strid (h);
+	    arr->el = ghw_read_typeid (h);
+	    if (ghw_read_uleb128 (h, &arr->nbr_dim) != 0)
+	      return -1;
+	    arr->dims = (union ghw_type **)
+	      malloc (arr->nbr_dim * sizeof (union ghw_type *));
+	    for (j = 0; j < arr->nbr_dim; j++)
+	      arr->dims[j] = ghw_read_typeid (h);
+	    if (h->flag_verbose > 1)
+	      printf ("array: %s\n", arr->name);
+	    h->types[i] = (union ghw_type *)arr;
+	  }
+	  break;
+	case ghdl_rtik_subtype_array:
+	case ghdl_rtik_subtype_array_ptr:
+	  {
+	    struct ghw_subtype_array *sa;
+	    int j;
+	    int nbr_el;
+
+	    sa = malloc (sizeof (struct ghw_subtype_array));
+	    sa->kind = t;
+	    sa->name = ghw_read_strid (h);
+	    sa->base = (struct ghw_type_array *)ghw_read_typeid (h);
+	    nbr_el = get_nbr_elements (sa->base->el);
+	    sa->rngs = malloc (sa->base->nbr_dim * sizeof (union ghw_range *));
+	    for (j = 0; j < sa->base->nbr_dim; j++)
+	      {
+		sa->rngs[j] = ghw_read_range (h);
+		nbr_el *= get_range_length (sa->rngs[j]);
+	      }
+	    sa->nbr_el = nbr_el;
+	    if (h->flag_verbose > 1)
+	      printf ("subtype array: %s (nbr_el=%d)\n", sa->name, sa->nbr_el);
+	    h->types[i] = (union ghw_type *)sa;
+	  }
+	  break;
+	case ghdl_rtik_type_record:
+	  {
+	    struct ghw_type_record *rec;
+	    int j;
+	    int nbr_el;
+
+	    rec = malloc (sizeof (struct ghw_type_record));
+	    rec->kind = t;
+	    rec->name = ghw_read_strid (h);
+	    if (ghw_read_uleb128 (h, &rec->nbr_fields) != 0)
+	      return -1;
+	    rec->el = malloc
+	      (rec->nbr_fields * sizeof (struct ghw_record_element));
+	    nbr_el = 0;
+	    for (j = 0; j < rec->nbr_fields; j++)
+	      {
+		rec->el[j].name = ghw_read_strid (h);
+		rec->el[j].type = ghw_read_typeid (h);
+		nbr_el += get_nbr_elements (rec->el[j].type);
+	      }
+	    rec->nbr_el = nbr_el;
+	    if (h->flag_verbose > 1)
+	      printf ("record type: %s (nbr_el=%d)\n", rec->name, rec->nbr_el);
+	    h->types[i] = (union ghw_type *)rec;
+	  }
+	  break;
+	default:
+	  fprintf (stderr, "ghw_read_type: unknown type %d\n", t);
+	  return -1;
+	}
+    }
+  if (fgetc (h->stream) != 0)
+    return -1;
+  return 0;
+}
+
+int
+ghw_read_wk_types (struct ghw_handler *h)
+{
+  char hdr[4];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+
+  while (1)
+    {
+      int t;
+      union ghw_type *tid;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      else if (t == 0)
+	break;
+
+      tid = ghw_read_typeid (h);
+      if (tid->kind == ghdl_rtik_type_b2
+	  || tid->kind == ghdl_rtik_type_e8)
+	{
+	  if (h->flag_verbose > 0)
+	    printf ("%s: wkt=%d\n", tid->en.name, t);
+	  tid->en.wkt = t;
+	}
+    }
+  return 0;
+}
+
+void
+ghw_disp_typename (struct ghw_handler *h, union ghw_type *t)
+{
+  printf ("%s", t->common.name);
+}
+
+/* Read a signal composed of severals elements.  */
+int
+ghw_read_signal (struct ghw_handler *h, unsigned int *sigs, union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_subtype_scalar:
+      {
+	unsigned int sig_el;
+
+	if (ghw_read_uleb128 (h, &sig_el) < 0)
+	  return -1;
+	*sigs = sig_el;
+	if (sig_el >= h->nbr_sigs)
+	  abort ();
+	if (h->sigs[sig_el].type == NULL)
+	  h->sigs[sig_el].type = ghw_get_base_type (t);
+      }
+      return 0;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      {
+	int i;
+	int stride;
+	int len;
+
+	len = t->sa.nbr_el;
+	stride = get_nbr_elements (t->sa.base->el);
+
+	for (i = 0; i < len; i += stride)
+	  if (ghw_read_signal (h, &sigs[i], t->sa.base->el) < 0)
+	    return -1;
+      }
+      return 0;
+    case ghdl_rtik_type_record:
+      {
+	int i;
+	int off;
+	
+	off = 0;
+	for (i = 0; i < t->rec.nbr_fields; i++)
+	  {
+	    if (ghw_read_signal (h, &sigs[off], t->rec.el[i].type) < 0)
+	      return -1;
+	    off += get_nbr_elements (t->rec.el[i].type);
+	  }
+      }
+      return 0;
+    default:
+      fprintf (stderr, "ghw_read_signal: type kind %d unhandled\n", t->kind);
+      abort ();
+    }
+}
+
+
+int
+ghw_read_value (struct ghw_handler *h,
+		union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      {
+	int v;
+	v = fgetc (h->stream);
+	if (v == EOF)
+	  return -1;
+	val->b2 = v;
+      }
+      break;
+    case ghdl_rtik_type_e8:
+      {
+	int v;
+	v = fgetc (h->stream);
+	if (v == EOF)
+	  return -1;
+	val->e8 = v;
+      }
+      break;
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      {
+	int32_t v;
+	if (ghw_read_sleb128 (h, &v) < 0)
+	  return -1;
+	val->i32 = v;
+      }
+      break;
+    case ghdl_rtik_type_f64:
+      {
+	double v;
+	if (ghw_read_f64 (h, &v) < 0)
+	  return -1;
+	val->f64 = v;
+      }
+      break;
+    case ghdl_rtik_type_p64:
+      {
+	int64_t v;
+	if (ghw_read_lsleb128 (h, &v) < 0)
+	  return -1;
+	val->i64 = v;
+      }
+      break;
+    default:
+      fprintf (stderr, "read_value: cannot handle format %d\n", type->kind);
+      abort ();
+    }
+  return 0;
+}
+
+int
+ghw_read_hie (struct ghw_handler *h)
+{
+  unsigned char hdr[16];
+  int nbr_scopes;
+  int nbr_sigs;
+  int i;
+  struct ghw_hie *blk;
+  struct ghw_hie **last;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  nbr_scopes = ghw_get_i32 (h, &hdr[4]);
+  /* Number of declared signals (which may be composite).  */
+  nbr_sigs = ghw_get_i32 (h, &hdr[8]);
+  /* Number of basic signals.  */
+  h->nbr_sigs = ghw_get_i32 (h, &hdr[12]);
+
+  if (h->flag_verbose)
+    printf ("%d scopes, %d signals, %d signal elements\n",
+	    nbr_scopes, nbr_sigs, h->nbr_sigs);
+
+  blk = (struct ghw_hie *)malloc (sizeof (struct ghw_hie));
+  blk->kind = ghw_hie_design;
+  blk->name = NULL;
+  blk->parent = NULL;
+  blk->brother = NULL;
+  blk->u.blk.child = NULL;
+
+  last = &blk->u.blk.child;
+  h->hie = blk;
+
+  h->nbr_sigs++;
+  h->sigs = (struct ghw_sig *) malloc (h->nbr_sigs * sizeof (struct ghw_sig));
+  memset (h->sigs, 0, h->nbr_sigs * sizeof (struct ghw_sig));
+
+  while (1)
+    {
+      int t;
+      struct ghw_hie *el;
+      unsigned int str;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      if (t == 0)
+	break;
+
+      if (t == ghw_hie_eos)
+	{
+	  blk = blk->parent;
+	  if (blk->u.blk.child == NULL)
+	    last = &blk->u.blk.child;
+	  else
+	    {
+	      struct ghw_hie *l = blk->u.blk.child;
+	      while (l->brother != NULL)
+		l = l->brother;
+	      last = &l->brother;
+	    }
+
+	  continue;
+	}
+
+      el = (struct ghw_hie *) malloc (sizeof (struct ghw_hie));
+      el->kind = t;
+      el->parent = blk;
+      el->brother = NULL;
+
+      /* Link.  */
+      *last = el;
+      last = &el->brother;
+
+      /* Read name.  */
+      if (ghw_read_uleb128 (h, &str) != 0)
+	return -1;
+      el->name = h->str_table[str];
+
+      switch (t)
+	{
+	case ghw_hie_eoh:
+	case ghw_hie_design:
+	case ghw_hie_eos:
+	  /* Should not be here.  */
+	  abort ();
+	case ghw_hie_process:
+	  break;
+	case ghw_hie_block:
+	case ghw_hie_generate_if:
+	case ghw_hie_generate_for:
+	case ghw_hie_instance:
+	case ghw_hie_generic:
+	case ghw_hie_package:
+	  /* Create a block.  */
+	  el->u.blk.child = NULL;
+
+	  if (t == ghw_hie_generate_for)
+	    {
+	      el->u.blk.iter_type = ghw_read_typeid (h);
+	      el->u.blk.iter_value = malloc (sizeof (union ghw_val));
+	      if (ghw_read_value (h, el->u.blk.iter_value,
+				  el->u.blk.iter_type) < 0)
+		return -1;
+	    }
+	  blk = el;
+	  last = &el->u.blk.child;
+	  break;
+	case ghw_hie_signal:
+	case ghw_hie_port_in:
+	case ghw_hie_port_out:
+	case ghw_hie_port_inout:
+	case ghw_hie_port_buffer:
+	case ghw_hie_port_linkage:
+	  /* For a signal, read type.  */
+	  {
+	    int nbr_el;
+	    unsigned int *sigs;
+
+	    el->u.sig.type = ghw_read_typeid (h);
+	    nbr_el = get_nbr_elements (el->u.sig.type);
+	    sigs = (unsigned int *) malloc
+	      ((nbr_el + 1) * sizeof (unsigned int));
+	    el->u.sig.sigs = sigs;
+	    /* Last element is NULL.  */
+	    sigs[nbr_el] = 0;
+
+	    if (h->flag_verbose > 1)
+	      printf ("signal %s: %d el [", el->name, nbr_el);
+	    if (ghw_read_signal (h, sigs, el->u.sig.type) < 0)
+	      return -1;
+	    if (h->flag_verbose > 1)
+	      {
+		int i;
+		for (i = 0; i < nbr_el; i++)
+		  printf (" #%u", sigs[i]);
+		printf ("]\n");
+	      }
+	  }
+	  break;
+	default:
+	  fprintf (stderr, "ghw_read_hie: unhandled kind %d\n", t);
+	  abort ();
+	}
+    }
+
+  /* Allocate values.  */
+  for (i = 0; i < h->nbr_sigs; i++)
+    if (h->sigs[i].type != NULL)
+      h->sigs[i].val = (union ghw_val *) malloc (sizeof (union ghw_val));
+  return 0;
+}
+
+const char *
+ghw_get_hie_name (struct ghw_hie *h)
+{
+  switch (h->kind)
+    {
+    case ghw_hie_eoh:
+      return "eoh";
+    case ghw_hie_design:
+      return "design";
+    case ghw_hie_block:
+      return "block";
+    case ghw_hie_generate_if:
+      return "generate-if";
+    case ghw_hie_generate_for:
+      return "generate-for";
+    case ghw_hie_instance:
+      return "instance";
+    case ghw_hie_package:
+      return "package";
+    case ghw_hie_process:
+      return "process";
+    case ghw_hie_generic:
+      return "generic";
+    case ghw_hie_eos:
+      return "eos";
+    case ghw_hie_signal:
+      return "signal";
+    case ghw_hie_port_in:
+      return "port-in";
+    case ghw_hie_port_out:
+      return "port-out";
+    case ghw_hie_port_inout:
+      return "port-inout";
+    case ghw_hie_port_buffer:
+      return "port-buffer";
+    case ghw_hie_port_linkage:
+      return "port-linkage";
+    default:
+      return "??";
+    }
+}
+
+void
+ghw_disp_value (union ghw_val *val, union ghw_type *type);
+
+void
+ghw_disp_hie (struct ghw_handler *h, struct ghw_hie *top)
+{
+  int i;
+  int indent;
+  struct ghw_hie *hie;
+  struct ghw_hie *n;
+
+  hie = top;
+  indent = 0;
+  
+  while (1)
+    {
+      for (i = 0; i < indent; i++)
+	fputc (' ', stdout);
+      printf ("%s", ghw_get_hie_name (hie));
+
+      switch (hie->kind)
+	{
+	case ghw_hie_design:
+	case ghw_hie_block:
+	case ghw_hie_generate_if:
+	case ghw_hie_generate_for:
+	case ghw_hie_instance:
+	case ghw_hie_process:
+	case ghw_hie_package:
+	  if (hie->name)
+	    printf (" %s", hie->name);
+	  if (hie->kind == ghw_hie_generate_for)
+	    {
+	      printf ("(");
+	      ghw_disp_value (hie->u.blk.iter_value, hie->u.blk.iter_type);
+	      printf (")");
+	    }
+	  n = hie->u.blk.child;
+	  if (n == NULL)
+	    n = hie->brother;
+	  else
+	    indent++;
+	  break;
+	case ghw_hie_generic:
+	case ghw_hie_eos:
+	  abort ();
+	case ghw_hie_signal:
+	case ghw_hie_port_in:
+	case ghw_hie_port_out:
+	case ghw_hie_port_inout:
+	case ghw_hie_port_buffer:
+	case ghw_hie_port_linkage:
+	  {
+	    unsigned int *sigs;
+
+	    printf (" %s: ", hie->name);
+	    ghw_disp_typename (h, hie->u.sig.type);
+	    for (sigs = hie->u.sig.sigs; *sigs != 0; sigs++)
+	      printf (" #%u", *sigs);
+	    n = hie->brother;
+	  }
+	  break;
+	default:
+	  abort ();
+	}
+      printf ("\n");
+
+      while (n == NULL)
+	{
+	  if (hie->parent == NULL)
+	    return;
+	  hie = hie->parent;
+	  indent--;
+	  n = hie->brother;
+	}
+      hie = n;
+    }
+}
+
+int
+ghw_read_eoh (struct ghw_handler *h)
+{
+  return 0;
+}
+
+
+int
+ghw_read_base (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int res;
+
+  while (1)
+    {
+      if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+	return -1;
+      if (memcmp (hdr, "STR", 4) == 0)
+	res = ghw_read_str (h);
+      else if (memcmp (hdr, "HIE", 4) == 0)
+	res = ghw_read_hie (h);
+      else if (memcmp (hdr, "TYP", 4) == 0)
+	res = ghw_read_type (h);
+      else if (memcmp (hdr, "WKT", 4) == 0)
+	res = ghw_read_wk_types (h);
+      else if (memcmp (hdr, "EOH", 4) == 0)
+	return 0;
+      else
+	{
+	  fprintf (stderr, "ghw_read_base: unknown GHW section %c%c%c%c\n",
+		   hdr[0], hdr[1], hdr[2], hdr[3]);
+	  return -1;
+	}
+      if (res != 0)
+	{
+	  fprintf (stderr, "ghw_read_base: error in section %s\n", hdr);
+	  return res;
+	}
+    }
+}
+
+int
+ghw_read_signal_value (struct ghw_handler *h, struct ghw_sig *s)
+{
+  return ghw_read_value (h, s->val, s->type);
+}
+
+int
+ghw_read_snapshot (struct ghw_handler *h)
+{
+  unsigned char hdr[12];
+  int i;
+  struct ghw_sig *s;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->snap_time = ghw_get_i64 (h, &hdr[4]);
+  if (h->flag_verbose > 1)
+    printf ("Time is %lld fs\n", h->snap_time);
+
+  for (i = 0; i < h->nbr_sigs; i++)
+    {
+      s = &h->sigs[i];
+      if (s->type != NULL)
+	{
+	  if (h->flag_verbose > 1)
+	    printf ("read type %d for sig %d\n", s->type->kind, i);
+	  if (ghw_read_signal_value (h, s) < 0)
+	    return -1;
+	}
+    }
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+
+  if (memcmp (hdr, "ESN", 4))
+    return -1;
+
+  return 0;
+}
+
+void ghw_disp_values (struct ghw_handler *h);
+
+int
+ghw_read_cycle_start (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  h->snap_time = ghw_get_i64 (h, hdr);
+  return 0;
+}
+
+int
+ghw_read_cycle_cont (struct ghw_handler *h, int *list)
+{
+  int i;
+  int *list_p;
+
+  i = 0;
+  list_p = list;
+  while (1)
+    {
+      uint32_t d;
+      
+      /* Read delta to next signal.  */
+      if (ghw_read_uleb128 (h, &d) < 0)
+	return -1;
+      if (d == 0)
+	{
+	  /* Last signal reached.  */
+	  break;
+	}
+
+      /* Find next signal.  */
+      while (d > 0)
+	{
+	  i++;
+	  if (h->sigs[i].type != NULL)
+	    d--;
+	}
+      
+      if (ghw_read_signal_value (h, &h->sigs[i]) < 0)
+	return -1;
+      if (list_p)
+	*list_p++ = i;
+    }
+  
+  if (list_p)
+    *list_p = 0;
+  return 0;
+}
+
+int
+ghw_read_cycle_next (struct ghw_handler *h)
+{
+  int64_t d_time;
+
+  if (ghw_read_lsleb128 (h, &d_time) < 0)
+    return -1;
+  if (d_time == -1)
+    return 0;
+  h->snap_time += d_time;
+  return 1;
+}
+
+
+int
+ghw_read_cycle_end (struct ghw_handler *h)
+{
+  char hdr[4];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "ECY", 4))
+    return -1;
+
+  return 0;
+}
+
+static const char *
+ghw_get_lit (union ghw_type *type, int e)
+{
+  if (e >= type->en.nbr || e < 0)
+    return "??";
+  else
+    return type->en.lits[e];
+}
+
+static void
+ghw_disp_lit (union ghw_type *type, int e)
+{
+  printf ("%s (%d)", ghw_get_lit (type, e), e);
+}
+
+void
+ghw_disp_value (union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      ghw_disp_lit (type, val->b2);
+      break;
+    case ghdl_rtik_type_e8:
+      ghw_disp_lit (type, val->e8);
+      break;
+    case ghdl_rtik_type_i32:
+      printf ("%d", val->i32);
+      break;
+    case ghdl_rtik_type_p64:
+      printf ("%lld", val->i64);
+      break;
+    case ghdl_rtik_type_f64:
+      printf ("%g", val->f64);
+      break;
+    default:
+      fprintf (stderr, "ghw_disp_value: cannot handle type %d\n",
+	       type->kind);
+      abort ();
+    }
+}
+
+/* Put the ASCII representation of VAL into BUF, whose size if LEN.
+   A NUL is always written to BUF.
+*/
+void
+ghw_get_value (char *buf, int len, union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      if (val->b2 <= 1)
+	{
+	  strncpy (buf, type->en.lits[val->b2], len - 1);
+	  buf[len - 1] = 0;
+	}
+      else
+	{
+	  snprintf (buf, len, "?%d", val->b2);
+	}
+      break;
+    case ghdl_rtik_type_e8:
+      if (val->b2 <= type->en.nbr)
+	{
+	  strncpy (buf, type->en.lits[val->e8], len - 1);
+	  buf[len - 1] = 0;
+	}
+      else
+	{
+	  snprintf (buf, len, "?%d", val->e8);
+	}
+      break;
+    case ghdl_rtik_type_i32:
+      snprintf (buf, len, "%d", val->i32);
+      break;
+    case ghdl_rtik_type_p64:
+      snprintf (buf, len, "%lld", val->i64);
+      break;
+    case ghdl_rtik_type_f64:
+      snprintf (buf, len, "%g", val->f64);
+      break;
+    default:
+      snprintf (buf, len, "?bad type %d?", type->kind);
+    }
+}
+
+void
+ghw_disp_values (struct ghw_handler *h)
+{
+  int i;
+
+  for (i = 0; i < h->nbr_sigs; i++)
+    {
+      struct ghw_sig *s = &h->sigs[i];
+      if (s->type != NULL)
+	{
+	  printf ("#%d: ", i);
+	  ghw_disp_value (s->val, s->type);
+	  printf ("\n");
+	}
+    }
+}
+
+int
+ghw_read_directory (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+  int nbr_entries;
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  nbr_entries = ghw_get_i32 (h, &hdr[4]);
+  
+  if (h->flag_verbose)
+    printf ("Directory (%d entries):\n", nbr_entries);
+
+  for (i = 0; i < nbr_entries; i++)
+    {
+      unsigned char ent[8];
+      int pos;
+
+      if (fread (ent, sizeof (ent), 1, h->stream) != 1)
+	return -1;
+
+      pos = ghw_get_i32 (h, &ent[4]);
+      if (h->flag_verbose)
+	printf (" %s at %d\n", ent, pos);
+    }
+
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "EOD", 4))
+    return -1;
+  return 0;
+}
+
+int
+ghw_read_tailer (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+  int pos;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  pos = ghw_get_i32 (h, &hdr[4]);
+  
+  if (h->flag_verbose)
+    printf ("Tailer: directory at %d\n", pos);
+  return 0;
+}
+
+enum ghw_res
+ghw_read_sm_hdr (struct ghw_handler *h, int *list)
+{
+  unsigned char hdr[4];
+  int res;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    {
+      if (feof (h->stream))
+	return ghw_res_eof;
+      else
+	return ghw_res_error;
+    }
+  if (memcmp (hdr, "SNP", 4) == 0)
+    {
+      res = ghw_read_snapshot (h);
+      if (res < 0)
+	return res;
+      return ghw_res_snapshot;
+    }
+  else if (memcmp (hdr, "CYC", 4) == 0)
+    {
+      res = ghw_read_cycle_start (h);
+      if (res < 0)
+	return res;
+      res = ghw_read_cycle_cont (h, list);
+      if (res < 0)
+	return res;
+      
+      return ghw_res_cycle;
+    }
+  else if (memcmp (hdr, "DIR", 4) == 0)
+    {
+      res = ghw_read_directory (h);
+    }
+  else if (memcmp (hdr, "TAI", 4) == 0)
+    {
+      res = ghw_read_tailer (h);
+    }
+  else 
+    {
+      fprintf (stderr, "unknown GHW section %c%c%c%c\n",
+	       hdr[0], hdr[1], hdr[2], hdr[3]);
+      return -1;
+    }
+  if (res != 0)
+    return res;
+  return ghw_res_other;
+}
+
+int
+ghw_read_sm (struct ghw_handler *h, enum ghw_sm_type *sm)
+{
+  int res;
+
+  while (1)
+    {
+      /* printf ("sm: state = %d\n", *sm); */
+      switch (*sm)
+	{
+	case ghw_sm_init:
+	case ghw_sm_sect:
+	  res = ghw_read_sm_hdr (h, NULL);
+	  switch (res)
+	    {
+	    case ghw_res_other:
+	      break;
+	    case ghw_res_snapshot:
+	      *sm = ghw_sm_sect;
+	      return res;
+	    case ghw_res_cycle:
+	      *sm = ghw_sm_cycle;
+	      return res;
+	    default:
+	      return res;
+	    }
+	  break;
+	case ghw_sm_cycle:
+	  if (0)
+	    printf ("Time is %lld fs\n", h->snap_time);
+	  if (0)
+	    ghw_disp_values (h);
+	  
+	  res = ghw_read_cycle_next (h);
+	  if (res < 0)
+	    return res;
+	  if (res == 1)
+	    {
+	      res = ghw_read_cycle_cont (h, NULL);
+	      if (res < 0)
+		return res;
+	      return ghw_res_cycle;
+	    }
+	  res = ghw_read_cycle_end (h);
+	  if (res < 0)
+	    return res;
+	  *sm = ghw_sm_sect;
+	  break;
+	}
+    }
+}
+
+int
+ghw_read_cycle (struct ghw_handler *h)
+{
+  int res;
+
+  res = ghw_read_cycle_start (h);
+  if (res < 0)
+    return res;
+  while (1)
+    {
+      res = ghw_read_cycle_cont (h, NULL);
+      if (res < 0)
+	return res;
+      
+      if (0)
+	printf ("Time is %lld fs\n", h->snap_time);
+      if (0)
+	ghw_disp_values (h);
+      
+	      
+      res = ghw_read_cycle_next (h);
+      if (res < 0)
+	return res;
+      if (res == 0)
+	break;
+    }
+  res = ghw_read_cycle_end (h);
+  return res;
+}
+
+int
+ghw_read_dump (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int res;
+
+  while (1)
+    {
+      if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+	{
+	  if (feof (h->stream))
+	    return 0;
+	  else
+	    return -1;
+	}
+      if (memcmp (hdr, "SNP", 4) == 0)
+	{
+	  res = ghw_read_snapshot (h);
+	  if (0 && res >= 0)
+	    ghw_disp_values (h);
+	}
+      else if (memcmp (hdr, "CYC", 4) == 0)
+	{
+	  res = ghw_read_cycle (h);
+	}
+      else if (memcmp (hdr, "DIR", 4) == 0)
+	{
+	  res = ghw_read_directory (h);
+	}
+      else if (memcmp (hdr, "TAI", 4) == 0)
+	{
+	  res = ghw_read_tailer (h);
+	}
+      else 
+	{
+	  fprintf (stderr, "unknown GHW section %c%c%c%c\n",
+		   hdr[0], hdr[1], hdr[2], hdr[3]);
+	  return -1;
+	}
+      if (res != 0)
+	return res;
+    }
+}
+
+struct ghw_section ghw_sections[] = {
+  { "\0\0\0", NULL },
+  { "STR", ghw_read_str },
+  { "HIE", ghw_read_hie },
+  { "TYP", ghw_read_type },
+  { "WKT", ghw_read_wk_types },
+  { "EOH", ghw_read_eoh },
+  { "SNP", ghw_read_snapshot },
+  { "CYC", ghw_read_cycle },
+  { "DIR", ghw_read_directory },
+  { "TAI", ghw_read_tailer }
+};
+
+int
+ghw_read_section (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    {
+      if (feof (h->stream))
+	return -2;
+      else
+	return -1;
+    }
+  
+  for (i = 1; i < sizeof (ghw_sections) / sizeof (*ghw_sections); i++)
+    if (memcmp (hdr, ghw_sections[i].name, 4) == 0)
+      return i;
+
+  fprintf (stderr, "ghw_read_section: unknown GHW section %c%c%c%c\n",
+	   hdr[0], hdr[1], hdr[2], hdr[3]);
+  return 0;
+}
+
+void
+ghw_close (struct ghw_handler *h)
+{
+  if (h->stream)
+    {
+      fclose (h->stream);
+      h->stream = NULL;
+    }
+}
+
+const char *
+ghw_get_dir (int is_downto)
+{
+  return is_downto ? "downto" : "to";
+}
+
+void
+ghw_disp_range (union ghw_type *type, union ghw_range *rng)
+{
+  switch (rng->kind)
+    {
+    case ghdl_rtik_type_e8:
+      printf ("%s %s %s", ghw_get_lit (type, rng->e8.left),
+	      ghw_get_dir (rng->e8.dir), ghw_get_lit (type, rng->e8.right));
+      break;
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      printf ("%d %s %d",
+	      rng->i32.left, ghw_get_dir (rng->i32.dir), rng->i32.right);
+      break;
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_p64:
+      printf ("%lld %s %lld",
+	      rng->i64.left, ghw_get_dir (rng->i64.dir), rng->i64.right);
+      break;
+    case ghdl_rtik_type_f64:
+      printf ("%g %s %g",
+	      rng->f64.left, ghw_get_dir (rng->f64.dir), rng->f64.right);
+      break;
+    default:
+      printf ("?(%d)", rng->kind);
+    }
+}
+
+void
+ghw_disp_type (struct ghw_handler *h, union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+      {
+	struct ghw_type_enum *e = &t->en;
+	int i;
+
+	printf ("type %s is (", e->name);
+	for (i = 0; i < e->nbr; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    printf ("%s", e->lits[i]);
+	  }
+	printf (");");
+	if (e->wkt != ghw_wkt_unknown)
+	  printf ("  -- WKT:%d", e->wkt);
+	printf ("\n");
+      }
+      break;
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_f64:
+      {
+	struct ghw_type_scalar *s = &t->sc;
+	printf ("type %s is range <>;\n", s->name);
+      }
+      break;
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+      {
+	int i;
+
+	struct ghw_type_physical *p = &t->ph;
+	printf ("type %s is range <> units\n", p->name);
+	for (i = 0; i < p->nbr_units; i++)
+	  {
+	    struct ghw_unit *u = &p->units[i];
+	    printf ("  %s = %lld %s;\n", u->name, u->val, p->units[0].name);
+	  }
+	printf ("end units\n");
+      }
+      break;
+    case ghdl_rtik_subtype_scalar:
+      {
+	struct ghw_subtype_scalar *s = &t->ss;
+	printf ("subtype %s is ", s->name);
+	ghw_disp_typename (h, s->base);
+	printf (" range ");
+	ghw_disp_range (s->base, s->rng);
+	printf (";\n");
+      }
+      break;
+    case ghdl_rtik_type_array:
+      {
+	struct ghw_type_array *a = &t->ar;
+	int i;
+
+	printf ("type %s is array (", a->name);
+	for (i = 0; i < a->nbr_dim; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    ghw_disp_typename (h, a->dims[i]);
+	    printf (" range <>");
+	  }
+	printf (") of ");
+	ghw_disp_typename (h, a->el);
+	printf (";\n");
+      }
+      break;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      {
+	struct ghw_subtype_array *a = &t->sa;
+	int i;
+
+	printf ("subtype %s is ", a->name);
+	ghw_disp_typename (h, (union ghw_type *)a->base);
+	printf (" (");
+	for (i = 0; i < a->base->nbr_dim; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    ghw_disp_range ((union ghw_type *)a->base, a->rngs[i]);
+	  }
+	printf (");\n");
+      }
+      break;
+    case ghdl_rtik_type_record:
+      {
+	struct ghw_type_record *r = &t->rec;
+	int i;
+
+	printf ("type %s is record\n", r->name);
+	for (i = 0; i < r->nbr_fields; i++)
+	  {
+	    printf ("  %s: ", r->el[i].name);
+	    ghw_disp_typename (h, r->el[i].type);
+	    printf ("\n");
+	  }
+	printf ("end record;\n");
+      }
+      break;
+    default:
+      printf ("ghw_disp_type: unhandled type kind %d\n", t->kind);
+    }
+}
+
+void
+ghw_disp_types (struct ghw_handler *h)
+{
+  int i;
+
+  for (i = 0; i < h->nbr_types; i++)
+    ghw_disp_type (h, h->types[i]);
+}
diff --git a/src/translate/grt/ghwlib.h b/src/translate/grt/ghwlib.h
new file mode 100644
index 000000000..0138267ed
--- /dev/null
+++ b/src/translate/grt/ghwlib.h
@@ -0,0 +1,399 @@
+/*  GHDL Wavefile reader library.
+    Copyright (C) 2005 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.
+*/
+
+
+#ifndef _GHWLIB_H_
+#define _GHWLIB_H_
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef __GNUC__
+#include <stdint.h>
+#endif
+
+enum ghdl_rtik {
+  ghdl_rtik_top,		/* 0  */
+  ghdl_rtik_library,
+  ghdl_rtik_package,
+  ghdl_rtik_package_body,
+  ghdl_rtik_entity,
+  ghdl_rtik_architecture,	/* 5 */
+  ghdl_rtik_process,
+  ghdl_rtik_block,
+  ghdl_rtik_if_generate,
+  ghdl_rtik_for_generate,
+  ghdl_rtik_instance,
+  ghdl_rtik_constant,
+  ghdl_rtik_iterator,
+  ghdl_rtik_variable,
+  ghdl_rtik_signal,
+  ghdl_rtik_file,
+  ghdl_rtik_port,
+  ghdl_rtik_generic,
+  ghdl_rtik_alias,
+  ghdl_rtik_guard,
+  ghdl_rtik_component,
+  ghdl_rtik_attribute,
+  ghdl_rtik_type_b2,		/* 22 */
+  ghdl_rtik_type_e8,
+  ghdl_rtik_type_e32,
+  ghdl_rtik_type_i32,		/* 25 */
+  ghdl_rtik_type_i64,
+  ghdl_rtik_type_f64,
+  ghdl_rtik_type_p32,
+  ghdl_rtik_type_p64,
+  ghdl_rtik_type_access,	/* 30 */
+  ghdl_rtik_type_array,
+  ghdl_rtik_type_record,
+  ghdl_rtik_type_file,
+  ghdl_rtik_subtype_scalar,
+  ghdl_rtik_subtype_array,	/* 35 */
+  ghdl_rtik_subtype_array_ptr,
+  ghdl_rtik_subtype_unconstrained_array,
+  ghdl_rtik_subtype_record,
+  ghdl_rtik_subtype_access,
+  ghdl_rtik_type_protected,
+  ghdl_rtik_element,
+  ghdl_rtik_unit,
+  ghdl_rtik_attribute_transaction,
+  ghdl_rtik_attribute_quiet,
+  ghdl_rtik_attribute_stable,
+  ghdl_rtik_error
+};
+
+/* Well-known types.  */
+enum ghw_wkt_type {
+  ghw_wkt_unknown,
+  ghw_wkt_boolean,
+  ghw_wkt_bit,
+  ghw_wkt_std_ulogic
+};
+
+struct ghw_range_b2
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8; /* 0: to, !0: downto.  */
+  unsigned char left;
+  unsigned char right;
+};
+
+struct ghw_range_e8
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8; /* 0: to, !0: downto.  */
+  unsigned char left;
+  unsigned char right;
+};
+
+struct ghw_range_i32
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8; /* 0: to, !0: downto.  */
+  int32_t left;
+  int32_t right;
+};
+
+struct ghw_range_i64
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8;
+  int64_t left;
+  int64_t right;
+};
+
+struct ghw_range_f64
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8;
+  double left;
+  double right;
+};
+
+union ghw_range
+{
+  enum ghdl_rtik kind : 8;
+  struct ghw_range_e8 e8;
+  struct ghw_range_i32 i32;
+  struct ghw_range_i64 i64;
+  struct ghw_range_f64 f64;
+};
+
+/* Note: the first two fields must be kind and name.  */
+union ghw_type;
+
+struct ghw_type_common
+{
+  enum ghdl_rtik kind;
+  const char *name;
+};
+
+struct ghw_type_enum
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  enum ghw_wkt_type wkt;
+  unsigned int nbr;
+  const char **lits;
+};
+
+struct ghw_type_scalar
+{
+  enum ghdl_rtik kind;
+  const char *name;
+};
+
+struct ghw_unit
+{
+  const char *name;
+  int64_t val;
+};
+
+struct ghw_type_physical
+{
+  enum ghdl_rtik kind;
+  const char *name;
+  uint32_t nbr_units;
+  struct ghw_unit *units;
+};
+
+struct ghw_type_array
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  unsigned int nbr_dim;
+  union ghw_type *el;
+  union ghw_type **dims;
+};
+
+struct ghw_subtype_array
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  struct ghw_type_array *base;
+  int nbr_el;
+  union ghw_range **rngs;
+};
+
+struct ghw_subtype_scalar
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  union ghw_type *base;
+  union ghw_range *rng;
+};
+
+struct ghw_record_element
+{
+  const char *name;
+  union ghw_type *type;
+};
+
+struct ghw_type_record
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  unsigned int nbr_fields;
+  int nbr_el;	/* Number of scalar signals.  */
+  struct ghw_record_element *el;
+};
+  
+union ghw_type
+{
+  enum ghdl_rtik kind;
+  struct ghw_type_common common;
+  struct ghw_type_enum en;
+  struct ghw_type_scalar sc;
+  struct ghw_type_physical ph;
+  struct ghw_subtype_scalar ss;
+  struct ghw_subtype_array sa;
+  struct ghw_type_array ar;
+  struct ghw_type_record rec;
+};
+
+union ghw_val
+{
+  unsigned char b2;
+  unsigned char e8;
+  int32_t i32;
+  int64_t i64;
+  double f64;
+};
+
+/* A non-composite signal.  */
+struct ghw_sig
+{
+  union ghw_type *type;
+  union ghw_val *val;
+};
+
+enum ghw_hie_kind {
+  ghw_hie_eoh          = 0,
+  ghw_hie_design       = 1,
+  ghw_hie_block        = 3,
+  ghw_hie_generate_if  = 4,
+  ghw_hie_generate_for = 5,
+  ghw_hie_instance     = 6,
+  ghw_hie_package      = 7,
+  ghw_hie_process      = 13,
+  ghw_hie_generic      = 14,
+  ghw_hie_eos          = 15,
+  ghw_hie_signal       = 16,
+  ghw_hie_port_in      = 17,
+  ghw_hie_port_out     = 18,
+  ghw_hie_port_inout   = 19,
+  ghw_hie_port_buffer  = 20,
+  ghw_hie_port_linkage = 21
+};
+
+struct ghw_hie
+{
+  enum ghw_hie_kind kind;
+  struct ghw_hie *parent;
+  const char *name;
+  struct ghw_hie *brother;
+  union
+  {
+    struct
+    {
+      struct ghw_hie *child;
+      union ghw_type *iter_type;
+      union ghw_val *iter_value;
+    } blk;
+    struct
+    {
+      union ghw_type *type;
+      /* Array of signal elements.
+	 Last element is 0.  */
+      unsigned int *sigs;
+    } sig;
+  } u;
+};
+
+struct ghw_handler
+{
+  FILE *stream;
+  /* True if words are big-endian.  */
+  int word_be;
+  int word_len;
+  int off_len;
+  /* Minor version.  */
+  int version;
+
+  /* Set by user.  */
+  int flag_verbose;
+
+  /* String table.  */
+  /* Number of strings.  */
+  int nbr_str;
+  /* Size of the strings (without nul).  */
+  int str_size;
+  /* String table.  */
+  char **str_table;
+  /* Array containing strings.  */
+  char *str_content;
+
+  /* Type table.  */
+  int nbr_types;
+  union ghw_type **types;
+
+  /* Non-composite (or basic) signals.  */
+  int nbr_sigs;
+  struct ghw_sig *sigs;
+
+  /* Hierarchy.  */
+  struct ghw_hie *hie;
+
+  /* Time of the next cycle.  */
+  int64_t snap_time;
+};
+
+/* Open a GHW file with H.
+   Return < 0 in case of error. */
+int ghw_open (struct ghw_handler *h, const char *filename);
+
+union ghw_type *ghw_get_base_type (union ghw_type *t);
+
+/* Put the ASCII representation of VAL into BUF, whose size if LEN.
+   A NUL is always written to BUF.  */
+void ghw_get_value (char *buf, int len, 
+		    union ghw_val *val, union ghw_type *type);
+
+const char *ghw_get_hie_name (struct ghw_hie *h);
+
+void ghw_disp_hie (struct ghw_handler *h, struct ghw_hie *top);
+
+int ghw_read_base (struct ghw_handler *h);
+
+void ghw_disp_values (struct ghw_handler *h);
+
+int ghw_read_cycle_start (struct ghw_handler *h);
+
+int ghw_read_cycle_cont (struct ghw_handler *h, int *list);
+
+int ghw_read_cycle_next (struct ghw_handler *h);
+
+int ghw_read_cycle_end (struct ghw_handler *h);
+
+enum ghw_sm_type {
+  /* At init;
+     Read section name.  */
+  ghw_sm_init = 0,
+  ghw_sm_sect = 1,
+  ghw_sm_cycle = 2
+};
+
+enum ghw_res {
+  ghw_res_error = -1,
+  ghw_res_eof = -2,
+  ghw_res_ok = 0,
+  ghw_res_snapshot = 1,
+  ghw_res_cycle = 2,
+  ghw_res_other = 3
+};
+
+int ghw_read_sm (struct ghw_handler *h, enum ghw_sm_type *sm);
+
+int ghw_read_dump (struct ghw_handler *h);
+
+struct ghw_section {
+  const char name[4];
+  int (*handler)(struct ghw_handler *h);
+};
+
+extern struct ghw_section ghw_sections[];
+
+int ghw_read_section (struct ghw_handler *h);
+
+void ghw_close (struct ghw_handler *h);
+
+const char *ghw_get_dir (int is_downto);
+
+/* Note: TYPE must be a base type (used only to display literals).  */
+void ghw_disp_range (union ghw_type *type, union ghw_range *rng);
+
+void ghw_disp_type (struct ghw_handler *h, union ghw_type *t);
+
+void ghw_disp_types (struct ghw_handler *h);
+#endif /* _GHWLIB_H_ */
diff --git a/src/translate/grt/grt-arch.ads b/src/translate/grt/grt-arch.ads
new file mode 100644
index 000000000..5f5aa0e4c
--- /dev/null
+++ b/src/translate/grt/grt-arch.ads
@@ -0,0 +1,2 @@
+With Grt.Arch_None;
+Package Grt.Arch renames Grt.Arch_None;
diff --git a/src/translate/grt/grt-arch_none.adb b/src/translate/grt/grt-arch_none.adb
new file mode 100644
index 000000000..14db1c7d5
--- /dev/null
+++ b/src/translate/grt/grt-arch_none.adb
@@ -0,0 +1,7 @@
+package body Grt.Arch_None is
+   function Get_Time_Stamp return Ghdl_U64 is
+   begin
+      return 0;
+   end Get_Time_Stamp;
+end Grt.Arch_None;
+
diff --git a/src/translate/grt/grt-arch_none.ads b/src/translate/grt/grt-arch_none.ads
new file mode 100644
index 000000000..f8ae437d6
--- /dev/null
+++ b/src/translate/grt/grt-arch_none.ads
@@ -0,0 +1,6 @@
+with Grt.Types; use Grt.Types;
+
+package Grt.Arch_None is
+   function Get_Time_Stamp return Ghdl_U64;
+   pragma Inline (Get_Time_Stamp);
+end Grt.Arch_None;
diff --git a/src/translate/grt/grt-astdio.adb b/src/translate/grt/grt-astdio.adb
new file mode 100644
index 000000000..456d024ac
--- /dev/null
+++ b/src/translate/grt/grt-astdio.adb
@@ -0,0 +1,231 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT types.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.C; use Grt.C;
+
+package body Grt.Astdio is
+   procedure Put (Stream : FILEs; Str : String)
+   is
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := fputc (Character'Pos (C), Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      Len := strlen (Str);
+      S := fwrite (Str (1)'Address, size_t (Len), 1, Stream);
+   end Put;
+
+   procedure New_Line (Stream : FILEs) is
+   begin
+      Put (Stream, Nl);
+   end New_Line;
+
+   procedure Put (Str : String)
+   is
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stdout);
+   end Put;
+
+   procedure Put (C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := fputc (Character'Pos (C), stdout);
+   end Put;
+
+   procedure Put (Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      Len := strlen (Str);
+      S := fwrite (Str (1)'Address, size_t (Len), 1, stdout);
+   end Put;
+
+   procedure New_Line is
+   begin
+      Put (Nl);
+   end New_Line;
+
+   procedure Put_Line (Str : String)
+   is
+   begin
+      Put (Str);
+      New_Line;
+   end Put_Line;
+
+   procedure Put_Str_Len (Stream : FILEs; Str : Ghdl_Str_Len_Type)
+   is
+      S : String (1 .. 3);
+   begin
+      if Str.Str = null then
+         S (1) := ''';
+         S (2) := Character'Val (Str.Len);
+         S (3) := ''';
+         Put (Stream, S);
+      else
+         Put (Stream, Str.Str (1 .. Str.Len));
+      end if;
+   end Put_Str_Len;
+
+   generic
+      type Ntype is range <>;
+      Max_Len : Natural;
+   procedure Put_Ntype (Stream : FILEs; N : Ntype);
+
+   procedure Put_Ntype (Stream : FILEs; N : Ntype)
+   is
+      Str : String (1 .. Max_Len);
+      P : Natural := Str'Last;
+      V : Ntype;
+   begin
+      --  V is negativ.
+      if N > 0 then
+         V := -N;
+      else
+         V := N;
+      end if;
+      loop
+         Str (P) := Character'Val (48 - (V rem 10)); -- V is <= 0.
+         V := V / 10;
+         exit when V = 0;
+         P := P - 1;
+      end loop;
+      if N < 0 then
+         P := P - 1;
+         Str (P) := '-';
+      end if;
+      Put (Stream, Str (P .. Max_Len));
+   end Put_Ntype;
+
+   generic
+      type Utype is mod <>;
+      Max_Len : Natural;
+   procedure Put_Utype (Stream : FILEs; N : Utype);
+
+   procedure Put_Utype (Stream : FILEs; N : Utype)
+   is
+      Str : String (1 .. Max_Len);
+      P : Natural := Str'Last;
+      V : Utype := N;
+   begin
+      loop
+         Str (P) := Character'Val (48 + (V rem 10));
+         V := V / 10;
+         exit when V = 0;
+         P := P - 1;
+      end loop;
+      Put (Stream, Str (P .. Max_Len));
+   end Put_Utype;
+
+   procedure Put_I32_1 is new Put_Ntype (Ntype => Ghdl_I32, Max_Len => 11);
+   procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32) renames Put_I32_1;
+
+   procedure Put_U32_1 is new Put_Utype (Utype => Ghdl_U32, Max_Len => 11);
+   procedure Put_U32 (Stream : FILEs; U32 : Ghdl_U32) renames Put_U32_1;
+
+   procedure Put_I64_1 is new Put_Ntype (Ntype => Ghdl_I64, Max_Len => 20);
+   procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64) renames Put_I64_1;
+
+   procedure Put_U64_1 is new Put_Utype (Utype => Ghdl_U64, Max_Len => 20);
+   procedure Put_U64 (Stream : FILEs; U64 : Ghdl_U64) renames Put_U64_1;
+
+   procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64)
+   is
+      procedure Fprintf_G (Stream : FILEs;
+                           Arg : Ghdl_F64);
+      pragma Import (C, Fprintf_G, "__ghdl_fprintf_g");
+   begin
+      Fprintf_G (Stream, F64);
+   end Put_F64;
+
+   Hex_Map : constant array (0 .. 15) of Character := "0123456789ABCDEF";
+
+   procedure Put (Stream : FILEs; Addr : System.Address)
+   is
+      Res : String (1 .. System.Word_Size / 4);
+      Val : Integer_Address := To_Integer (Addr);
+   begin
+      for I in reverse Res'Range loop
+         Res (I) := Hex_Map (Natural (Val and 15));
+         Val := Val / 16;
+      end loop;
+      Put (Stream, Res);
+   end Put;
+
+   procedure Put_Dir (Stream : FILEs; Dir : Ghdl_Dir_Type) is
+   begin
+      case Dir is
+         when Dir_To =>
+            Put (Stream, " to ");
+         when Dir_Downto =>
+            Put (Stream, " downto ");
+      end case;
+   end Put_Dir;
+
+   procedure Put_Time (Stream : FILEs; Time : Std_Time) is
+   begin
+      if Time = Std_Time'First then
+         Put (Stream, "-Inf");
+      else
+         --  Do not bother with sec, min, and hr.
+         if (Time mod 1_000_000_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000_000));
+            Put (Stream, "ms");
+         elsif (Time mod 1_000_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000));
+            Put (Stream, "us");
+         elsif (Time mod 1_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000));
+            Put (Stream, "ns");
+         elsif (Time mod 1_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000));
+            Put (Stream, "ps");
+         else
+            Put_I64 (Stream, Ghdl_I64 (Time));
+            Put (Stream, "fs");
+         end if;
+      end if;
+   end Put_Time;
+
+end Grt.Astdio;
diff --git a/src/translate/grt/grt-astdio.ads b/src/translate/grt/grt-astdio.ads
new file mode 100644
index 000000000..8e8b739cc
--- /dev/null
+++ b/src/translate/grt/grt-astdio.ads
@@ -0,0 +1,60 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT types.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+with Grt.Types; use Grt.Types;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Astdio is
+   pragma Preelaborate (Grt.Astdio);
+
+   --  Procedures to disp on STREAM.
+   procedure Put (Stream : FILEs; Str : String);
+   procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32);
+   procedure Put_U32 (Stream : FILEs; U32 : Ghdl_U32);
+   procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64);
+   procedure Put_U64 (Stream : FILEs; U64 : Ghdl_U64);
+   procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64);
+   procedure Put (Stream : FILEs; Addr : System.Address);
+   procedure Put (Stream : FILEs; Str : Ghdl_C_String);
+   procedure Put (Stream : FILEs; C : Character);
+   procedure New_Line (Stream : FILEs);
+
+   --  Display time with unit, without space.
+   --  Eg: 10ns, 100ms, 97ps...
+   procedure Put_Time (Stream : FILEs; Time : Std_Time);
+
+   --  And on stdout.
+   procedure Put (Str : String);
+   procedure Put (C : Character);
+   procedure New_Line;
+   procedure Put_Line (Str : String);
+   procedure Put (Str : Ghdl_C_String);
+
+   --  Put STR using put procedures.
+   procedure Put_Str_Len (Stream : FILEs; Str : Ghdl_Str_Len_Type);
+
+   --  Put " to " or " downto ".
+   procedure Put_Dir (Stream : FILEs; Dir : Ghdl_Dir_Type);
+end Grt.Astdio;
diff --git a/src/translate/grt/grt-avhpi.adb b/src/translate/grt/grt-avhpi.adb
new file mode 100644
index 000000000..b935fd9a3
--- /dev/null
+++ b/src/translate/grt/grt-avhpi.adb
@@ -0,0 +1,1142 @@
+--  GHDL Run Time (GRT) - VHPI implementation for Ada.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+
+package body Grt.Avhpi is
+   procedure Get_Root_Inst (Res : out VhpiHandleT)
+   is
+   begin
+      Res := (Kind => VhpiRootInstK,
+              Ctxt => Get_Top_Context);
+   end Get_Root_Inst;
+
+   procedure Get_Package_Inst (Res : out VhpiHandleT) is
+   begin
+      Res := (Kind => VhpiIteratorK,
+              Ctxt => (Base => Null_Address,
+                       Block => To_Ghdl_Rti_Access (Ghdl_Rti_Top'Address)),
+              Rel => VhpiPackInsts,
+              It_Cur => 0,
+              It2 => 0,
+              Max2 => 0);
+   end Get_Package_Inst;
+
+   --  Number of elements in an array.
+   function Ranges_To_Length (Rngs : Ghdl_Range_Array;
+                              Indexes : Ghdl_Rti_Arr_Acc)
+                             return Ghdl_Index_Type
+   is
+      Res : Ghdl_Index_Type;
+   begin
+      Res := 1;
+      for I in Rngs'Range loop
+         Res := Res * Range_To_Length
+           (Rngs (I), Get_Base_Type (Indexes (I - Rngs'First)));
+      end loop;
+      return Res;
+   end Ranges_To_Length;
+
+   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
+                            Ref : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default value in case of success.
+      Res := (Kind => VhpiIteratorK,
+              Ctxt => Ref.Ctxt,
+              Rel => Rel,
+              It_Cur => 0,
+              It2 => 0,
+              Max2 => 0);
+      Error := AvhpiErrorOk;
+
+      case Rel is
+         when VhpiInternalRegions =>
+            case Ref.Kind is
+               when VhpiRootInstK
+                 | VhpiArchBodyK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK =>
+                  return;
+               when VhpiForGenerateK =>
+                  Res.It2 := 1;
+                  return;
+               when VhpiCompInstStmtK =>
+                  Get_Instance_Context (Ref.Inst, Ref.Ctxt, Res.Ctxt);
+                  return;
+               when others =>
+                  null;
+            end case;
+         when VhpiDecls =>
+            case Ref.Kind is
+               when VhpiArchBodyK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK
+                 | VhpiForGenerateK =>
+                  return;
+               when VhpiRootInstK
+                 | VhpiPackInstK =>
+                  Res.It2 := 1;
+                  return;
+               when VhpiCompInstStmtK =>
+                  Get_Instance_Context (Ref.Inst, Ref.Ctxt, Res.Ctxt);
+                  Res.It2 := 1;
+                  return;
+               when others =>
+                  null;
+            end case;
+         when VhpiIndexedNames =>
+            case Ref.Kind is
+               when VhpiGenericDeclK =>
+                  Res := (Kind => AvhpiNameIteratorK,
+                          Ctxt => Ref.Ctxt,
+                          N_Addr => Avhpi_Get_Address (Ref),
+                          N_Type => Ref.Obj.Obj_Type,
+                          N_Idx => 0,
+                          N_Obj => Ref.Obj);
+               when VhpiIndexedNameK =>
+                  Res := (Kind => AvhpiNameIteratorK,
+                          Ctxt => Ref.Ctxt,
+                          N_Addr => Ref.N_Addr,
+                          N_Type => Ref.N_Type,
+                          N_Idx => 0,
+                          N_Obj => Ref.N_Obj);
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+                  return;
+            end case;
+            case Res.N_Type.Kind is
+               when Ghdl_Rtik_Subtype_Array =>
+                  declare
+                     St : constant Ghdl_Rtin_Subtype_Array_Acc :=
+                       To_Ghdl_Rtin_Subtype_Array_Acc (Res.N_Type);
+                     Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                     Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+                  begin
+                     Bound_To_Range
+                       (Loc_To_Addr (St.Common.Depth, St.Bounds, Res.Ctxt),
+                        Bt, Rngs);
+                     Res.N_Idx := Ranges_To_Length (Rngs, Bt.Indexes);
+                  end;
+               when others =>
+                  Error := AvhpiErrorBadRel;
+            end case;
+            return;
+         when others =>
+            null;
+      end case;
+      --  Failure.
+      Res := Null_Handle;
+      Error := AvhpiErrorNotImplemented;
+   end Vhpi_Iterator;
+
+   --  OBJ_RTI is the RTI for the base name.
+   function Add_Index (Ctxt : Rti_Context;
+                       Obj_Base : Address;
+                       Obj_Rti : Ghdl_Rtin_Object_Acc;
+                       El_Type : Ghdl_Rti_Access;
+                       Off : Ghdl_Index_Type) return Address
+   is
+      pragma Unreferenced (Ctxt);
+      Is_Sig : Boolean;
+      El_Size : Ghdl_Index_Type;
+      El_Type1 : Ghdl_Rti_Access;
+   begin
+      case Obj_Rti.Common.Kind is
+         when Ghdl_Rtik_Generic =>
+            Is_Sig := False;
+         when others =>
+            Internal_Error ("add_index");
+      end case;
+
+      if El_Type.Kind = Ghdl_Rtik_Subtype_Scalar then
+         El_Type1 := Get_Base_Type (El_Type);
+      else
+         El_Type1 := El_Type;
+      end if;
+
+      case El_Type1.Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            if Is_Sig then
+               El_Size := Address'Size / Storage_Unit;
+            else
+               El_Size := Ghdl_I64'Size / Storage_Unit;
+            end if;
+         when Ghdl_Rtik_Subtype_Array =>
+            if Is_Sig then
+               El_Size := Ghdl_Index_Type
+                 (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Sigsize);
+            else
+               El_Size := Ghdl_Index_Type
+                 (To_Ghdl_Rtin_Subtype_Array_Acc (El_Type1).Valsize);
+            end if;
+         when others =>
+            Internal_Error ("add_index");
+      end case;
+      return Obj_Base + Off * El_Size;
+   end Add_Index;
+
+   procedure Vhpi_Scan_Indexed_Name (Iterator : in out VhpiHandleT;
+                                     Res : out VhpiHandleT;
+                                     Error : out AvhpiErrorT)
+   is
+      El_Type : Ghdl_Rti_Access;
+   begin
+      if Iterator.N_Idx = 0 then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      El_Type := To_Ghdl_Rtin_Type_Array_Acc
+        (Get_Base_Type (Iterator.N_Type)).Element;
+
+      Res := (Kind => VhpiIndexedNameK,
+              Ctxt => Iterator.Ctxt,
+              N_Addr => Iterator.N_Addr,
+              N_Type => El_Type,
+              N_Idx => 0,
+              N_Obj => Iterator.N_Obj);
+
+      --  Increment Address.
+      Iterator.N_Addr := Add_Index
+        (Iterator.Ctxt, Iterator.N_Addr, Iterator.N_Obj, El_Type, 1);
+
+      Iterator.N_Idx := Iterator.N_Idx - 1;
+      Error := AvhpiErrorOk;
+   end Vhpi_Scan_Indexed_Name;
+
+   procedure Vhpi_Scan_Internal_Regions (Iterator : in out VhpiHandleT;
+                                         Res : out VhpiHandleT;
+                                         Error : out AvhpiErrorT)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ch : Ghdl_Rti_Access;
+      Nblk : Ghdl_Rtin_Block_Acc;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+      if Blk = null then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      loop
+         << Again >> null;
+         if Iterator.It_Cur >= Blk.Nbr_Child then
+            Error := AvhpiErrorIteratorEnd;
+            return;
+         end if;
+
+         Ch := Blk.Children (Iterator.It_Cur);
+         Nblk := To_Ghdl_Rtin_Block_Acc (Ch);
+
+         if Iterator.Max2 /= 0 then
+            --  A for generate.
+            Iterator.It2 := Iterator.It2 + 1;
+            if Iterator.It2 >= Iterator.Max2 then
+               --  End of loop.
+               Iterator.Max2 := 0;
+               Iterator.It_Cur := Iterator.It_Cur + 1;
+               goto Again;
+            else
+               declare
+                  Base : Address;
+               begin
+                  Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc).all;
+                  Base := Base + Iterator.It2 * Nblk.Size;
+                  Res := (Kind => VhpiForGenerateK,
+                          Ctxt => (Base => Base,
+                                   Block => Ch));
+
+                  Error := AvhpiErrorOk;
+                  return;
+               end;
+            end if;
+         end if;
+
+
+         Iterator.It_Cur := Iterator.It_Cur + 1;
+
+         case Ch.Kind is
+            when Ghdl_Rtik_Process =>
+               Res := (Kind => VhpiProcessStmtK,
+                       Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_Block =>
+               Res := (Kind => VhpiBlockStmtK,
+                       Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_If_Generate =>
+               Res := (Kind => VhpiIfGenerateK,
+                       Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+                                                     + Nblk.Loc).all,
+                                Block => Ch));
+               --  Return only if the condition is true.
+               if Res.Ctxt.Base /= Null_Address then
+                  Error := AvhpiErrorOk;
+                  return;
+               end if;
+            when Ghdl_Rtik_For_Generate =>
+               Res := (Kind => VhpiForGenerateK,
+                       Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+                                                     + Nblk.Loc).all,
+                                Block => Ch));
+               Iterator.Max2 := Get_For_Generate_Length (Nblk, Iterator.Ctxt);
+               Iterator.It2 := 0;
+               if Iterator.Max2 > 0 then
+                  Iterator.It_Cur := Iterator.It_Cur - 1;
+                  Error := AvhpiErrorOk;
+                  return;
+               end if;
+               --  If the iterator range is nul, then continue to scan.
+            when Ghdl_Rtik_Instance =>
+               Res := (Kind => VhpiCompInstStmtK,
+                       Ctxt => Iterator.Ctxt,
+                       Inst => To_Ghdl_Rtin_Instance_Acc (Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when others =>
+               --  Next one.
+               null;
+         end case;
+      end loop;
+   end Vhpi_Scan_Internal_Regions;
+
+   procedure Rti_To_Handle (Rti : Ghdl_Rti_Access;
+                            Ctxt : Rti_Context;
+                            Res : out VhpiHandleT)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Signal =>
+            Res := (Kind => VhpiSigDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Port =>
+            Res := (Kind => VhpiPortDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Generic =>
+            Res := (Kind => VhpiGenericDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               Atype : Ghdl_Rtin_Subtype_Array_Acc;
+               Bt : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               Atype := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt := Atype.Basetype;
+               if Atype.Name = Bt.Name then
+                  Res := (Kind => VhpiArrayTypeDeclK,
+                          Ctxt => Ctxt,
+                          Atype => Rti);
+               else
+                  Res := (Kind => VhpiSubtypeDeclK,
+                          Ctxt => Ctxt,
+                          Atype => Rti);
+               end if;
+            end;
+         when Ghdl_Rtik_Type_Array =>
+            Res := (Kind => VhpiArrayTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Res := (Kind => VhpiEnumTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when Ghdl_Rtik_Type_P32
+           | Ghdl_Rtik_Type_P64 =>
+            Res := (Kind => VhpiPhysTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Res := (Kind => VhpiSubtypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when others =>
+            Res := (Kind => VhpiUndefined,
+                    Ctxt => Ctxt);
+      end case;
+   end Rti_To_Handle;
+
+   procedure Vhpi_Scan_Decls (Iterator : in out VhpiHandleT;
+                              Res : out VhpiHandleT;
+                              Error : out AvhpiErrorT)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ch : Ghdl_Rti_Access;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+
+      --  If there is no context, returns now.
+      --  This may happen for a unbound compinststmt.
+      if Blk = null then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      if Iterator.It2 = 1 then
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               --  Iterate on the entity.
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+            when Ghdl_Rtik_Package_Body =>
+               --  Iterate on the package.
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+            when Ghdl_Rtik_Package =>
+               --  Only for std.standard.
+               Iterator.It2 := 0;
+            when others =>
+               Internal_Error ("vhpi_scan_decls");
+         end case;
+      end if;
+      loop
+         loop
+            exit when Iterator.It_Cur >= Blk.Nbr_Child;
+
+            Ch := Blk.Children (Iterator.It_Cur);
+
+            Iterator.It_Cur := Iterator.It_Cur + 1;
+
+            case Ch.Kind is
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Generic
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Type_Array
+                 | Ghdl_Rtik_Subtype_Array
+                 | Ghdl_Rtik_Type_E8
+                 | Ghdl_Rtik_Type_E32
+                 | Ghdl_Rtik_Type_B1
+                 | Ghdl_Rtik_Subtype_Scalar =>
+                  Rti_To_Handle (Ch, Iterator.Ctxt, Res);
+                  if Res.Kind /= VhpiUndefined then
+                     Error := AvhpiErrorOk;
+                     return;
+                  else
+                     Internal_Error ("vhpi_scan_decls");
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         case Iterator.It2 is
+            when 1 =>
+               --  Iterate on the architecture/package decl.
+               Iterator.It2 := 0;
+               Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+               Iterator.It_Cur := 0;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      Error := AvhpiErrorIteratorEnd;
+   end Vhpi_Scan_Decls;
+
+   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;
+                        Res : out VhpiHandleT;
+                        Error : out AvhpiErrorT)
+   is
+   begin
+      if Iterator.Kind = AvhpiNameIteratorK then
+         case Iterator.N_Type.Kind is
+            when Ghdl_Rtik_Subtype_Array =>
+               Vhpi_Scan_Indexed_Name (Iterator, Res, Error);
+            when others =>
+               Error := AvhpiErrorHandle;
+               Res := Null_Handle;
+         end case;
+         return;
+      elsif Iterator.Kind /= VhpiIteratorK then
+         Error := AvhpiErrorHandle;
+         Res := Null_Handle;
+         return;
+      end if;
+
+      case Iterator.Rel is
+         when VhpiPackInsts =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+               if Iterator.It_Cur >= Blk.Nbr_Child then
+                  Error := AvhpiErrorIteratorEnd;
+                  return;
+               end if;
+               Res := (Kind => VhpiPackInstK,
+                       Ctxt => (Base => Null_Address,
+                                Block => Blk.Children (Iterator.It_Cur)));
+               Iterator.It_Cur := Iterator.It_Cur + 1;
+               Error := AvhpiErrorOk;
+            end;
+         when VhpiInternalRegions =>
+            Vhpi_Scan_Internal_Regions (Iterator, Res, Error);
+         when VhpiDecls =>
+            Vhpi_Scan_Decls (Iterator, Res, Error);
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Scan;
+
+   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String
+   is
+   begin
+      case Obj.Kind is
+         when VhpiEnumTypeDeclK =>
+            return To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name;
+         when VhpiPackInstK
+           | VhpiArchBodyK
+           | VhpiEntityDeclK
+           | VhpiProcessStmtK
+           | VhpiBlockStmtK
+           | VhpiIfGenerateK
+           | VhpiForGenerateK =>
+            return To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block).Name;
+         when VhpiRootInstK =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+               return Blk.Name;
+            end;
+         when VhpiCompInstStmtK =>
+            return Obj.Inst.Name;
+         when VhpiSigDeclK
+           | VhpiPortDeclK
+           | VhpiGenericDeclK =>
+            return Obj.Obj.Name;
+         when VhpiSubtypeDeclK =>
+            return To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name;
+         when others =>
+            return null;
+      end case;
+   end Avhpi_Get_Base_Name;
+
+   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
+                           Obj : VhpiHandleT;
+                           Res : out String;
+                           Len : out Natural)
+   is
+      subtype R_Type is String (1 .. Res'Length);
+      R : R_Type renames Res;
+
+      procedure Add (C : Character) is
+      begin
+         Len := Len + 1;
+         if Len <= R_Type'Last then
+            R (Len) := C;
+         end if;
+      end Add;
+
+      procedure Add (Str : String) is
+      begin
+         for I in Str'Range loop
+            Add (Str (I));
+         end loop;
+      end Add;
+
+      procedure Add (Str : Ghdl_C_String) is
+      begin
+         for I in Str'Range loop
+            exit when Str (I) = NUL;
+            Add (Str (I));
+         end loop;
+      end Add;
+   begin
+      Len := 0;
+
+      case Property is
+         when VhpiNameP =>
+            case Obj.Kind is
+               when VhpiEnumTypeDeclK =>
+                  Add (To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name);
+               when VhpiSubtypeDeclK =>
+                  Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name);
+               when VhpiArrayTypeDeclK =>
+                  Add (To_Ghdl_Rtin_Type_Array_Acc (Obj.Atype).Name);
+               when VhpiPackInstK
+                 | VhpiArchBodyK
+                 | VhpiEntityDeclK
+                 | VhpiProcessStmtK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK =>
+                  Add (To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block).Name);
+               when VhpiRootInstK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+                     Add (Blk.Name);
+                  end;
+               when VhpiCompInstStmtK =>
+                  Add (Obj.Inst.Name);
+               when VhpiSigDeclK
+                 | VhpiPortDeclK
+                 | VhpiGenericDeclK =>
+                  Add (Obj.Obj.Name);
+               when VhpiForGenerateK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Iter : Ghdl_Rtin_Object_Acc;
+                     Iter_Type : Ghdl_Rti_Access;
+                     Vptr : Ghdl_Value_Ptr;
+                     Buf : String (1 .. 12);
+                     Buf_Len : Natural;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                     Vptr := To_Ghdl_Value_Ptr
+                       (Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Obj.Ctxt));
+                     Add (Blk.Name);
+                     Add ('(');
+                     Iter_Type := Iter.Obj_Type;
+                     if Iter_Type.Kind = Ghdl_Rtik_Subtype_Scalar then
+                        Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
+                          (Iter_Type).Basetype;
+                     end if;
+                     case Iter_Type.Kind is
+                        when Ghdl_Rtik_Type_I32 =>
+                           To_String (Buf, Buf_Len, Vptr.I32);
+                           Add (Buf (Buf_Len .. Buf'Last));
+--                         when Ghdl_Rtik_Type_E8 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+--                         when Ghdl_Rtik_Type_E32 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
+--                         when Ghdl_Rtik_Type_B1 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti,
+--                               Ghdl_Index_Type (Ghdl_B1'Pos (Vptr.B1)));
+                        when others =>
+                           Add ('?');
+                     end case;
+                     --Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
+                     Add (')');
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiCompNameP =>
+            case Obj.Kind is
+               when VhpiCompInstStmtK =>
+                  declare
+                     Comp : Ghdl_Rtin_Component_Acc;
+                  begin
+                     Comp := To_Ghdl_Rtin_Component_Acc (Obj.Inst.Instance);
+                     if Comp.Common.Kind = Ghdl_Rtik_Component then
+                        Add (Comp.Name);
+                     end if;
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiLibLogicalNameP =>
+            case Obj.Kind is
+               when VhpiPackInstK
+                 | VhpiArchBodyK
+                 | VhpiEntityDeclK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Lib : Ghdl_Rtin_Type_Scalar_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     if Blk.Common.Kind = Ghdl_Rtik_Package_Body then
+                        Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+                     end if;
+                     Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
+                     if Lib.Common.Kind /= Ghdl_Rtik_Library then
+                        Internal_Error ("VhpiLibLogicalNameP");
+                     end if;
+                     Add (Lib.Name);
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiFullNameP =>
+            declare
+               Rstr : Rstring;
+               Nctxt : Rti_Context;
+            begin
+               if Obj.Kind = VhpiCompInstStmtK then
+                  Get_Instance_Context (Obj.Inst, Obj.Ctxt, Nctxt);
+                  Get_Path_Name (Rstr, Nctxt, ':', False);
+               else
+                  Get_Path_Name (Rstr, Obj.Ctxt, ':', False);
+               end if;
+               Copy (Rstr, R, Len);
+               Free (Rstr);
+               case Obj.Kind is
+                  when VhpiCompInstStmtK =>
+                     null;
+                  when VhpiPortDeclK
+                    | VhpiSigDeclK =>
+                     Add (':');
+                     Add (Obj.Obj.Name);
+                  when others =>
+                     null;
+               end case;
+            end;
+         when others =>
+            null;
+      end case;
+   end Vhpi_Get_Str;
+
+   procedure Vhpi_Handle (Rel : VhpiOneToOneT;
+                          Ref : VhpiHandleT;
+                          Res : out VhpiHandleT;
+                          Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default error.
+      Error := AvhpiErrorNotImplemented;
+
+      case Rel is
+         when VhpiDesignUnit =>
+            case Ref.Kind is
+               when VhpiRootInstK =>
+                  case Ref.Ctxt.Block.Kind is
+                     when Ghdl_Rtik_Architecture =>
+                        Res := (Kind => VhpiArchBodyK,
+                                Ctxt => Ref.Ctxt);
+                        Error := AvhpiErrorOk;
+                        return;
+                     when others =>
+                        return;
+                  end case;
+               when others =>
+                  return;
+            end case;
+         when VhpiPrimaryUnit =>
+            case Ref.Kind is
+               when VhpiArchBodyK =>
+                  declare
+                     Rti : Ghdl_Rti_Access;
+                     Ent : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Rti := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block).Parent;
+                     Ent := To_Ghdl_Rtin_Block_Acc (Rti);
+                     Res := (Kind => VhpiEntityDeclK,
+                             Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc,
+                                      Block => Rti));
+                     Error := AvhpiErrorOk;
+                  end;
+               when others =>
+                  return;
+            end case;
+         when VhpiIterScheme =>
+            case Ref.Kind is
+               when VhpiForGenerateK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Iter : Ghdl_Rtin_Object_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block);
+                     Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                     Res := (Kind => VhpiConstDeclK,
+                             Ctxt => Ref.Ctxt,
+                             Obj => Iter);
+                     Error := AvhpiErrorOk;
+                  end;
+               when others =>
+                  return;
+            end case;
+         when VhpiSubtype =>
+            case Ref.Kind is
+               when VhpiPortDeclK
+                 | VhpiSigDeclK
+                 | VhpiGenericDeclK
+                 | VhpiConstDeclK =>
+                  Res := (Kind => VhpiSubtypeIndicK,
+                          Ctxt => Ref.Ctxt,
+                          Atype => Ref.Obj.Obj_Type);
+                  Error := AvhpiErrorOk;
+               when others =>
+                  return;
+            end case;
+         when VhpiTypeMark =>
+            case Ref.Kind is
+               when VhpiSubtypeIndicK =>
+                  --  FIXME: if the subtype is anonymous, return the base type.
+                  Rti_To_Handle (Ref.Atype, Ref.Ctxt, Res);
+                  if Res.Kind /= VhpiUndefined then
+                     Error := AvhpiErrorOk;
+                  end if;
+                  return;
+               when others =>
+                  return;
+            end case;
+         when VhpiBaseType =>
+            declare
+               Atype : Ghdl_Rti_Access;
+            begin
+               case Ref.Kind is
+                  when VhpiSubtypeIndicK
+                    | VhpiSubtypeDeclK
+                    | VhpiArrayTypeDeclK =>
+                     Atype := Ref.Atype;
+                  when VhpiGenericDeclK =>
+                     Atype := Ref.Obj.Obj_Type;
+                  when VhpiIndexedNameK =>
+                     Atype := Ref.N_Type;
+                  when others =>
+                     return;
+               end case;
+               case Atype.Kind is
+                  when Ghdl_Rtik_Subtype_Array =>
+                     Rti_To_Handle
+                       (To_Ghdl_Rti_Access (To_Ghdl_Rtin_Subtype_Array_Acc
+                                            (Atype).Basetype),
+                        Ref.Ctxt, Res);
+                     if Res.Kind /= VhpiUndefined then
+                        Error := AvhpiErrorOk;
+                     end if;
+                  when Ghdl_Rtik_Subtype_Scalar =>
+                     Rti_To_Handle
+                       (To_Ghdl_Rtin_Subtype_Scalar_Acc (Atype).Basetype,
+                        Ref.Ctxt, Res);
+                     if Res.Kind /= VhpiUndefined then
+                        Error := AvhpiErrorOk;
+                     end if;
+                  when Ghdl_Rtik_Type_Array =>
+                     Res := Ref;
+                     Error := AvhpiErrorOk;
+                  when others =>
+                     return;
+               end case;
+            end;
+         when VhpiElemSubtype =>
+            declare
+               Base_Type : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               case Ref.Atype.Kind is
+                  when Ghdl_Rtik_Subtype_Array =>
+                     Base_Type :=
+                       To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype).Basetype;
+                  when Ghdl_Rtik_Type_Array =>
+                     Base_Type := To_Ghdl_Rtin_Type_Array_Acc (Ref.Atype);
+                  when others =>
+                     return;
+               end case;
+               Rti_To_Handle (Base_Type.Element, Ref.Ctxt, Res);
+               if Res.Kind /= VhpiUndefined then
+                  Error := AvhpiErrorOk;
+               end if;
+            end;
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Handle;
+
+   procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT;
+                                   Ref : VhpiHandleT;
+                                   Index : Natural;
+                                   Res : out VhpiHandleT;
+                                   Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default error.
+      Error := AvhpiErrorNotImplemented;
+
+      case Rel is
+         when VhpiConstraints =>
+            case Ref.Kind is
+               when VhpiSubtypeIndicK =>
+                  if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then
+                     declare
+                        Arr_Subtype : constant Ghdl_Rtin_Subtype_Array_Acc :=
+                          To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype);
+                        Basetype : constant Ghdl_Rtin_Type_Array_Acc :=
+                          Arr_Subtype.Basetype;
+                        Idx : constant Ghdl_Index_Type :=
+                          Ghdl_Index_Type (Index);
+                        Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1);
+                        Range_Basetype : Ghdl_Rti_Access;
+                     begin
+                        if Idx not in 1 .. Basetype.Nbr_Dim then
+                           Res := Null_Handle;
+                           Error := AvhpiErrorBadIndex;
+                           return;
+                        end if;
+                        --  constraint type is basetype.indexes (idx - 1)
+                        Bound_To_Range
+                          (Loc_To_Addr (Arr_Subtype.Common.Depth,
+                                        Arr_Subtype.Bounds, Ref.Ctxt),
+                           Basetype, Bounds);
+                        Res := (Kind => VhpiIntRangeK,
+                                Ctxt => Ref.Ctxt,
+                                Rng_Type => Basetype.Indexes (Idx - 1),
+                                Rng_Addr => Bounds (Idx - 1));
+                        Range_Basetype := Get_Base_Type (Res.Rng_Type);
+                        case Range_Basetype.Kind is
+                           when Ghdl_Rtik_Type_I32 =>
+                              null;
+                           when Ghdl_Rtik_Type_E8
+                             | Ghdl_Rtik_Type_E32 =>
+                              Res := (Kind => VhpiEnumRangeK,
+                                      Ctxt => Ref.Ctxt,
+                                      Rng_Type => Res.Rng_Type,
+                                      Rng_Addr => Res.Rng_Addr);
+                           when others =>
+                              Internal_Error
+                                ("vhpi_handle_by_index/constraint");
+                        end case;
+                        Error := AvhpiErrorOk;
+                     end;
+                  end if;
+               when others =>
+                  return;
+            end case;
+         when VhpiIndexedNames =>
+            declare
+               Base_Type, El_Type : VhpiHandleT;
+            begin
+               Vhpi_Handle (VhpiBaseType, Ref, Base_Type, Error);
+               if Error /= AvhpiErrorOk then
+                  return;
+               end if;
+               if Vhpi_Get_Kind (Base_Type) /= VhpiArrayTypeDeclK then
+                  Error := AvhpiErrorBadRel;
+                  return;
+               end if;
+               Vhpi_Handle (VhpiElemSubtype, Base_Type, El_Type, Error);
+               if Error /= AvhpiErrorOk then
+                  return;
+               end if;
+               Res := (Kind => VhpiIndexedNameK,
+                       Ctxt => Ref.Ctxt,
+                       N_Addr => Avhpi_Get_Address (Ref),
+                       N_Type => El_Type.Atype,
+                       N_Idx => Ghdl_Index_Type (Index),
+                       N_Obj => Ref.Obj);
+               if Res.N_Addr = Null_Address then
+                  Error := AvhpiErrorBadRel;
+                  return;
+               end if;
+               Res.N_Addr := Add_Index
+                 (Res.Ctxt, Res.N_Addr, Res.N_Obj, Res.N_Type,
+                  Ghdl_Index_Type (Index));
+            end;
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Handle_By_Index;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out VhpiIntT;
+                       Error : out AvhpiErrorT)
+   is
+   begin
+      case Property is
+         when VhpiLeftBoundP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Res := 0;
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Left;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when VhpiRightBoundP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Right;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when others =>
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Get;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out Boolean;
+                       Error : out AvhpiErrorT)
+   is
+   begin
+      case Property is
+         when VhpiIsUpP =>
+            if Obj.Kind /= VhpiIntRangeK then
+               Res := False;
+               Error := AvhpiErrorBadRel;
+               return;
+            end if;
+            Error := AvhpiErrorOk;
+            case Get_Base_Type (Obj.Rng_Type).Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Res := Obj.Rng_Addr.I32.Dir = Dir_To;
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+            end case;
+            return;
+         when others =>
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Get;
+
+   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
+                                 return VhpiEntityClassT
+   is
+   begin
+      case Obj.Kind is
+         when VhpiArchBodyK =>
+            return VhpiArchitectureEC;
+         when others =>
+            return VhpiErrorEC;
+      end case;
+   end Vhpi_Get_EntityClass;
+
+   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT is
+   begin
+      return Obj.Kind;
+   end Vhpi_Get_Kind;
+
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeT is
+   begin
+      case Obj.Kind is
+         when VhpiPortDeclK =>
+            case Obj.Obj.Common.Mode and Ghdl_Rti_Signal_Mode_Mask is
+               when Ghdl_Rti_Signal_Mode_In =>
+                  return VhpiInMode;
+               when Ghdl_Rti_Signal_Mode_Out =>
+                  return VhpiOutMode;
+               when Ghdl_Rti_Signal_Mode_Inout =>
+                  return VhpiInoutMode;
+               when Ghdl_Rti_Signal_Mode_Buffer =>
+                  return VhpiBufferMode;
+               when Ghdl_Rti_Signal_Mode_Linkage =>
+                  return VhpiLinkageMode;
+               when others =>
+                  return VhpiErrorMode;
+            end case;
+         when others =>
+            return VhpiErrorMode;
+      end case;
+   end Vhpi_Get_Mode;
+
+   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access is
+   begin
+      case Obj.Kind is
+         when VhpiSubtypeIndicK
+           | VhpiEnumTypeDeclK =>
+            return Obj.Atype;
+         when VhpiSigDeclK
+           | VhpiPortDeclK =>
+            return To_Ghdl_Rti_Access (Obj.Obj);
+         when others =>
+            return null;
+      end case;
+   end Avhpi_Get_Rti;
+
+   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address is
+   begin
+      case Obj.Kind is
+         when VhpiPortDeclK
+           | VhpiSigDeclK
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
+            return Loc_To_Addr (Obj.Ctxt.Block.Depth,
+                                Obj.Obj.Loc,
+                                Obj.Ctxt);
+         when others =>
+            return Null_Address;
+      end case;
+   end Avhpi_Get_Address;
+
+   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context is
+   begin
+      return Obj.Ctxt;
+   end Avhpi_Get_Context;
+
+   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)
+                                 return Boolean
+   is
+   begin
+      if Hdl1.Kind /= Hdl2.Kind then
+         return False;
+      end if;
+      case Hdl1.Kind is
+         when VhpiSubtypeIndicK
+           | VhpiSubtypeDeclK
+           | VhpiArrayTypeDeclK
+           | VhpiPhysTypeDeclK =>
+            return Hdl1.Atype = Hdl2.Atype;
+         when others =>
+            -- FIXME: todo
+            Internal_Error ("vhpi_compare_handles");
+      end case;
+   end Vhpi_Compare_Handles;
+
+   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)
+                           return AvhpiErrorT
+   is
+      Vptr : Ghdl_Value_Ptr;
+      Atype : Ghdl_Rti_Access;
+   begin
+      case Obj.Kind is
+         when VhpiIndexedNameK =>
+            Vptr := To_Ghdl_Value_Ptr (Obj.N_Addr);
+            Atype := Obj.N_Type;
+         when others =>
+            return AvhpiErrorNotImplemented;
+      end case;
+      case Get_Base_Type (Atype).Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            null;
+         when others =>
+            return AvhpiErrorHandle;
+      end case;
+      Vptr.I64 := Val;
+      return AvhpiErrorOk;
+   end Vhpi_Put_Value;
+end Grt.Avhpi;
+
+
diff --git a/src/translate/grt/grt-avhpi.ads b/src/translate/grt/grt-avhpi.ads
new file mode 100644
index 000000000..1eff5a8a3
--- /dev/null
+++ b/src/translate/grt/grt-avhpi.ads
@@ -0,0 +1,561 @@
+--  GHDL Run Time (GRT) - VHPI implementation for Ada.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+--  Ada oriented implementation of VHPI.
+--  This doesn't follow exactly what VHPI defined, but:
+--  * it should be easy to write a VHPI interface from this implementation.
+--  * this implementation is thread-safe (no global storage).
+--  * this implementation never allocates memory.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+
+package Grt.Avhpi is
+   --  Object Kinds.
+   type VhpiClassKindT is
+     (
+      VhpiUndefined,
+      VhpiAccessTypeDeclK,
+      VhpiAggregateK,
+      VhpiAliasDeclK,
+      VhpiAllLiteralK,
+      VhpiAllocatorK,
+      VhpiAnyCollectionK,
+      VhpiArchBodyK,
+      VhpiArgvK,
+      VhpiArrayTypeDeclK,
+      VhpiAssertStmtK,
+      VhpiAssocElemK,
+      VhpiAttrDeclK,
+      VhpiAttrSpecK,
+      VhpiBinaryExprK,
+      VhpiBitStringLiteralK,
+      VhpiBlockConfigK,
+      VhpiBlockStmtK,
+      VhpiBranchK,
+      VhpiCallbackK,
+      VhpiCaseStmtK,
+      VhpiCharLiteralK,
+      VhpiCompConfigK,
+      VhpiCompDeclK,
+      VhpiCompInstStmtK,
+      VhpiCondSigAssignStmtK,
+      VhpiCondWaveformK,
+      VhpiConfigDeclK,
+      VhpiConstDeclK,
+      VhpiConstParamDeclK,
+      VhpiConvFuncK,
+      VhpiDeRefObjK,
+      VhpiDisconnectSpecK,
+      VhpiDriverK,
+      VhpiDriverCollectionK,
+      VhpiElemAssocK,
+      VhpiElemDeclK,
+      VhpiEntityClassEntryK,
+      VhpiEntityDeclK,
+      VhpiEnumLiteralK,
+      VhpiEnumRangeK,
+      VhpiEnumTypeDeclK,
+      VhpiExitStmtK,
+      VhpiFileDeclK,
+      VhpiFileParamDeclK,
+      VhpiFileTypeDeclK,
+      VhpiFloatRangeK,
+      VhpiFloatTypeDeclK,
+      VhpiForGenerateK,
+      VhpiForLoopK,
+      VhpiForeignfK,
+      VhpiFuncCallK,
+      VhpiFuncDeclK,
+      VhpiGenericDeclK,
+      VhpiGroupDeclK,
+      VhpiGroupTempDeclK,
+      VhpiIfGenerateK,
+      VhpiIfStmtK,
+      VhpiInPortK,
+      VhpiIndexedNameK,
+      VhpiIntLiteralK,
+      VhpiIntRangeK,
+      VhpiIntTypeDeclK,
+      VhpiIteratorK,
+      VhpiLibraryDeclK,
+      VhpiLoopStmtK,
+      VhpiNextStmtK,
+      VhpiNullLiteralK,
+      VhpiNullStmtK,
+      VhpiOperatorK,
+      VhpiOthersLiteralK,
+      VhpiOutPortK,
+      VhpiPackBodyK,
+      VhpiPackDeclK,
+      VhpiPackInstK,
+      VhpiParamAttrNameK,
+      VhpiPhysLiteralK,
+      VhpiPhysRangeK,
+      VhpiPhysTypeDeclK,
+      VhpiPortDeclK,
+      VhpiProcCallStmtK,
+      VhpiProcDeclK,
+      VhpiProcessStmtK,
+      VhpiProtectedTypeK,
+      VhpiProtectedTypeBodyK,
+      VhpiProtectedTypeDeclK,
+      VhpiRealLiteralK,
+      VhpiRecordTypeDeclK,
+      VhpiReportStmtK,
+      VhpiReturnStmtK,
+      VhpiRootInstK,
+      VhpiSelectSigAssignStmtK,
+      VhpiSelectWaveformK,
+      VhpiSelectedNameK,
+      VhpiSigDeclK,
+      VhpiSigParamDeclK,
+      VhpiSimpAttrNameK,
+      VhpiSimpleSigAssignStmtK,
+      VhpiSliceNameK,
+      VhpiStringLiteralK,
+      VhpiSubpBodyK,
+      VhpiSubtypeDeclK,
+      VhpiSubtypeIndicK,
+      VhpiToolK,
+      VhpiTransactionK,
+      VhpiTypeConvK,
+      VhpiUnaryExprK,
+      VhpiUnitDeclK,
+      VhpiUserAttrNameK,
+      VhpiVarAssignStmtK,
+      VhpiVarDeclK,
+      VhpiVarParamDeclK,
+      VhpiWaitStmtK,
+      VhpiWaveformElemK,
+      VhpiWhileLoopK,
+
+      --  Iterator, but on a name.
+      AvhpiNameIteratorK
+     );
+
+   type VhpiOneToOneT is
+     (
+      VhpiAbstractLiteral,
+      VhpiActual,
+      VhpiAllLiteral,
+      VhpiAttrDecl,
+      VhpiAttrSpec,
+      VhpiBaseType,
+      VhpiBaseUnit,
+      VhpiBasicSignal,
+      VhpiBlockConfig,
+      VhpiCaseExpr,
+      VhpiCondExpr,
+      VhpiConfigDecl,
+      VhpiConfigSpec,
+      VhpiConstraint,
+      VhpiContributor,
+      VhpiCurCallback,
+      VhpiCurEqProcess,
+      VhpiCurStackFrame,
+      VhpiDeRefObj,
+      VhpiDecl,
+      VhpiDesignUnit,
+      VhpiDownStack,
+      VhpiElemSubtype,
+      VhpiEntityAspect,
+      VhpiEntityDecl,
+      VhpiEqProcessStmt,
+      VhpiExpr,
+      VhpiFormal,
+      VhpiFuncDecl,
+      VhpiGroupTempDecl,
+      VhpiGuardExpr,
+      VhpiGuardSig,
+      VhpiImmRegion,
+      VhpiInPort,
+      VhpiInitExpr,
+      VhpiIterScheme,
+      VhpiLeftExpr,
+      VhpiLexicalScope,
+      VhpiLhsExpr,
+      VhpiLocal,
+      VhpiLogicalExpr,
+      VhpiName,
+      VhpiOperator,
+      VhpiOthersLiteral,
+      VhpiOutPort,
+      VhpiParamDecl,
+      VhpiParamExpr,
+      VhpiParent,
+      VhpiPhysLiteral,
+      VhpiPrefix,
+      VhpiPrimaryUnit,
+      VhpiProtectedTypeBody,
+      VhpiProtectedTypeDecl,
+      VhpiRejectTime,
+      VhpiReportExpr,
+      VhpiResolFunc,
+      VhpiReturnExpr,
+      VhpiReturnTypeMark,
+      VhpiRhsExpr,
+      VhpiRightExpr,
+      VhpiRootInst,
+      VhpiSelectExpr,
+      VhpiSeverityExpr,
+      VhpiSimpleName,
+      VhpiSubpBody,
+      VhpiSubpDecl,
+      VhpiSubtype,
+      VhpiSuffix,
+      VhpiTimeExpr,
+      VhpiTimeOutExpr,
+      VhpiTool,
+      VhpiTypeMark,
+      VhpiUnitDecl,
+      VhpiUpStack,
+      VhpiUpperRegion,
+      VhpiValExpr,
+      VhpiValSubtype
+     );
+
+   --  Methods used to traverse 1 to many relationships.
+   type VhpiOneToManyT is
+     (
+      VhpiAliasDecls,
+      VhpiArgvs,
+      VhpiAttrDecls,
+      VhpiAttrSpecs,
+      VhpiBasicSignals,
+      VhpiBlockStmts,
+      VhpiBranchs,
+      VhpiCallbacks,
+      VhpiChoices,
+      VhpiCompInstStmts,
+      VhpiCondExprs,
+      VhpiCondWaveforms,
+      VhpiConfigItems,
+      VhpiConfigSpecs,
+      VhpiConstDecls,
+      VhpiConstraints,
+      VhpiContributors,
+      VhpiCurRegions,
+      VhpiDecls,
+      VhpiDepUnits,
+      VhpiDesignUnits,
+      VhpiDrivenSigs,
+      VhpiDrivers,
+      VhpiElemAssocs,
+      VhpiEntityClassEntrys,
+      VhpiEntityDesignators,
+      VhpiEnumLiterals,
+      VhpiForeignfs,
+      VhpiGenericAssocs,
+      VhpiGenericDecls,
+      VhpiIndexExprs,
+      VhpiIndexedNames,
+      VhpiInternalRegions,
+      VhpiMembers,
+      VhpiPackInsts,
+      VhpiParamAssocs,
+      VhpiParamDecls,
+      VhpiPortAssocs,
+      VhpiPortDecls,
+      VhpiRecordElems,
+      VhpiSelectWaveforms,
+      VhpiSelectedNames,
+      VhpiSensitivitys,
+      VhpiSeqStmts,
+      VhpiSigAttrs,
+      VhpiSigDecls,
+      VhpiSigNames,
+      VhpiSignals,
+      VhpiSpecNames,
+      VhpiSpecs,
+      VhpiStmts,
+      VhpiTransactions,
+      VhpiTypeMarks,
+      VhpiUnitDecls,
+      VhpiUses,
+      VhpiVarDecls,
+      VhpiWaveformElems,
+      VhpiLibraryDecls
+     );
+
+   type VhpiIntPropertyT is
+     (
+      VhpiAccessP,
+      VhpiArgcP,
+      VhpiAttrKindP,
+      VhpiBaseIndexP,
+      VhpiBeginLineNoP,
+      VhpiEndLineNoP,
+      VhpiEntityClassP,
+      VhpiForeignKindP,
+      VhpiFrameLevelP,
+      VhpiGenerateIndexP,
+      VhpiIntValP,
+      VhpiIsAnonymousP,
+      VhpiIsBasicP,
+      VhpiIsCompositeP,
+      VhpiIsDefaultP,
+      VhpiIsDeferredP,
+      VhpiIsDiscreteP,
+      VhpiIsForcedP,
+      VhpiIsForeignP,
+      VhpiIsGuardedP,
+      VhpiIsImplicitDeclP,
+      VhpiIsInvalidP_DEPRECATED,
+      VhpiIsLocalP,
+      VhpiIsNamedP,
+      VhpiIsNullP,
+      VhpiIsOpenP,
+      VhpiIsPLIP,
+      VhpiIsPassiveP,
+      VhpiIsPostponedP,
+      VhpiIsProtectedTypeP,
+      VhpiIsPureP,
+      VhpiIsResolvedP,
+      VhpiIsScalarP,
+      VhpiIsSeqStmtP,
+      VhpiIsSharedP,
+      VhpiIsTransportP,
+      VhpiIsUnaffectedP,
+      VhpiIsUnconstrainedP,
+      VhpiIsUninstantiatedP,
+      VhpiIsUpP,
+      VhpiIsVitalP,
+      VhpiIteratorTypeP,
+      VhpiKindP,
+      VhpiLeftBoundP,
+      VhpiLevelP_DEPRECATED,
+      VhpiLineNoP,
+      VhpiLineOffsetP,
+      VhpiLoopIndexP,
+      VhpiModeP,
+      VhpiNumDimensionsP,
+      VhpiNumFieldsP_DEPRECATED,
+      VhpiNumGensP,
+      VhpiNumLiteralsP,
+      VhpiNumMembersP,
+      VhpiNumParamsP,
+      VhpiNumPortsP,
+      VhpiOpenModeP,
+      VhpiPhaseP,
+      VhpiPositionP,
+      VhpiPredefAttrP,
+      VhpiReasonP,
+      VhpiRightBoundP,
+      VhpiSigKindP,
+      VhpiSizeP,
+      VhpiStartLineNoP,
+      VhpiStateP,
+      VhpiStaticnessP,
+      VhpiVHDLversionP,
+      VhpiIdP,
+      VhpiCapabilitiesP
+     );
+
+   --  String properties.
+   type VhpiStrPropertyT is
+     (
+      VhpiCaseNameP,
+      VhpiCompNameP,
+      VhpiDefNameP,
+      VhpiFileNameP,
+      VhpiFullCaseNameP,
+      VhpiFullNameP,
+      VhpiKindStrP,
+      VhpiLabelNameP,
+      VhpiLibLogicalNameP,
+      VhpiLibPhysicalNameP,
+      VhpiLogicalNameP,
+      VhpiLoopLabelNameP,
+      VhpiNameP,
+      VhpiOpNameP,
+      VhpiStrValP,
+      VhpiToolVersionP,
+      VhpiUnitNameP
+     );
+
+   --  Possible Errors.
+   type AvhpiErrorT is
+     (
+      AvhpiErrorOk,
+      AvhpiErrorBadRel,
+      AvhpiErrorHandle,
+      AvhpiErrorNotImplemented,
+      AvhpiErrorIteratorEnd,
+      AvhpiErrorBadIndex
+     );
+
+   type VhpiHandleT is private;
+
+   --  A null handle.
+   Null_Handle : constant VhpiHandleT;
+
+   --  Get the root instance.
+   procedure Get_Root_Inst (Res : out VhpiHandleT);
+
+   --  Get the instanciated packages.
+   procedure Get_Package_Inst (Res : out VhpiHandleT);
+
+   procedure Vhpi_Handle (Rel : VhpiOneToOneT;
+                          Ref : VhpiHandleT;
+                          Res : out VhpiHandleT;
+                          Error : out AvhpiErrorT);
+
+   procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT;
+                                   Ref : VhpiHandleT;
+                                   Index : Natural;
+                                   Res : out VhpiHandleT;
+                                   Error : out AvhpiErrorT);
+
+   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
+                            Ref : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Error : out AvhpiErrorT);
+   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;
+                        Res : out VhpiHandleT;
+                        Error : out AvhpiErrorT);
+
+   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
+                           Obj : VhpiHandleT;
+                           Res : out String;
+                           Len : out Natural);
+
+   subtype VhpiIntT is Ghdl_I32;
+
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out VhpiIntT;
+                       Error : out AvhpiErrorT);
+   procedure Vhpi_Get (Property : VhpiIntPropertyT;
+                       Obj : VhpiHandleT;
+                       Res : out Boolean;
+                       Error : out AvhpiErrorT);
+
+   --  Almost the same as Vhpi_Get_Str (VhpiName, OBJ), but there is not
+   --  indexes for generate stmt.
+   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String;
+
+   --  Return TRUE iff HDL1 and HDL2 are equivalent.
+   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)
+                                 return Boolean;
+
+--    procedure Vhpi_Handle_By_Simple_Name (Ref : VhpiHandleT;
+--                                          Res : out VhpiHandleT;
+--                                          Error : out AvhpiErrorT);
+
+   type VhpiEntityClassT is
+     (
+      VhpiErrorEC,
+      VhpiEntityEC,
+      VhpiArchitectureEC,
+      VhpiConfigurationEC,
+      VhpiProcedureEC,
+      VhpiFunctionEC,
+      VhpiPackageEC,
+      VhpiTypeEC,
+      VhpiSubtypeEC,
+      VhpiConstantEC,
+      VhpiSignalEC,
+      VhpiVariableEC,
+      VhpiComponentEC,
+      VhpiLabelEC,
+      VhpiLiteralEC,
+      VhpiUnitsEC,
+      VhpiFileEC,
+      VhpiGroupEC
+     );
+
+   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
+                                 return VhpiEntityClassT;
+
+   type VhpiModeT is
+     (
+      VhpiErrorMode,
+      VhpiInMode,
+      VhpiOutMode,
+      VhpiInoutMode,
+      VhpiBufferMode,
+      VhpiLinkageMode
+     );
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeT;
+
+   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access;
+
+   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address;
+
+   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context;
+
+   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT;
+
+   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)
+                           return AvhpiErrorT;
+private
+   type VhpiHandleT (Kind : VhpiClassKindT := VhpiUndefined) is record
+      --  Context.
+      Ctxt : Rti_Context;
+
+      case Kind is
+         when VhpiIteratorK =>
+            Rel : VhpiOneToManyT;
+            It_Cur : Ghdl_Index_Type;
+            It2 : Ghdl_Index_Type;
+            Max2 : Ghdl_Index_Type;
+         when AvhpiNameIteratorK
+           | VhpiIndexedNameK =>
+            N_Addr : Address;
+            N_Type : Ghdl_Rti_Access;
+            N_Idx : Ghdl_Index_Type;
+            N_Obj : Ghdl_Rtin_Object_Acc;
+         when VhpiSigDeclK
+           | VhpiPortDeclK
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
+            Obj : Ghdl_Rtin_Object_Acc;
+         when VhpiSubtypeIndicK
+           | VhpiSubtypeDeclK
+           | VhpiArrayTypeDeclK
+           | VhpiEnumTypeDeclK
+           | VhpiPhysTypeDeclK =>
+            Atype : Ghdl_Rti_Access;
+         when VhpiCompInstStmtK =>
+            Inst : Ghdl_Rtin_Instance_Acc;
+         when VhpiIntRangeK
+           | VhpiEnumRangeK
+           | VhpiFloatRangeK
+           | VhpiPhysRangeK =>
+            Rng_Type : Ghdl_Rti_Access;
+            Rng_Addr : Ghdl_Range_Ptr;
+         when others =>
+            null;
+      end case;
+      --  Current Object.
+      --Obj : Ghdl_Rti_Access;
+   end record;
+
+   Null_Handle : constant VhpiHandleT := (Kind => VhpiUndefined,
+                                          Ctxt => (Base => Null_Address,
+                                                   Block => null));
+end Grt.Avhpi;
diff --git a/src/translate/grt/grt-avls.adb b/src/translate/grt/grt-avls.adb
new file mode 100644
index 000000000..7f13ed39a
--- /dev/null
+++ b/src/translate/grt/grt-avls.adb
@@ -0,0 +1,249 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Avls is
+   function Get_Height (Tree: AVL_Tree; N : AVL_Nid) return Ghdl_I32 is
+   begin
+      if N = AVL_Nil then
+         return 0;
+      else
+         return Tree (N).Height;
+      end if;
+   end Get_Height;
+
+   procedure Check_AVL (Tree : AVL_Tree; N : AVL_Nid)
+   is
+      L, R : AVL_Nid;
+      Lh, Rh : Ghdl_I32;
+      H : Ghdl_I32;
+   begin
+      if N = AVL_Nil then
+         return;
+      end if;
+      L := Tree (N).Left;
+      R := Tree (N).Right;
+      H := Get_Height (Tree, N);
+      if L = AVL_Nil and R = AVL_Nil then
+         if Get_Height (Tree, N) /= 1 then
+            Internal_Error ("check_AVL(1)");
+         end if;
+         return;
+      elsif L = AVL_Nil then
+         Check_AVL (Tree, R);
+         if H /= Get_Height (Tree, R) + 1 or H > 2 then
+            Internal_Error ("check_AVL(2)");
+         end if;
+      elsif R = AVL_Nil then
+         Check_AVL (Tree, L);
+         if H /= Get_Height (Tree, L) + 1 or H > 2 then
+            Internal_Error ("check_AVL(3)");
+         end if;
+      else
+         Check_AVL (Tree, L);
+         Check_AVL (Tree, R);
+         Lh := Get_Height (Tree, L);
+         Rh := Get_Height (Tree, R);
+         if Ghdl_I32'Max (Lh, Rh) + 1 /= H then
+            Internal_Error ("check_AVL(4)");
+         end if;
+         if Rh - Lh > 1 or Rh - Lh < -1 then
+            Internal_Error ("check_AVL(5)");
+         end if;
+      end if;
+   end Check_AVL;
+
+   procedure Compute_Height (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+   begin
+      Tree (N).Height :=
+        Ghdl_I32'Max (Get_Height (Tree, Tree (N).Left),
+                      Get_Height (Tree, Tree (N).Right)) + 1;
+   end Compute_Height;
+
+   procedure Simple_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      R : AVL_Nid;
+      V : AVL_Value;
+   begin
+      --  Rotate nodes.
+      R := Tree (N).Right;
+      Tree (N).Right := Tree (R).Right;
+      Tree (R).Right := Tree (R).Left;
+      Tree (R).Left := Tree (N).Left;
+      Tree (N).Left := R;
+      --  Swap vals.
+      V := Tree (N).Val;
+      Tree (N).Val := Tree (R).Val;
+      Tree (R).Val := V;
+      --  Adjust bal.
+      Compute_Height (Tree, R);
+      Compute_Height (Tree, N);
+   end Simple_Rotate_Right;
+
+   procedure Simple_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      L : AVL_Nid;
+      V : AVL_Value;
+   begin
+      L := Tree (N).Left;
+      Tree (N).Left := Tree (L).Left;
+      Tree (L).Left := Tree (L).Right;
+      Tree (L).Right := Tree (N).Right;
+      Tree (N).Right := L;
+      V := Tree (N).Val;
+      Tree (N).Val := Tree (L).Val;
+      Tree (L).Val := V;
+      Compute_Height (Tree, L);
+      Compute_Height (Tree, N);
+   end Simple_Rotate_Left;
+
+   procedure Double_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      R : AVL_Nid;
+   begin
+      R := Tree (N).Right;
+      Simple_Rotate_Left (Tree, R);
+      Simple_Rotate_Right (Tree, N);
+   end Double_Rotate_Right;
+
+   procedure Double_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      L : AVL_Nid;
+   begin
+      L := Tree (N).Left;
+      Simple_Rotate_Right (Tree, L);
+      Simple_Rotate_Left (Tree, N);
+   end Double_Rotate_Left;
+
+   procedure Insert (Tree : in out AVL_Tree;
+                    Cmp : AVL_Compare_Func;
+                    Val : AVL_Nid;
+                    N : AVL_Nid;
+                    Res : out AVL_Nid)
+   is
+      Diff : Integer;
+      Op_Ch, Ch : AVL_Nid;
+   begin
+      Diff := Cmp.all (Tree (Val).Val, Tree (N).Val);
+      if Diff = 0 then
+         Res := N;
+         return;
+      end if;
+      if Diff < 0 then
+         if Tree (N).Left = AVL_Nil then
+            Tree (N).Left := Val;
+            Compute_Height (Tree, N);
+            --  N is balanced.
+            Res := Val;
+         else
+            Ch := Tree (N).Left;
+            Op_Ch := Tree (N).Right;
+            Insert (Tree, Cmp, Val, Ch, Res);
+            if Res /= Val then
+               return;
+            end if;
+            if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then
+               --  Rotate
+               if Get_Height (Tree, Tree (Ch).Left)
+                 > Get_Height (Tree, Tree (Ch).Right)
+               then
+                  Simple_Rotate_Left (Tree, N);
+               else
+                  Double_Rotate_Left (Tree, N);
+               end if;
+            else
+               Compute_Height (Tree, N);
+            end if;
+         end if;
+      else
+         if Tree (N).Right = AVL_Nil then
+            Tree (N).Right := Val;
+            Compute_Height (Tree, N);
+            --  N is balanced.
+            Res := Val;
+         else
+            Ch := Tree (N).Right;
+            Op_Ch := Tree (N).Left;
+            Insert (Tree, Cmp, Val, Ch, Res);
+            if Res /= Val then
+               return;
+            end if;
+            if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then
+               --  Rotate
+               if Get_Height (Tree, Tree (Ch).Right)
+                 > Get_Height (Tree, Tree (Ch).Left)
+               then
+                  Simple_Rotate_Right (Tree, N);
+               else
+                  Double_Rotate_Right (Tree, N);
+               end if;
+            else
+               Compute_Height (Tree, N);
+            end if;
+         end if;
+      end if;
+   end Insert;
+
+   procedure Get_Node (Tree : in out AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       N : AVL_Nid;
+                       Res : out AVL_Nid)
+   is
+   begin
+      if Tree'First /= AVL_Root or N /= Tree'Last then
+         Internal_Error ("avls.get_node");
+      end if;
+      Insert (Tree, Cmp, N, AVL_Root, Res);
+      Check_AVL (Tree, AVL_Root);
+   end Get_Node;
+
+   function Find_Node (Tree : AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       Val : AVL_Value) return AVL_Nid
+   is
+      N : AVL_Nid;
+      Diff : Integer;
+   begin
+      N := AVL_Root;
+      if Tree'Last < AVL_Root then
+         return AVL_Nil;
+      end if;
+      loop
+         Diff := Cmp.all (Val, Tree (N).Val);
+         if Diff = 0 then
+            return N;
+         end if;
+         if Diff < 0 then
+            N := Tree (N).Left;
+         else
+            N := Tree (N).Right;
+         end if;
+         if N = AVL_Nil then
+            return AVL_Nil;
+         end if;
+      end loop;
+   end Find_Node;
+end Grt.Avls;
diff --git a/src/translate/grt/grt-avls.ads b/src/translate/grt/grt-avls.ads
new file mode 100644
index 000000000..790053c6f
--- /dev/null
+++ b/src/translate/grt/grt-avls.ads
@@ -0,0 +1,84 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+
+package Grt.Avls is
+   --  Implementation of a binary balanced tree.
+   --  This package is very generic, and provides only the algorithm.
+   --  The user must provide the storage of the tree.
+   --  The basic types of this implementation ares:
+   --  * AVL_Value: the value stored in the tree.  This is an integer on 32
+   --    bits.  However, they may either really represent integers or an index
+   --    into another table.  To compare two values, a user function is always
+   --    provided.
+   --  * AVL_Nid: a node id or an index into the tree.
+   --  * AVL_Node: a node, indexed by AVL_Nid.
+   --  * AVL_Tree: an array of AVL_Node, indexed by AVL_Nid.  This represents
+   --    the tree.  The root of the tree is always AVL_Root, which is the
+   --    first element of the array.
+   --
+   --  As a choice, this package never allocate nodes.  So, to insert a value
+   --  in the tree, the user must allocate an (empty) node, set the value of
+   --  the node and try to insert this node into the tree.  If the value is
+   --  already in the tree, Get_Node will returns the node id which contains
+   --  the value.  Otherwise, Get_Node returns the node just created by the
+   --  user.
+
+   --  The value in an AVL tree.
+   --  This is fixed.
+   type AVL_Value is new Ghdl_I32;
+
+   --  An AVL node id.
+   type AVL_Nid is new Ghdl_I32;
+   AVL_Nil : constant AVL_Nid := 0;
+   AVL_Root : constant AVL_Nid := 1;
+
+   type AVL_Node is record
+      Val : AVL_Value;
+      Left : AVL_Nid;
+      Right : AVL_Nid;
+      Height : Ghdl_I32;
+   end record;
+
+   type AVL_Tree is array (AVL_Nid range <>) of AVL_Node;
+
+   --  Compare two values.
+   --  Returns < 0 if L < R, 0 if L = R, > 0 if L > R.
+   type AVL_Compare_Func is access function (L, R : AVL_Value) return Integer;
+
+   --  Try to insert node N into TREE.
+   --  Returns either N or the node id of a node containing already the value.
+   procedure Get_Node (Tree : in out AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       N : AVL_Nid;
+                       Res : out AVL_Nid);
+
+   function Find_Node (Tree : AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       Val : AVL_Value) return AVL_Nid;
+
+end Grt.Avls;
+
+
diff --git a/src/translate/grt/grt-c.ads b/src/translate/grt/grt-c.ads
new file mode 100644
index 000000000..24003cf4a
--- /dev/null
+++ b/src/translate/grt/grt-c.ads
@@ -0,0 +1,54 @@
+--  GHDL Run Time (GRT) - C interface.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+--  This package declares C types.
+--  It is a really stripped down version of interfaces.C!
+with System;
+
+package Grt.C is
+   pragma Preelaborate (Grt.C);
+
+   --  Type void * and char *.
+   subtype voids is System.Address;
+   subtype chars is System.Address;
+   subtype long is Long_Integer;
+
+   --  Type size_t.
+   type size_t is mod 2 ** Standard'Address_Size;
+
+   --  Type int.  It is an alias on Integer for simplicity.
+   subtype int is Integer;
+
+   --  Low level memory management.
+   procedure Free (Addr : System.Address);
+   function Malloc (Size : size_t) return System.Address;
+   function Realloc (Ptr : System.Address; Size : size_t)
+                    return System.Address;
+
+private
+   pragma Import (C, Free);
+   pragma Import (C, Malloc);
+   pragma Import (C, Realloc);
+end Grt.C;
diff --git a/src/translate/grt/grt-cbinding.c b/src/translate/grt/grt-cbinding.c
new file mode 100644
index 000000000..b95c0f0a9
--- /dev/null
+++ b/src/translate/grt/grt-cbinding.c
@@ -0,0 +1,99 @@
+/*  GRT C bindings.
+    Copyright (C) 2002, 2003, 2004, 2005 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.
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+FILE *
+__ghdl_get_stdout (void)
+{
+  return stdout;
+}
+
+FILE *
+__ghdl_get_stdin (void)
+{
+  return stdin;
+}
+
+FILE *
+__ghdl_get_stderr (void)
+{
+  return stderr;
+}
+
+int
+__ghdl_snprintf_g (char *buf, unsigned int len, double val)
+{
+  snprintf (buf, len, "%g", val);
+  return strlen (buf);
+}
+
+void
+__ghdl_snprintf_nf (char *buf, unsigned int len, int ndigits, double val)
+{
+  snprintf (buf, len, "%.*f", ndigits, val);
+}
+
+void
+__ghdl_snprintf_fmtf (char *buf, unsigned int len,
+		      const char *format, double v)
+{
+  snprintf (buf, len, format, v);
+}
+
+void
+__ghdl_fprintf_g (FILE *stream, double val)
+{
+  fprintf (stream, "%g", val);
+}
+
+void
+__ghdl_fprintf_clock (FILE *stream, int a, int b)
+{
+  fprintf (stream, "%3d.%03d", a, b);
+}
+
+#ifndef WITH_GNAT_RUN_TIME
+void
+__gnat_last_chance_handler (void)
+{
+  abort ();
+}
+
+void *
+__gnat_malloc (size_t size)
+{
+  void *res;
+  res = malloc (size);
+  return res;
+}
+
+void
+__gnat_free (void *ptr)
+{
+  free (ptr);
+}
+
+void *
+__gnat_realloc (void *ptr, size_t size)
+{
+  return realloc (ptr, size);
+}
+#endif
diff --git a/src/translate/grt/grt-cvpi.c b/src/translate/grt/grt-cvpi.c
new file mode 100644
index 000000000..51edd678f
--- /dev/null
+++ b/src/translate/grt/grt-cvpi.c
@@ -0,0 +1,277 @@
+/*  GRT VPI C helpers.
+    Copyright (C) 2003, 2004, 2005 Tristan Gingold & Felix Bertram
+
+    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.
+*/
+//-----------------------------------------------------------------------------
+// Description: VPI interface for GRT runtime, "C" helpers
+//              the main purpose of this code is to interface with the
+//              Icarus Verilog Interactive (IVI) simulator GUI
+//-----------------------------------------------------------------------------
+
+#include <stdio.h>
+#include <stdlib.h>
+
+//-----------------------------------------------------------------------------
+// VPI callback functions
+typedef void *vpiHandle, *p_vpi_time, *p_vpi_value;
+typedef struct t_cb_data {
+      int reason;
+      int (*cb_rtn)(struct t_cb_data*cb);
+      vpiHandle obj;
+      p_vpi_time time;
+      p_vpi_value value;
+      int index;
+      char*user_data;
+} s_cb_data, *p_cb_data;
+
+//-----------------------------------------------------------------------------
+// vpi thunking a la Icarus Verilog
+#include <stdarg.h>
+typedef void *s_vpi_time, *p_vpi_vlog_info, *p_vpi_error_info;
+#define VPI_THUNK_MAGIC  (0x87836BA5)
+struct t_vpi_systf_data;
+void         vpi_register_systf  (const struct t_vpi_systf_data*ss);
+void         vpi_vprintf         (const char*fmt, va_list ap);
+unsigned int vpi_mcd_close       (unsigned int mcd);
+char *       vpi_mcd_name        (unsigned int mcd);
+unsigned int vpi_mcd_open        (char *name);
+unsigned int vpi_mcd_open_x      (char *name, char *mode);
+int          vpi_mcd_vprintf     (unsigned int mcd, const char*fmt, va_list ap);
+int          vpi_mcd_fputc       (unsigned int mcd, unsigned char x);
+int          vpi_mcd_fgetc       (unsigned int mcd);
+vpiHandle    vpi_register_cb     (p_cb_data data);
+int          vpi_remove_cb       (vpiHandle ref);
+void         vpi_sim_vcontrol    (int operation, va_list ap);
+vpiHandle    vpi_handle          (int type, vpiHandle ref);
+vpiHandle    vpi_iterate         (int type, vpiHandle ref);
+vpiHandle    vpi_scan            (vpiHandle iter);
+vpiHandle    vpi_handle_by_index (vpiHandle ref, int index);
+void         vpi_get_time        (vpiHandle obj, s_vpi_time*t);
+int          vpi_get             (int property, vpiHandle ref);
+char*        vpi_get_str         (int property, vpiHandle ref);
+void         vpi_get_value       (vpiHandle expr, p_vpi_value value);
+vpiHandle    vpi_put_value       (vpiHandle obj, p_vpi_value value,
+                                  p_vpi_time when, int flags);
+int          vpi_free_object     (vpiHandle ref);
+int          vpi_get_vlog_info   (p_vpi_vlog_info vlog_info_p);
+int          vpi_chk_error       (p_vpi_error_info info);
+vpiHandle    vpi_handle_by_name  (char *name, vpiHandle scope);
+
+typedef struct {
+	int magic;
+	void         (*vpi_register_systf) (const struct t_vpi_systf_data*ss);
+	void         (*vpi_vprintf)        (const char*fmt, va_list ap);
+	unsigned int (*vpi_mcd_close)      (unsigned int mcd);
+	char*        (*vpi_mcd_name)       (unsigned int mcd);
+	unsigned int (*vpi_mcd_open)       (char *name);
+	unsigned int (*vpi_mcd_open_x)     (char *name, char *mode);
+	int          (*vpi_mcd_vprintf)    (unsigned int mcd, const char*fmt, va_list ap);
+	int          (*vpi_mcd_fputc)      (unsigned int mcd, unsigned char x);
+	int          (*vpi_mcd_fgetc)      (unsigned int mcd);
+	vpiHandle    (*vpi_register_cb)    (p_cb_data data);
+	int          (*vpi_remove_cb)      (vpiHandle ref);
+	void         (*vpi_sim_vcontrol)   (int operation, va_list ap);
+	vpiHandle    (*vpi_handle)         (int type, vpiHandle ref);
+	vpiHandle    (*vpi_iterate)        (int type, vpiHandle ref);
+	vpiHandle    (*vpi_scan)           (vpiHandle iter);
+	vpiHandle    (*vpi_handle_by_index)(vpiHandle ref, int index);
+	void         (*vpi_get_time)       (vpiHandle obj, s_vpi_time*t);
+	int          (*vpi_get)            (int property, vpiHandle ref);
+	char*        (*vpi_get_str)        (int property, vpiHandle ref);
+	void         (*vpi_get_value)      (vpiHandle expr, p_vpi_value value);
+	vpiHandle    (*vpi_put_value)      (vpiHandle obj, p_vpi_value value,
+	                                    p_vpi_time when, int flags);
+	int          (*vpi_free_object)    (vpiHandle ref);
+	int          (*vpi_get_vlog_info)  (p_vpi_vlog_info vlog_info_p);
+	int          (*vpi_chk_error)      (p_vpi_error_info info);
+	vpiHandle    (*vpi_handle_by_name) (char *name, vpiHandle scope);
+} vpi_thunk, *p_vpi_thunk;
+
+int vpi_register_sim(p_vpi_thunk tp);
+
+static vpi_thunk thunkTable = 
+{	VPI_THUNK_MAGIC,
+	vpi_register_systf,
+	vpi_vprintf,
+	vpi_mcd_close,
+	vpi_mcd_name,
+	vpi_mcd_open,
+	0, //vpi_mcd_open_x,
+	0, //vpi_mcd_vprintf,
+	0, //vpi_mcd_fputc,
+	0, //vpi_mcd_fgetc,
+	vpi_register_cb,
+	vpi_remove_cb,
+	0, //vpi_sim_vcontrol,
+	vpi_handle,
+	vpi_iterate,
+	vpi_scan,
+	vpi_handle_by_index,
+	vpi_get_time,
+	vpi_get,
+	vpi_get_str,
+	vpi_get_value,
+	vpi_put_value,
+	vpi_free_object,
+	vpi_get_vlog_info,
+	0, //vpi_chk_error,
+	0 //vpi_handle_by_name
+};
+
+//-----------------------------------------------------------------------------
+// VPI module load & startup
+static void * module_open (const char *path);
+static void * module_symbol (void *handle, const char *symbol);
+static const char *module_error (void);
+
+#if defined(__WIN32__)
+#include <windows.h>
+static void *
+module_open (const char *path)
+{
+  return (void *)LoadLibrary (path);
+}
+
+static void *
+module_symbol (void *handle, const char *symbol)
+{
+  return (void *)GetProcAddress ((HMODULE)handle, symbol);
+}
+
+static const char *
+module_error (void)
+{
+  static char msg[256];
+
+  FormatMessage
+    (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+     NULL,
+     GetLastError (),
+     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+     (LPTSTR) &msg,
+     sizeof (msg) - 1,
+     NULL);
+  return msg;
+}
+#else
+#include <dlfcn.h>
+static void *
+module_open (const char *path)
+{
+  return dlopen (path, RTLD_LAZY);
+}
+
+static void *
+module_symbol (void *handle, const char *symbol)
+{
+  return dlsym (handle, symbol);
+}
+
+static const char *
+module_error (void)
+{
+  return dlerror ();
+}
+#endif
+
+int
+loadVpiModule (const char* modulename)
+{
+  static const char * const vpitablenames[] =
+    {
+      "_vlog_startup_routines", // with leading underscore: MacOSX
+      "vlog_startup_routines"   // w/o  leading underscore: Linux
+    };
+  static const char * const vpithunknames[] =
+    {
+      "_vpi_register_sim",      // with leading underscore: MacOSX
+      "vpi_register_sim"        // w/o  leading underscore: Linux
+    };
+
+  int i;	
+  void* vpimod;
+
+  fprintf (stderr, "loading VPI module '%s'\n", modulename);
+
+  vpimod = module_open (modulename);
+
+  if (vpimod == NULL)
+    {
+      const char *msg;
+
+      msg = module_error ();
+
+      fprintf (stderr, "%s\n", msg == NULL ? "unknown dlopen error" : msg);
+      return -1;
+    }
+
+  for (i = 0; i < 2; i++) // try with and w/o leading underscores
+    {
+      void* vpithunk;
+      void* vpitable;
+	  
+      vpitable = module_symbol (vpimod, vpitablenames[i]);
+      vpithunk = module_symbol (vpimod, vpithunknames[i]);
+	  
+      if (vpithunk)
+	{
+	  typedef int (*funT)(p_vpi_thunk tp);
+	  funT regsim;
+	  
+	  regsim = (funT)vpithunk;
+	  regsim (&thunkTable);
+	}
+      else
+	{
+	  // this is not an error, as the register-mechanism
+	  // is not standardized
+	}
+      
+      if (vpitable)
+	{
+	  unsigned int tmp;
+	  //extern void (*vlog_startup_routines[])();
+	  typedef void (*vlog_startup_routines_t)(void);
+	  vlog_startup_routines_t *vpifuns;
+				
+	  vpifuns = (vlog_startup_routines_t*)vpitable;
+	  for (tmp = 0; vpifuns[tmp]; tmp++)
+	    {
+	      vpifuns[tmp]();
+	    }
+	  
+	  fprintf (stderr, "VPI module loaded!\n");
+	  return 0; // successfully registered VPI module
+	}
+    }
+  fprintf (stderr, "vlog_startup_routines not found\n");
+  return -1; // failed to register VPI module
+}
+
+void
+vpi_printf (const char *fmt, ...)
+{
+  va_list params;
+
+  va_start (params, fmt);
+  vprintf (fmt, params);
+  va_end (params);
+}
+
+//-----------------------------------------------------------------------------
+// end of file
+
diff --git a/src/translate/grt/grt-disp.adb b/src/translate/grt/grt-disp.adb
new file mode 100644
index 000000000..e68b1168b
--- /dev/null
+++ b/src/translate/grt/grt-disp.adb
@@ -0,0 +1,227 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Stdio; use Grt.Stdio;
+--with Grt.Errors; use Grt.Errors;
+
+package body Grt.Disp is
+
+--    procedure Put_Trim (Stream : FILEs; Str : String)
+--    is
+--       Start : Natural;
+--    begin
+--       Start := Str'First;
+--       while Start <= Str'Last and then Str (Start) = ' ' loop
+--          Start := Start + 1;
+--       end loop;
+--       Put (Stream, Str (Start .. Str'Last));
+--    end Put_Trim;
+
+--   procedure Put_E8 (Stream : FILEs; E8 : Ghdl_E8; Type_Desc : Ghdl_Desc_Ptr)
+--    is
+--    begin
+--       Put_Str_Len (Stream, Type_Desc.E8.Values (Natural (E8)));
+--    end Put_E8;
+
+   --procedure Put_E32
+   --  (Stream : FILEs; E32 : Ghdl_E32; Type_Desc : Ghdl_Desc_Ptr)
+   --is
+   --begin
+   --   Put_Str_Len (Stream, Type_Desc.E32.Values (Natural (E32)));
+   --end Put_E32;
+
+   procedure Put_Sig_Index (Sig : Sig_Table_Index)
+   is
+   begin
+      Put_I32 (stdout, Ghdl_I32 (Sig));
+   end Put_Sig_Index;
+
+   procedure Put_Sig_Range (Sig : Sig_Table_Range)
+   is
+   begin
+      Put_Sig_Index (Sig.First);
+      if Sig.Last /= Sig.First then
+         Put ("-");
+         Put_Sig_Index (Sig.Last);
+      end if;
+   end Put_Sig_Range;
+
+   procedure Disp_Now
+   is
+   begin
+      Put ("Now is ");
+      Put_Time (stdout, Current_Time);
+      Put (" +");
+      Put_I32 (stdout, Ghdl_I32 (Current_Delta));
+      New_Line;
+   end Disp_Now;
+
+   procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type)
+   is
+   begin
+      case Kind is
+         when Drv_One_Driver =>
+            Put ("Drv (1 drv) ");
+         when Eff_One_Driver =>
+            Put ("Eff (1 drv) ");
+         when Drv_One_Port =>
+            Put ("Drv (1 prt) ");
+         when Eff_One_Port =>
+            Put ("Eff (1 prt) ");
+         when Imp_Forward =>
+            Put ("Forward ");
+         when Imp_Forward_Build =>
+            Put ("Forward_Build ");
+         when Imp_Guard =>
+            Put ("Guard ");
+         when Imp_Stable =>
+            Put ("Stable ");
+         when Imp_Quiet =>
+            Put ("Quiet ");
+         when Imp_Transaction =>
+            Put ("Transaction ");
+         when Imp_Delayed =>
+            Put ("Delayed ");
+         when Eff_Actual =>
+            Put ("Eff Actual ");
+         when Eff_Multiple =>
+            Put ("Eff multiple ");
+         when Drv_One_Resolved =>
+            Put ("Drv 1 resolved ");
+         when Eff_One_Resolved =>
+            Put ("Eff 1 resolved ");
+         when In_Conversion =>
+            Put ("In conv ");
+         when Out_Conversion =>
+            Put ("Out conv ");
+         when Drv_Error =>
+            Put ("Drv error ");
+         when Drv_Multiple =>
+            Put ("Drv multiple ");
+         when Prop_End =>
+            Put ("end ");
+      end case;
+   end Disp_Propagation_Kind;
+
+   procedure Disp_Signals_Order is
+   begin
+      for I in Propagation.First .. Propagation.Last loop
+         Put_I32 (stdout, Ghdl_I32 (I));
+         Put (": ");
+         Disp_Propagation_Kind (Propagation.Table (I).Kind);
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver
+              | Drv_One_Port
+              | Eff_One_Port
+              | Drv_One_Resolved
+              | Eff_One_Resolved
+              | Imp_Guard
+              | Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction
+              | Imp_Delayed
+              | Eff_Actual =>
+               Put_Sig_Index (Signal_Ptr_To_Index (Propagation.Table (I).Sig));
+               New_Line;
+            when Imp_Forward =>
+               Put_I32 (stdout, Ghdl_I32 (Propagation.Table (I).Sig.Net));
+               New_Line;
+            when Imp_Forward_Build =>
+               declare
+                  Forward : Forward_Build_Acc;
+               begin
+                  Forward := Propagation.Table (I).Forward;
+                  Put_Sig_Index (Signal_Ptr_To_Index (Forward.Src));
+                  Put (" -> ");
+                  Put_Sig_Index (Signal_Ptr_To_Index (Forward.Targ));
+                  New_Line;
+               end;
+            when Eff_Multiple
+              | Drv_Multiple =>
+               Put_Sig_Range (Propagation.Table (I).Resolv.Sig_Range);
+               New_Line;
+            when In_Conversion
+              | Out_Conversion =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+               begin
+                  Conv := Propagation.Table (I).Conv;
+                  Put_Sig_Range (Conv.Src);
+                  Put (" -> ");
+                  Put_Sig_Range (Conv.Dest);
+                  New_Line;
+               end;
+            when Prop_End =>
+               New_Line;
+            when Drv_Error =>
+               null;
+         end case;
+      end loop;
+   end Disp_Signals_Order;
+
+   procedure Disp_Mode (Mode : Mode_Type)
+   is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            Put (" b1");
+         when Mode_E8 =>
+            Put (" e8");
+         when Mode_E32 =>
+            Put ("e32");
+         when Mode_I32 =>
+            Put ("i32");
+         when Mode_I64 =>
+            Put ("i64");
+         when Mode_F64 =>
+            Put ("f64");
+      end case;
+   end Disp_Mode;
+
+   procedure Disp_Value (Value : Value_Union; Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            if Value.B1 then
+               Put ("T");
+            else
+               Put ("F");
+            end if;
+         when Mode_E8 =>
+            Put_I32 (stdout, Ghdl_I32 (Value.E8));
+         when Mode_E32 =>
+            Put_I32 (stdout, Ghdl_I32 (Value.E32));
+         when Mode_I32 =>
+            Put_I32 (stdout, Value.I32);
+         when Mode_I64 =>
+            Put_I64 (stdout, Value.I64);
+         when Mode_F64 =>
+            Put_F64 (stdout, Value.F64);
+      end case;
+   end Disp_Value;
+end Grt.Disp;
diff --git a/src/translate/grt/grt-disp.ads b/src/translate/grt/grt-disp.ads
new file mode 100644
index 000000000..6c15b37c9
--- /dev/null
+++ b/src/translate/grt/grt-disp.ads
@@ -0,0 +1,46 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Signals; use Grt.Signals;
+with Grt.Types; use Grt.Types;
+
+package Grt.Disp is
+   --  Display SIG number.
+   procedure Put_Sig_Index (Sig : Sig_Table_Index);
+
+   --  Disp current time and current delta.
+   procedure Disp_Now;
+
+   procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type);
+
+   --  Disp signals propagation order.
+   procedure Disp_Signals_Order;
+
+   --  Disp mode.
+   procedure Disp_Mode (Mode : Mode_Type);
+
+   --  Disp value (numeric).
+   procedure Disp_Value (Value : Value_Union; Mode : Mode_Type);
+
+end Grt.Disp;
diff --git a/src/translate/grt/grt-disp_rti.adb b/src/translate/grt/grt-disp_rti.adb
new file mode 100644
index 000000000..08d27dacb
--- /dev/null
+++ b/src/translate/grt/grt-disp_rti.adb
@@ -0,0 +1,1080 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Errors; use Grt.Errors;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+
+package body Grt.Disp_Rti is
+   procedure Disp_Kind (Kind : Ghdl_Rtik);
+
+   procedure Disp_Name (Name : Ghdl_C_String) is
+   begin
+      if Name = null then
+         Put (stdout, "<anonymous>");
+      else
+         Put (stdout, Name);
+      end if;
+   end Disp_Name;
+
+   --  Disp value stored at ADDR and whose type is described by RTI.
+   procedure Disp_Enum_Value
+     (Stream : FILEs; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Put (Stream, Enum_Rti.Names (Val));
+   end Disp_Enum_Value;
+
+   procedure Disp_Scalar_Value
+     (Stream : FILEs;
+      Rti : Ghdl_Rti_Access;
+      Addr : in out Address;
+      Is_Sig : Boolean)
+   is
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Addr := Addr + (S / Storage_Unit);
+      end Update;
+
+      Vptr : Ghdl_Value_Ptr;
+   begin
+      if Is_Sig then
+         Vptr := To_Ghdl_Value_Ptr (To_Addr_Acc (Addr).all);
+         Update (Address'Size);
+      else
+         Vptr := To_Ghdl_Value_Ptr (Addr);
+      end if;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            Put_I32 (Stream, Vptr.I32);
+            if not Is_Sig then
+               Update (32);
+            end if;
+         when Ghdl_Rtik_Type_E8 =>
+            Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+            if not Is_Sig then
+               Update (8);
+            end if;
+         when Ghdl_Rtik_Type_E32 =>
+            Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
+            if not Is_Sig then
+               Update (32);
+            end if;
+         when Ghdl_Rtik_Type_B1 =>
+            Disp_Enum_Value (Stream, Rti,
+                             Ghdl_Index_Type (Ghdl_B1'Pos (Vptr.B1)));
+            if not Is_Sig then
+               Update (8);
+            end if;
+         when Ghdl_Rtik_Type_F64 =>
+            Put_F64 (Stream, Vptr.F64);
+            if not Is_Sig then
+               Update (64);
+            end if;
+         when Ghdl_Rtik_Type_P64 =>
+            Put_I64 (Stream, Vptr.I64);
+            Put (Stream, " ");
+            Put (Stream,
+                 Get_Physical_Unit_Name
+                   (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)));
+            if not Is_Sig then
+               Update (64);
+            end if;
+         when Ghdl_Rtik_Type_P32 =>
+            Put_I32 (Stream, Vptr.I32);
+            Put (Stream, " ");
+            Put (Stream,
+                 Get_Physical_Unit_Name
+                   (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)));
+            if not Is_Sig then
+               Update (32);
+            end if;
+         when others =>
+            Internal_Error ("disp_rti.disp_scalar_value");
+      end case;
+   end Disp_Scalar_Value;
+
+--    function Get_Scalar_Type_Kind (Rti : Ghdl_Rti_Access) return Ghdl_Rtik
+--    is
+--       Ndef : Ghdl_Rti_Access;
+--    begin
+--       if Rti.Kind = Ghdl_Rtik_Subtype_Scalar then
+--          Ndef := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype;
+--       else
+--          Ndef := Rti;
+--       end if;
+--       case Ndef.Kind is
+--          when Ghdl_Rtik_Type_I32 =>
+--             return Ndef.Kind;
+--          when others =>
+--             return Ghdl_Rtik_Error;
+--       end case;
+--    end Get_Scalar_Type_Kind;
+
+   procedure Disp_Array_Value_1 (Stream : FILEs;
+                                 El_Rti : Ghdl_Rti_Access;
+                                 Ctxt : Rti_Context;
+                                 Rngs : Ghdl_Range_Array;
+                                 Rtis : Ghdl_Rti_Arr_Acc;
+                                 Index : Ghdl_Index_Type;
+                                 Obj : in out Address;
+                                 Is_Sig : Boolean)
+   is
+      Length : Ghdl_Index_Type;
+   begin
+      Length := Range_To_Length (Rngs (Index), Get_Base_Type (Rtis (Index)));
+      Put (Stream, "(");
+      for I in 1 .. Length loop
+         if I /= 1 then
+            Put (Stream, ", ");
+         end if;
+         if Index = Rngs'Last then
+            Disp_Value (Stream, El_Rti, Ctxt, Obj, Is_Sig);
+         else
+            Disp_Array_Value_1
+              (Stream, El_Rti, Ctxt, Rngs, Rtis, Index + 1, Obj, Is_Sig);
+         end if;
+      end loop;
+      Put (Stream, ")");
+   end Disp_Array_Value_1;
+
+   procedure Disp_Array_Value (Stream : FILEs;
+                               Rti : Ghdl_Rtin_Type_Array_Acc;
+                               Ctxt : Rti_Context;
+                               Vals : Ghdl_Uc_Array_Acc;
+                               Is_Sig : Boolean)
+   is
+      Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim;
+      Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
+      Obj : Address;
+   begin
+      Bound_To_Range (Vals.Bounds, Rti, Rngs);
+      Obj := Vals.Base;
+      Disp_Array_Value_1
+        (Stream, Rti.Element, Ctxt, Rngs, Rti.Indexes, 0, Obj, Is_Sig);
+   end Disp_Array_Value;
+
+   procedure Disp_Record_Value (Stream : FILEs;
+                                Rti : Ghdl_Rtin_Type_Record_Acc;
+                                Ctxt : Rti_Context;
+                                Obj : Address;
+                                Is_Sig : Boolean)
+   is
+      El : Ghdl_Rtin_Element_Acc;
+      El_Addr : Address;
+   begin
+      Put (Stream, "(");
+      for I in 1 .. Rti.Nbrel loop
+         El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
+         if I /= 1 then
+            Put (", ");
+         end if;
+         Put (Stream, El.Name);
+         Put (" => ");
+         if Is_Sig then
+            El_Addr := Obj + El.Sig_Off;
+         else
+            El_Addr := Obj + El.Val_Off;
+         end if;
+         if Rti_Complex_Type (El.Eltype) then
+            El_Addr := Obj + To_Ghdl_Index_Acc (El_Addr).all;
+         end if;
+         Disp_Value (Stream, El.Eltype, Ctxt, El_Addr, Is_Sig);
+      end loop;
+      Put (")");
+      --  FIXME: update ADDR.
+   end Disp_Record_Value;
+
+   procedure Disp_Value
+     (Stream : FILEs;
+      Rti : Ghdl_Rti_Access;
+      Ctxt : Rti_Context;
+      Obj : in out Address;
+      Is_Sig : Boolean)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Disp_Scalar_Value
+              (Stream, To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype,
+               Obj, Is_Sig);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32
+           | Ghdl_Rtik_Type_B1 =>
+            Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig);
+         when Ghdl_Rtik_Type_Array =>
+            Disp_Array_Value (Stream, To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt,
+                              To_Ghdl_Uc_Array_Acc (Obj), Is_Sig);
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               St : constant Ghdl_Rtin_Subtype_Array_Acc :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+               Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               B : Address;
+            begin
+               Bound_To_Range
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+               B := Obj;
+               Disp_Array_Value_1
+                 (Stream, Bt.Element, Ctxt, Rngs, Bt.Indexes, 0, B, Is_Sig);
+            end;
+         when Ghdl_Rtik_Type_File =>
+            declare
+               Vptr : Ghdl_Value_Ptr;
+            begin
+               Vptr := To_Ghdl_Value_Ptr (Obj);
+               Put (Stream, "File#");
+               Put_I32 (Stream, Vptr.I32);
+               --  FIXME: update OBJ (not very useful since never in a
+               --   composite type).
+            end;
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Record_Value
+              (Stream, To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Obj, Is_Sig);
+         when Ghdl_Rtik_Type_Protected =>
+            Put (Stream, "Unhandled protected type");
+         when others =>
+            Put (Stream, "Unknown Rti Kind : ");
+            Disp_Kind(Rti.Kind);
+      end case;
+      --  Put_Line(":");
+   end Disp_Value;
+
+   procedure Disp_Kind (Kind : Ghdl_Rtik) is
+   begin
+      case Kind is
+         when Ghdl_Rtik_Top =>
+            Put ("ghdl_rtik_top");
+         when Ghdl_Rtik_Package =>
+            Put ("ghdl_rtik_package");
+         when Ghdl_Rtik_Package_Body =>
+            Put ("ghdl_rtik_package_body");
+         when Ghdl_Rtik_Entity =>
+            Put ("ghdl_rtik_entity");
+         when Ghdl_Rtik_Architecture =>
+            Put ("ghdl_rtik_architecture");
+
+         when Ghdl_Rtik_Port =>
+            Put ("ghdl_rtik_port");
+         when Ghdl_Rtik_Generic =>
+            Put ("ghdl_rtik_generic");
+         when Ghdl_Rtik_Process =>
+            Put ("ghdl_rtik_process");
+         when Ghdl_Rtik_Component =>
+            Put ("ghdl_rtik_component");
+         when Ghdl_Rtik_Attribute =>
+            Put ("ghdl_rtik_attribute");
+
+         when Ghdl_Rtik_Attribute_Quiet =>
+            Put ("ghdl_rtik_attribute_quiet");
+         when Ghdl_Rtik_Attribute_Stable =>
+            Put ("ghdl_rtik_attribute_stable");
+         when Ghdl_Rtik_Attribute_Transaction =>
+            Put ("ghdl_rtik_attribute_transaction");
+
+         when Ghdl_Rtik_Constant =>
+            Put ("ghdl_rtik_constant");
+         when Ghdl_Rtik_Iterator =>
+            Put ("ghdl_rtik_iterator");
+         when Ghdl_Rtik_Signal =>
+            Put ("ghdl_rtik_signal");
+         when Ghdl_Rtik_Variable =>
+            Put ("ghdl_rtik_variable");
+         when Ghdl_Rtik_Guard =>
+            Put ("ghdl_rtik_guard");
+         when Ghdl_Rtik_File =>
+            Put ("ghdl_rtik_file");
+
+         when Ghdl_Rtik_Instance =>
+            Put ("ghdl_rtik_instance");
+         when Ghdl_Rtik_Block =>
+            Put ("ghdl_rtik_block");
+         when Ghdl_Rtik_If_Generate =>
+            Put ("ghdl_rtik_if_generate");
+         when Ghdl_Rtik_For_Generate =>
+            Put ("ghdl_rtik_for_generate");
+
+         when Ghdl_Rtik_Type_B1 =>
+            Put ("ghdl_rtik_type_b1");
+         when Ghdl_Rtik_Type_E8 =>
+            Put ("ghdl_rtik_type_e8");
+         when Ghdl_Rtik_Type_E32 =>
+            Put ("ghdl_rtik_type_e32");
+         when Ghdl_Rtik_Type_P64 =>
+            Put ("ghdl_rtik_type_p64");
+         when Ghdl_Rtik_Type_I32 =>
+            Put ("ghdl_rtik_type_i32");
+
+         when Ghdl_Rtik_Type_Array =>
+            Put ("ghdl_rtik_type_array");
+         when Ghdl_Rtik_Subtype_Array =>
+            Put ("ghdl_rtik_subtype_array");
+         when Ghdl_Rtik_Type_Record =>
+            Put ("ghdl_rtik_type_record");
+
+         when Ghdl_Rtik_Type_Access =>
+            Put ("ghdl_rtik_type_access");
+         when Ghdl_Rtik_Type_File =>
+            Put ("ghdl_rtik_type_file");
+         when Ghdl_Rtik_Type_Protected =>
+            Put ("ghdl_rtik_type_protected");
+
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Put ("ghdl_rtik_subtype_scalar");
+
+         when Ghdl_Rtik_Element =>
+            Put ("ghdl_rtik_element");
+         when Ghdl_Rtik_Unit64 =>
+            Put ("ghdl_rtik_unit64");
+         when Ghdl_Rtik_Unitptr =>
+            Put ("ghdl_rtik_unitptr");
+
+         when others =>
+            Put ("ghdl_rtik_#");
+            Put_I32 (stdout, Ghdl_Rtik'Pos (Kind));
+      end case;
+   end Disp_Kind;
+
+   procedure Disp_Depth (Depth : Ghdl_Rti_Depth) is
+   begin
+      Put (", D=");
+      Put_I32 (stdout, Ghdl_I32 (Depth));
+   end Disp_Depth;
+
+   procedure Disp_Indent (Indent : Natural) is
+   begin
+      for I in 1 .. Indent loop
+         Put (' ');
+      end loop;
+   end Disp_Indent;
+
+   --  Disp a subtype_indication.
+   --  OBJ may be necessary when the subtype is an unconstrained array type,
+   --  whose bounds are stored with the object.
+   procedure Disp_Subtype_Indication
+     (Def : Ghdl_Rti_Access; Ctxt : Rti_Context; Obj : Address);
+
+   procedure Disp_Range
+     (Stream : FILEs; Kind : Ghdl_Rtik; Rng : Ghdl_Range_Ptr)
+   is
+   begin
+      case Kind is
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_P32 =>
+            Put_I32 (Stream, Rng.I32.Left);
+            Put_Dir (Stream, Rng.I32.Dir);
+            Put_I32 (Stream, Rng.I32.Right);
+         when Ghdl_Rtik_Type_F64 =>
+            Put_F64 (Stream, Rng.F64.Left);
+            Put_Dir (Stream, Rng.F64.Dir);
+            Put_F64 (Stream, Rng.F64.Right);
+         when Ghdl_Rtik_Type_P64 =>
+            Put_I64 (Stream, Rng.P64.Left);
+            Put_Dir (Stream, Rng.P64.Dir);
+            Put_I64 (Stream, Rng.P64.Right);
+         when others =>
+            Put ("?Scal");
+      end case;
+   end Disp_Range;
+
+   procedure Disp_Scalar_Type_Name (Def : Ghdl_Rti_Access) is
+   begin
+      case Def.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Rti : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Rti := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def);
+               if Rti.Name /= null then
+                  Disp_Name (Rti.Name);
+               else
+                  Disp_Scalar_Type_Name (Rti.Basetype);
+               end if;
+            end;
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name);
+         when others =>
+            Put ("#disp_scalar_type_name#");
+      end case;
+   end Disp_Scalar_Type_Name;
+
+   procedure Disp_Type_Array_Name (Def : Ghdl_Rtin_Type_Array_Acc;
+                                   Bounds_Ptr : Address)
+   is
+      Bounds : Address;
+
+      procedure Align (A : Ghdl_Index_Type) is
+      begin
+         Bounds := Align (Bounds, Ghdl_Rti_Loc (A));
+      end Align;
+
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Bounds := Bounds + (S / Storage_Unit);
+      end Update;
+
+      procedure Disp_Bounds (Def : Ghdl_Rti_Access)
+      is
+         Ndef : Ghdl_Rti_Access;
+      begin
+         if Bounds = Null_Address then
+            Put ("?");
+         else
+            if Def.Kind = Ghdl_Rtik_Subtype_Scalar then
+               Ndef := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def).Basetype;
+            else
+               Ndef := Def;
+            end if;
+            case Ndef.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Align (Ghdl_Range_I32'Alignment);
+                  Disp_Range (stdout, Ndef.Kind, To_Ghdl_Range_Ptr (Bounds));
+                  Update (Ghdl_Range_I32'Size);
+               when others =>
+                  Disp_Kind (Ndef.Kind);
+                  --  Bounds are not known anymore.
+                  Bounds := Null_Address;
+            end case;
+         end if;
+      end Disp_Bounds;
+   begin
+      Disp_Name (Def.Name);
+      if Bounds_Ptr = Null_Address then
+         return;
+      end if;
+      Put (" (");
+      Bounds := Bounds_Ptr;
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Scalar_Type_Name (Def.Indexes (I));
+         Put (" range ");
+         Disp_Bounds (Def.Indexes (I));
+      end loop;
+      Put (")");
+   end Disp_Type_Array_Name;
+
+   procedure Disp_Subtype_Scalar_Range
+     (Stream : FILEs; Def : Ghdl_Rtin_Subtype_Scalar_Acc; Ctxt : Rti_Context)
+   is
+      Range_Addr : Address;
+      Rng : Ghdl_Range_Ptr;
+   begin
+      Range_Addr := Loc_To_Addr (Def.Common.Depth,
+                                 Def.Range_Loc, Ctxt);
+      Rng := To_Ghdl_Range_Ptr (Range_Addr);
+      Disp_Range (Stream, Def.Basetype.Kind, Rng);
+   end Disp_Subtype_Scalar_Range;
+
+   procedure Disp_Subtype_Indication
+     (Def : Ghdl_Rti_Access; Ctxt : Rti_Context; Obj : Address)
+   is
+   begin
+      case Def.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Rti : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Rti := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def);
+               if Rti.Name /= null then
+                  Disp_Name (Rti.Name);
+               else
+                  Disp_Subtype_Indication
+                    (Rti.Basetype, Null_Context, Null_Address);
+                  Put (" range ");
+                  Disp_Subtype_Scalar_Range (stdout, Rti, Ctxt);
+               end if;
+            end;
+            --Disp_Scalar_Subtype_Name (To_Ghdl_Rtin_Scalsubtype_Acc (Def),
+            --                          Base);
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name);
+         when Ghdl_Rtik_Type_File
+           | Ghdl_Rtik_Type_Access =>
+            Disp_Name (To_Ghdl_Rtin_Type_Fileacc_Acc (Def).Name);
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Name (To_Ghdl_Rtin_Type_Record_Acc (Def).Name);
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Bounds : Address;
+            begin
+               if Obj = Null_Address then
+                  Bounds := Null_Address;
+               else
+                  Bounds := To_Ghdl_Uc_Array_Acc (Obj).Bounds;
+               end if;
+               Disp_Type_Array_Name (To_Ghdl_Rtin_Type_Array_Acc (Def),
+                                     Bounds);
+            end;
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               Sdef : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               Sdef := To_Ghdl_Rtin_Subtype_Array_Acc (Def);
+               if Sdef.Name /= null then
+                  Disp_Name (Sdef.Name);
+               else
+                  Disp_Type_Array_Name
+                    (Sdef.Basetype,
+                     Loc_To_Addr (Sdef.Common.Depth, Sdef.Bounds, Ctxt));
+               end if;
+            end;
+         when Ghdl_Rtik_Type_Protected =>
+            Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name);
+         when others =>
+            Disp_Kind (Def.Kind);
+            Put (' ');
+      end case;
+   end Disp_Subtype_Indication;
+
+
+   procedure Disp_Rti (Rti : Ghdl_Rti_Access;
+                       Ctxt : Rti_Context;
+                       Indent : Natural);
+
+   procedure Disp_Rti_Arr (Nbr : Ghdl_Index_Type;
+                           Arr : Ghdl_Rti_Arr_Acc;
+                           Ctxt : Rti_Context;
+                           Indent : Natural)
+   is
+   begin
+      for I in 1 .. Nbr loop
+         Disp_Rti (Arr (I - 1), Ctxt, Indent);
+      end loop;
+   end Disp_Rti_Arr;
+
+   procedure Disp_Block (Blk : Ghdl_Rtin_Block_Acc;
+                         Ctxt : Rti_Context;
+                         Indent : Natural)
+   is
+      Nctxt : Rti_Context;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Blk.Common.Kind);
+      Disp_Depth (Blk.Common.Depth);
+      Put (": ");
+      Disp_Name (Blk.Name);
+      New_Line;
+      if Blk.Parent /= null then
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               --  Disp entity.
+               Disp_Rti (Blk.Parent, Ctxt, Indent + 1);
+            when others =>
+               null;
+         end case;
+      end if;
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Package
+           | Ghdl_Rtik_Package_Body
+           | Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_Process =>
+            Nctxt := (Base => Ctxt.Base + Blk.Loc,
+                      Block => To_Ghdl_Rti_Access (Blk));
+            Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                          Nctxt, Indent + 1);
+         when Ghdl_Rtik_For_Generate =>
+            declare
+               Length : Ghdl_Index_Type;
+            begin
+               Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
+                         Block => To_Ghdl_Rti_Access (Blk));
+               Length := Get_For_Generate_Length (Blk, Ctxt);
+               for I in 1 .. Length loop
+                  Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                                Nctxt, Indent + 1);
+                  Nctxt.Base := Nctxt.Base + Blk.Size;
+               end loop;
+            end;
+         when Ghdl_Rtik_If_Generate =>
+            Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
+                      Block => To_Ghdl_Rti_Access (Blk));
+            if Nctxt.Base /= Null_Address then
+               Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                             Nctxt, Indent + 1);
+            end if;
+         when others =>
+            Internal_Error ("disp_block");
+      end case;
+   end Disp_Block;
+
+   procedure Disp_Object (Obj : Ghdl_Rtin_Object_Acc;
+                          Is_Sig : Boolean;
+                          Ctxt : Rti_Context;
+                          Indent : Natural)
+   is
+      Addr : Address;
+      Obj_Type : Ghdl_Rti_Access;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Obj.Common.Kind);
+      Disp_Depth (Obj.Common.Depth);
+      Put ("; ");
+      Disp_Name (Obj.Name);
+      Put (": ");
+      Addr := Loc_To_Addr (Obj.Common.Depth, Obj.Loc, Ctxt);
+      Obj_Type := Obj.Obj_Type;
+      Disp_Subtype_Indication (Obj_Type, Ctxt, Addr);
+      Put (" := ");
+
+      --  FIXME: put this into a function.
+      if (Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+          or Obj_Type.Kind = Ghdl_Rtik_Type_Record)
+        and then Rti_Complex_Type (Obj_Type)
+      then
+         Addr := To_Addr_Acc (Addr).all;
+      end if;
+      Disp_Value (stdout, Obj_Type, Ctxt, Addr, Is_Sig);
+      New_Line;
+   end Disp_Object;
+
+   procedure Disp_Attribute (Obj : Ghdl_Rtin_Object_Acc;
+                             Ctxt : Rti_Context;
+                             Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Obj.Common.Kind);
+      Disp_Depth (Obj.Common.Depth);
+      Put ("; ");
+      Disp_Name (Obj.Name);
+      Put (": ");
+      Disp_Subtype_Indication (Obj.Obj_Type, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Attribute;
+
+   procedure Disp_Component (Comp : Ghdl_Rtin_Component_Acc;
+                             Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Comp.Common.Kind);
+      Disp_Depth (Comp.Common.Depth);
+      Put (": ");
+      Disp_Name (Comp.Name);
+      New_Line;
+      --Disp_Rti_Arr (Comp.Nbr_Child, Comp.Children, Base, Ident + 1);
+   end Disp_Component;
+
+   procedure Disp_Instance (Inst : Ghdl_Rtin_Instance_Acc;
+                            Ctxt : Rti_Context;
+                            Indent : Natural)
+   is
+      Inst_Addr : Address;
+      Inst_Base : Address;
+      Inst_Rti : Ghdl_Rti_Access;
+      Nindent : Natural;
+      Nctxt : Rti_Context;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Inst.Common.Kind);
+      Put (": ");
+      Disp_Name (Inst.Name);
+      New_Line;
+
+      Inst_Addr := Ctxt.Base + Inst.Loc;
+      --  Read sub instance.
+      Inst_Base := To_Addr_Acc (Inst_Addr).all;
+
+      Nindent := Indent + 1;
+
+      case Inst.Instance.Kind is
+         when Ghdl_Rtik_Component =>
+            declare
+               Comp : Ghdl_Rtin_Component_Acc;
+            begin
+               Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
+               Disp_Indent (Nindent);
+               Disp_Kind (Comp.Common.Kind);
+               Put (": ");
+               Disp_Name (Comp.Name);
+               New_Line;
+               --  Disp components generics and ports.
+               --  FIXME: the data to disp are at COMP_BASE.
+               Nctxt := (Base => Inst_Addr,
+                         Block => Inst.Instance);
+               Nindent := Nindent + 1;
+               Disp_Rti_Arr (Comp.Nbr_Child, Comp.Children, Nctxt, Nindent);
+               Nindent := Nindent + 1;
+            end;
+         when Ghdl_Rtik_Entity =>
+            null;
+         when others =>
+            null;
+      end case;
+
+      --  Read instance RTI.
+      if Inst_Base /= Null_Address then
+         Inst_Rti := To_Ghdl_Rti_Acc_Acc (Inst_Base).all;
+         Nctxt := (Base => Inst_Base,
+                   Block => Inst_Rti);
+         Disp_Block (To_Ghdl_Rtin_Block_Acc (Inst_Rti),
+                     Nctxt, Nindent);
+      end if;
+   end Disp_Instance;
+
+   procedure Disp_Type_Enum_Decl (Enum : Ghdl_Rtin_Type_Enum_Acc;
+                                  Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Enum.Common.Kind);
+      Put (": ");
+      Disp_Name (Enum.Name);
+      Put (" is (");
+      Disp_Name (Enum.Names (0));
+      for I in 1 .. Enum.Nbr - 1 loop
+         Put (", ");
+         Disp_Name (Enum.Names (I));
+      end loop;
+      Put (")");
+      New_Line;
+   end Disp_Type_Enum_Decl;
+
+   procedure Disp_Subtype_Scalar_Decl (Def : Ghdl_Rtin_Subtype_Scalar_Acc;
+                                       Ctxt : Rti_Context;
+                                       Indent : Natural)
+   is
+      Bt : Ghdl_Rti_Access;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Disp_Depth (Def.Common.Depth);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      Bt := Def.Basetype;
+      case Bt.Kind is
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_F64 =>
+            declare
+               Bdef : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Bdef := To_Ghdl_Rtin_Type_Scalar_Acc (Bt);
+               if Bdef.Name /= Def.Name then
+                  Disp_Name (Bdef.Name);
+                  Put (" range ");
+               end if;
+               --  This is the type definition.
+               Disp_Subtype_Scalar_Range (stdout, Def, Ctxt);
+            end;
+         when Ghdl_Rtik_Type_P64
+           | Ghdl_Rtik_Type_P32 =>
+            declare
+               Bdef : Ghdl_Rtin_Type_Physical_Acc;
+               Unit : Ghdl_Rti_Access;
+            begin
+               Bdef := To_Ghdl_Rtin_Type_Physical_Acc (Bt);
+               if Bdef.Name /= Def.Name then
+                  Disp_Name (Bdef.Name);
+                  Put (" range ");
+               end if;
+               --  This is the type definition.
+               Disp_Subtype_Scalar_Range (stdout, Def, Ctxt);
+               if Bdef.Name = Def.Name then
+                  for I in 0 .. Bdef.Nbr - 1 loop
+                     Unit := Bdef.Units (I);
+                     New_Line;
+                     Disp_Indent (Indent + 1);
+                     Disp_Kind (Unit.Kind);
+                     Put (": ");
+                     Disp_Name (Get_Physical_Unit_Name (Unit));
+                     Put (" = ");
+                     case Unit.Kind is
+                        when Ghdl_Rtik_Unit64 =>
+                           Put_I64 (stdout,
+                                    To_Ghdl_Rtin_Unit64_Acc (Unit).Value);
+                        when Ghdl_Rtik_Unitptr =>
+                           case Bt.Kind is
+                              when Ghdl_Rtik_Type_P64 =>
+                                 Put_I64
+                                   (stdout,
+                                    To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I64);
+                              when Ghdl_Rtik_Type_P32 =>
+                                 Put_I32
+                                   (stdout,
+                                    To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I32);
+                              when others =>
+                                 Internal_Error
+                                   ("disp_rti.subtype.scalar_decl(P32/P64)");
+                           end case;
+                        when others =>
+                           Internal_Error
+                             ("disp_rti.subtype.scalar_decl(P32/P64)");
+                     end case;
+                  end loop;
+               end if;
+            end;
+         when others =>
+            Disp_Subtype_Indication
+              (To_Ghdl_Rti_Access (Def), Ctxt, Null_Address);
+      end case;
+      New_Line;
+   end Disp_Subtype_Scalar_Decl;
+
+   procedure Disp_Type_Array_Decl (Def : Ghdl_Rtin_Type_Array_Acc;
+                                   Ctxt : Rti_Context;
+                                   Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is array (");
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Subtype_Indication (Def.Indexes (I), Ctxt, Null_Address);
+         Put (" range <>");
+      end loop;
+      Put (") of ");
+      Disp_Subtype_Indication (Def.Element, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Type_Array_Decl;
+
+   procedure Disp_Subtype_Array_Decl (Def : Ghdl_Rtin_Subtype_Array_Acc;
+                                      Ctxt : Rti_Context;
+                                      Indent : Natural)
+   is
+      Basetype : constant Ghdl_Rtin_Type_Array_Acc := Def.Basetype;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      Disp_Type_Array_Name
+        (Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt));
+      if Rti_Anonymous_Type (To_Ghdl_Rti_Access (Basetype)) then
+         Put (" of ");
+         Disp_Subtype_Indication (Basetype.Element, Ctxt, Null_Address);
+      end if;
+      New_Line;
+   end Disp_Subtype_Array_Decl;
+
+   procedure Disp_Type_File_Or_Access (Def : Ghdl_Rtin_Type_Fileacc_Acc;
+                                       Ctxt : Rti_Context;
+                                       Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      case Def.Common.Kind is
+         when Ghdl_Rtik_Type_Access =>
+            Put ("access ");
+         when Ghdl_Rtik_Type_File =>
+            Put ("file ");
+         when others =>
+            Put ("?? ");
+      end case;
+      Disp_Subtype_Indication (Def.Base, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Type_File_Or_Access;
+
+   procedure Disp_Type_Record (Def : Ghdl_Rtin_Type_Record_Acc;
+                               Ctxt : Rti_Context;
+                               Indent : Natural)
+   is
+      El : Ghdl_Rtin_Element_Acc;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is record");
+      New_Line;
+      for I in 1 .. Def.Nbrel loop
+         El := To_Ghdl_Rtin_Element_Acc (Def.Elements (I - 1));
+         Disp_Indent (Indent + 1);
+         Disp_Kind (El.Common.Kind);
+         Put (": ");
+         Disp_Name (El.Name);
+         Put (": ");
+         Disp_Subtype_Indication (El.Eltype, Ctxt, Null_Address);
+         New_Line;
+      end loop;
+   end Disp_Type_Record;
+
+   procedure Disp_Type_Protected (Def : Ghdl_Rtin_Type_Scalar_Acc;
+                                  Ctxt : Rti_Context;
+                                  Indent : Natural)
+   is
+      pragma Unreferenced (Ctxt);
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is protected");
+      New_Line;
+   end Disp_Type_Protected;
+
+   procedure Disp_Rti (Rti : Ghdl_Rti_Access;
+                       Ctxt : Rti_Context;
+                       Indent : Natural)
+   is
+   begin
+      if Rti = null then
+         return;
+      end if;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Package
+           | Ghdl_Rtik_Process
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_If_Generate
+           | Ghdl_Rtik_For_Generate =>
+            Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Package_Body =>
+            Disp_Rti (To_Ghdl_Rtin_Block_Acc (Rti).Parent, Ctxt, Indent);
+            Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Port
+           | Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Attribute_Quiet
+           | Ghdl_Rtik_Attribute_Stable
+           | Ghdl_Rtik_Attribute_Transaction =>
+            Disp_Object (To_Ghdl_Rtin_Object_Acc (Rti), True, Ctxt, Indent);
+         when Ghdl_Rtik_Generic
+           | Ghdl_Rtik_Constant
+           | Ghdl_Rtik_Variable
+           | Ghdl_Rtik_Iterator
+           | Ghdl_Rtik_File =>
+            Disp_Object (To_Ghdl_Rtin_Object_Acc (Rti), False, Ctxt, Indent);
+         when Ghdl_Rtik_Component =>
+            Disp_Component (To_Ghdl_Rtin_Component_Acc (Rti), Indent);
+         when Ghdl_Rtik_Attribute =>
+            Disp_Attribute (To_Ghdl_Rtin_Object_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Instance =>
+            Disp_Instance (To_Ghdl_Rtin_Instance_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Type_Enum_Decl (To_Ghdl_Rtin_Type_Enum_Acc (Rti), Indent);
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Disp_Subtype_Scalar_Decl (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti),
+                                      Ctxt, Indent);
+         when Ghdl_Rtik_Type_Array =>
+            Disp_Type_Array_Decl
+              (To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Subtype_Array =>
+            Disp_Subtype_Array_Decl
+              (To_Ghdl_Rtin_Subtype_Array_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_Access
+           | Ghdl_Rtik_Type_File =>
+            Disp_Type_File_Or_Access
+              (To_Ghdl_Rtin_Type_Fileacc_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Type_Record
+              (To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_Protected =>
+            Disp_Type_Protected
+              (To_Ghdl_Rtin_Type_Scalar_Acc (Rti), Ctxt, Indent);
+         when others =>
+            Disp_Indent (Indent);
+            Disp_Kind (Rti.Kind);
+            Put_Line (" ? ");
+      end case;
+   end Disp_Rti;
+
+   Disp_Rti_Flag : Boolean := False;
+
+   procedure Disp_All
+   is
+      Ctxt : Rti_Context;
+   begin
+      if not Disp_Rti_Flag then
+         return;
+      end if;
+
+      Put ("DISP_RTI.Disp_All: ");
+      Disp_Kind (Ghdl_Rti_Top.Common.Kind);
+      New_Line;
+      Ctxt := (Base => Ghdl_Rti_Top_Instance,
+               Block => Ghdl_Rti_Top.Parent);
+      Disp_Rti_Arr (Ghdl_Rti_Top.Nbr_Child,
+                    Ghdl_Rti_Top.Children,
+                    Ctxt, 0);
+      Disp_Rti (Ghdl_Rti_Top.Parent, Ctxt, 0);
+
+      --Disp_Hierarchy;
+   end Disp_All;
+
+   function Disp_Rti_Option (Opt : String) return Boolean
+   is
+   begin
+      if Opt = "--dump-rti" then
+         Disp_Rti_Flag := True;
+         return True;
+      else
+         return False;
+      end if;
+   end Disp_Rti_Option;
+
+   procedure Disp_Rti_Help
+   is
+      procedure P (Str : String) renames Put_Line;
+   begin
+      P (" --dump-rti        dump Run Time Information");
+   end Disp_Rti_Help;
+
+   Disp_Rti_Hooks : aliased constant Hooks_Type :=
+     (Option => Disp_Rti_Option'Access,
+      Help => Disp_Rti_Help'Access,
+      Init => null,
+      Start => Disp_All'Access,
+      Finish => null);
+
+   procedure Register is
+   begin
+      Register_Hooks (Disp_Rti_Hooks'Access);
+   end Register;
+
+end Grt.Disp_Rti;
diff --git a/src/translate/grt/grt-disp_rti.ads b/src/translate/grt/grt-disp_rti.ads
new file mode 100644
index 000000000..6033d2011
--- /dev/null
+++ b/src/translate/grt/grt-disp_rti.ads
@@ -0,0 +1,43 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+
+package Grt.Disp_Rti is
+   --  Disp NAME.  If NAME is null, then disp <anonymous>.
+   procedure Disp_Name (Name : Ghdl_C_String);
+
+   --  Disp a value.
+   procedure Disp_Value (Stream : FILEs;
+                         Rti : Ghdl_Rti_Access;
+                         Ctxt : Rti_Context;
+                         Obj : in out Address;
+                         Is_Sig : Boolean);
+
+   procedure Register;
+end Grt.Disp_Rti;
diff --git a/src/translate/grt/grt-disp_signals.adb b/src/translate/grt/grt-disp_signals.adb
new file mode 100644
index 000000000..424d20dcf
--- /dev/null
+++ b/src/translate/grt/grt-disp_signals.adb
@@ -0,0 +1,524 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Ada.Unchecked_Conversion;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Errors; use Grt.Errors;
+pragma Elaborate_All (Grt.Rtis_Utils);
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Options;
+with Grt.Processes;
+with Grt.Disp; use Grt.Disp;
+
+package body Grt.Disp_Signals is
+   procedure Foreach_Scalar_Signal
+     (Process : access procedure (Val_Addr : Address;
+                                  Val_Name : Vstring;
+                                  Val_Type : Ghdl_Rti_Access;
+                                  Param : Rti_Object))
+   is
+      procedure Call_Process (Val_Addr : Address;
+                              Val_Name : Vstring;
+                              Val_Type : Ghdl_Rti_Access;
+                              Param : Rti_Object) is
+      begin
+         Process.all (Val_Addr, Val_Name, Val_Type, Param);
+      end Call_Process;
+
+      pragma Inline (Call_Process);
+
+      procedure Foreach_Scalar_Signal_Signal is new
+        Foreach_Scalar (Param_Type => Rti_Object,
+                        Process => Call_Process);
+
+      function Foreach_Scalar_Signal_Object
+        (Ctxt : Rti_Context; Obj : Ghdl_Rti_Access)
+        return Traverse_Result
+      is
+         Sig : Ghdl_Rtin_Object_Acc;
+      begin
+         case Obj.Kind is
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard
+              | Ghdl_Rtik_Attribute_Quiet
+              | Ghdl_Rtik_Attribute_Stable
+              | Ghdl_Rtik_Attribute_Transaction =>
+               Sig := To_Ghdl_Rtin_Object_Acc (Obj);
+               Foreach_Scalar_Signal_Signal
+                 (Ctxt, Sig.Obj_Type,
+                  Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True,
+                  Rti_Object'(Obj, Ctxt));
+            when others =>
+               null;
+         end case;
+         return Traverse_Ok;
+      end Foreach_Scalar_Signal_Object;
+
+      function Foreach_Scalar_Signal_Traverse is
+         new Traverse_Blocks (Process => Foreach_Scalar_Signal_Object);
+
+      Res : Traverse_Result;
+      pragma Unreferenced (Res);
+   begin
+      Res := Foreach_Scalar_Signal_Traverse (Get_Top_Context);
+   end Foreach_Scalar_Signal;
+
+   procedure Disp_Context (Ctxt : Rti_Context)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Nctxt : Rti_Context;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Block
+           | Ghdl_Rtik_Process =>
+            Nctxt := Get_Parent_Context (Ctxt);
+            Disp_Context (Nctxt);
+            Put ('.');
+            Put (Blk.Name);
+         when Ghdl_Rtik_Entity =>
+            Put (Blk.Name);
+         when Ghdl_Rtik_Architecture =>
+            Nctxt := Get_Parent_Context (Ctxt);
+            Disp_Context (Nctxt);
+            Put ('(');
+            Put (Blk.Name);
+            Put (')');
+         when others =>
+            Internal_Error ("disp_context");
+      end case;
+   end Disp_Context;
+
+   --  This is a debugging procedure.
+   pragma Unreferenced (Disp_Context);
+
+   --  Option --trace-signals.
+
+   --  Disp transaction TRANS from signal SIG.
+   procedure Disp_Transaction (Trans : Transaction_Acc;
+                               Sig_Type : Ghdl_Rti_Access;
+                               Mode : Mode_Type)
+   is
+      T : Transaction_Acc;
+   begin
+      T := Trans;
+      loop
+         case T.Kind is
+            when Trans_Value =>
+               if Sig_Type /= null then
+                  Disp_Value (stdout, T.Val, Sig_Type);
+               else
+                  Disp_Value (T.Val, Mode);
+               end if;
+            when Trans_Direct =>
+               if Sig_Type /= null then
+                  Disp_Value (stdout, T.Val_Ptr.all, Sig_Type);
+               else
+                  Disp_Value (T.Val_Ptr.all, Mode);
+               end if;
+            when Trans_Null =>
+               Put ("NULL");
+            when Trans_Error =>
+               Put ("ERROR");
+         end case;
+         if T.Kind = Trans_Direct then
+            --  The Time field is not updated for direct transaction.
+            Put ("[DIRECT]");
+         else
+            Put ("@");
+            Put_Time (stdout, T.Time);
+         end if;
+         T := T.Next;
+         exit when T = null;
+         Put (", ");
+      end loop;
+   end Disp_Transaction;
+
+   procedure Disp_Simple_Signal
+     (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean)
+   is
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Resolved_Signal_Acc, Target => Address);
+   begin
+      Put (' ');
+      Put (stdout, Sig.all'Address);
+      Put (' ');
+      Disp_Mode (Sig.Mode);
+      Put (' ');
+      if Sig.Active then
+         Put ('A');
+      else
+         Put ('-');
+      end if;
+      if Sig.Event then
+         Put ('E');
+      else
+         Put ('-');
+      end if;
+      if Sig.Has_Active then
+         Put ('a');
+      else
+         Put ('-');
+      end if;
+      if Sig.S.Effective /= null then
+         Put ('e');
+      else
+         Put ('-');
+      end if;
+      if Boolean'(True) then
+         Put (" last_event=");
+         Put_Time (stdout, Sig.Last_Event);
+         Put (" last_active=");
+         Put_Time (stdout, Sig.Last_Active);
+      end if;
+      Put (" val=");
+      if Sig_Type /= null then
+         Disp_Value (stdout, Sig.Value, Sig_Type);
+      else
+         Disp_Value (Sig.Value, Sig.Mode);
+      end if;
+      Put ("; drv=");
+      if Sig_Type /= null then
+         Disp_Value (stdout, Sig.Driving_Value, Sig_Type);
+      else
+         Disp_Value (Sig.Driving_Value, Sig.Mode);
+      end if;
+      if Sources then
+         if Sig.Nbr_Ports > 0 then
+            Put (';');
+            Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports));
+            Put (" ports");
+         end if;
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            if Sig.S.Resolv /= null then
+               Put (stdout, " res func ");
+               Put (stdout, To_Address(Sig.S.Resolv));
+            end if;
+            if Sig.S.Nbr_Drivers = 0 then
+               Put ("; no driver");
+            elsif Sig.S.Nbr_Drivers = 1 then
+               Put ("; trans=");
+               Disp_Transaction
+                 (Sig.S.Drivers (0).First_Trans, Sig_Type, Sig.Mode);
+            else
+               for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+                  New_Line;
+                  Put ("   ");
+                  Disp_Transaction
+                    (Sig.S.Drivers (I).First_Trans, Sig_Type, Sig.Mode);
+               end loop;
+            end if;
+         end if;
+      end if;
+      New_Line;
+   end Disp_Simple_Signal;
+
+   procedure Disp_Signal_Name (Stream : FILEs;
+                               Ctxt : Rti_Context;
+                               Sig : Ghdl_Rtin_Object_Acc) is
+   begin
+      case Sig.Common.Kind is
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard =>
+            Put (stdout, Ctxt);
+            Put (".");
+            Put (Stream, Sig.Name);
+         when Ghdl_Rtik_Attribute_Quiet =>
+            Put (stdout, Ctxt);
+            Put (".");
+            Put (Stream, " 'quiet");
+         when Ghdl_Rtik_Attribute_Stable =>
+            Put (stdout, Ctxt);
+            Put (".");
+            Put (Stream, " 'stable");
+         when Ghdl_Rtik_Attribute_Transaction =>
+            Put (stdout, Ctxt);
+            Put (".");
+            Put (Stream, " 'transaction");
+         when others =>
+            null;
+      end case;
+   end Disp_Signal_Name;
+
+   procedure Disp_Scalar_Signal (Val_Addr : Address;
+                                 Val_Name : Vstring;
+                                 Val_Type : Ghdl_Rti_Access;
+                                 Parent : Rti_Object)
+   is
+   begin
+      Disp_Signal_Name (stdout, Parent.Ctxt,
+                        To_Ghdl_Rtin_Object_Acc (Parent.Obj));
+      Put (stdout, Val_Name);
+      Disp_Simple_Signal (To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all),
+                          Val_Type, Options.Disp_Sources);
+   end Disp_Scalar_Signal;
+
+
+   procedure Disp_All_Signals is
+   begin
+      Foreach_Scalar_Signal (Disp_Scalar_Signal'access);
+   end Disp_All_Signals;
+
+   --  Option disp-sensitivity
+
+   procedure Disp_Scalar_Sensitivity (Val_Addr : Address;
+                                      Val_Name : Vstring;
+                                      Val_Type : Ghdl_Rti_Access;
+                                      Parent : Rti_Object)
+   is
+      pragma Unreferenced (Val_Type);
+      Sig : Ghdl_Signal_Ptr;
+
+      Action : Action_List_Acc;
+   begin
+      Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+      if Sig.Flags.Seen then
+         return;
+      else
+         Sig.Flags.Seen := True;
+      end if;
+      Disp_Signal_Name (stdout, Parent.Ctxt,
+                        To_Ghdl_Rtin_Object_Acc (Parent.Obj));
+      Put (stdout, Val_Name);
+      New_Line (stdout);
+
+      Action := Sig.Event_List;
+      while Action /= null loop
+         Put (stdout, "  wakeup ");
+         Grt.Processes.Disp_Process_Name (stdout, Action.Proc);
+         New_Line (stdout);
+         Action := Action.Next;
+      end loop;
+
+      if Sig.S.Mode_Sig in Mode_Signal_User then
+         for I in 1 .. Sig.S.Nbr_Drivers loop
+            Put (stdout, "  driven ");
+            Grt.Processes.Disp_Process_Name
+              (stdout, Sig.S.Drivers (I - 1).Proc);
+            New_Line (stdout);
+         end loop;
+      end if;
+   end Disp_Scalar_Sensitivity;
+
+   procedure Disp_All_Sensitivity is
+   begin
+      Foreach_Scalar_Signal (Disp_Scalar_Sensitivity'access);
+   end Disp_All_Sensitivity;
+
+
+   --  Option disp-signals-map
+
+   procedure Disp_Signals_Map_Scalar (Val_Addr : Address;
+                                      Val_Name : Vstring;
+                                      Val_Type : Ghdl_Rti_Access;
+                                      Parent : Rti_Object)
+   is
+      pragma Unreferenced (Val_Type);
+
+      function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Ghdl_Signal_Ptr);
+
+      S : Ghdl_Signal_Ptr;
+   begin
+      Disp_Signal_Name (stdout,
+                        Parent.Ctxt, To_Ghdl_Rtin_Object_Acc (Parent.Obj));
+      Put (stdout, Val_Name);
+      Put (": ");
+      S := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+      Put (stdout, S.all'Address);
+      Put (" net: ");
+      Put_I32 (stdout, Ghdl_I32 (S.Net));
+      if S.Has_Active then
+         Put (" +A");
+      end if;
+      New_Line;
+   end Disp_Signals_Map_Scalar;
+
+   procedure Disp_Signals_Map is
+   begin
+      Foreach_Scalar_Signal (Disp_Signals_Map_Scalar'access);
+   end Disp_Signals_Map;
+
+   --  Option --disp-signals-table
+   procedure Disp_Mode_Signal (Mode : Mode_Signal_Type)
+   is
+   begin
+      case Mode is
+         when Mode_Signal =>
+            Put ("signal");
+         when Mode_Linkage =>
+            Put ("linkage");
+         when Mode_Buffer =>
+            Put ("buffer");
+         when Mode_Out =>
+            Put ("out");
+         when Mode_Inout =>
+            Put ("inout");
+         when Mode_In =>
+            Put ("in");
+         when Mode_Stable =>
+            Put ("stable");
+         when Mode_Quiet =>
+            Put ("quiet");
+         when Mode_Transaction =>
+            Put ("transaction");
+         when Mode_Delayed =>
+            Put ("delayed");
+         when Mode_Guard =>
+            Put ("guard");
+         when Mode_Conv_In =>
+            Put ("conv_in");
+         when Mode_Conv_Out =>
+            Put ("conv_out");
+         when Mode_End =>
+            Put ("end");
+      end case;
+   end Disp_Mode_Signal;
+
+   procedure Disp_Signals_Table
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+         Put_Sig_Index (I);
+         Put (": ");
+         Put (stdout, Sig.all'Address);
+         if Sig.Has_Active then
+            Put (" +A");
+         end if;
+         Put (" net: ");
+         Put_I32 (stdout,  Ghdl_I32 (Sig.Net));
+         Put (" smode: ");
+         Disp_Mode_Signal (Sig.S.Mode_Sig);
+         Put (" #prt: ");
+         Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports));
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            Put (" #drv: ");
+            Put_I32 (stdout, Ghdl_I32 (Sig.S.Nbr_Drivers));
+            if Sig.S.Effective /= null then
+               Put (" eff: ");
+               Put (stdout, Sig.S.Effective.all'Address);
+            end if;
+            if Sig.S.Resolv /= null then
+               Put (" resolved");
+            end if;
+         end if;
+         if Boolean'(False) then
+            Put (" link: ");
+            Put (stdout, Sig.Link.all'Address);
+         end if;
+         New_Line;
+         if Sig.Nbr_Ports /= 0 then
+            for J in 1 .. Sig.Nbr_Ports loop
+               Put ("  ");
+               Put (stdout, Sig.Ports (J - 1).all'Address);
+            end loop;
+            New_Line;
+         end if;
+      end loop;
+      Grt.Stdio.fflush (stdout);
+   end Disp_Signals_Table;
+
+   procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Disp_Simple_Signal (Sig, null, True);
+   end Disp_A_Signal;
+
+   procedure Put_Signal_Name (Stream : FILEs; Sig : Ghdl_Signal_Ptr)
+   is
+      Found : Boolean := False;
+      Cur_Ctxt : Rti_Context;
+      Cur_Sig : Ghdl_Rtin_Object_Acc;
+
+      procedure Process_Scalar  (Val_Addr : Address;
+                                 Val_Name : Vstring;
+                                 Val_Type : Ghdl_Rti_Access;
+                                 Param : Boolean)
+      is
+         pragma Unreferenced (Val_Type);
+         pragma Unreferenced (Param);
+         Sig1 : Ghdl_Signal_Ptr;
+      begin
+         --  Read the signal.
+         Sig1 := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+         if Sig1 = Sig and not Found then
+            Disp_Signal_Name (Stream, Cur_Ctxt, Cur_Sig);
+            Put (Stream, Val_Name);
+            Found := True;
+         end if;
+      end Process_Scalar;
+
+      procedure Foreach_Scalar is new Grt.Rtis_Utils.Foreach_Scalar
+        (Param_Type => Boolean, Process => Process_Scalar);
+
+      function Process_Block (Ctxt : Rti_Context;
+                              Obj : Ghdl_Rti_Access)
+                             return Traverse_Result
+      is
+      begin
+         case Obj.Kind is
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard
+              | Ghdl_Rtik_Attribute_Stable
+              | Ghdl_Rtik_Attribute_Quiet
+              | Ghdl_Rtik_Attribute_Transaction =>
+               Cur_Ctxt := Ctxt;
+               Cur_Sig := To_Ghdl_Rtin_Object_Acc (Obj);
+               Foreach_Scalar
+                 (Ctxt, Cur_Sig.Obj_Type,
+                  Loc_To_Addr (Cur_Sig.Common.Depth, Cur_Sig.Loc, Ctxt),
+                  True, True);
+               if Found then
+                  return Traverse_Stop;
+               end if;
+            when others =>
+               null;
+         end case;
+         return Traverse_Ok;
+      end Process_Block;
+
+      function Foreach_Block is new Grt.Rtis_Utils.Traverse_Blocks
+        (Process_Block);
+
+      Res_Status : Traverse_Result;
+      pragma Unreferenced (Res_Status);
+   begin
+      Res_Status := Foreach_Block (Get_Top_Context);
+      if not Found then
+         Put (Stream, "(unknown signal)");
+      end if;
+   end Put_Signal_Name;
+
+end Grt.Disp_Signals;
diff --git a/src/translate/grt/grt-disp_signals.ads b/src/translate/grt/grt-disp_signals.ads
new file mode 100644
index 000000000..73bd60d06
--- /dev/null
+++ b/src/translate/grt/grt-disp_signals.ads
@@ -0,0 +1,48 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Disp_Signals is
+   procedure Disp_All_Signals;
+
+   procedure Disp_Signals_Map;
+
+   procedure Disp_Signals_Table;
+
+   procedure Disp_All_Sensitivity;
+
+   procedure Disp_Mode_Signal (Mode : Mode_Signal_Type);
+
+   --  Disp informations on signal SIG.
+   --  To be used inside the debugger.
+   procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr);
+
+   --  Put the full name of signal SIG.
+   --  This operation is really expensive, since the whole hierarchy is
+   --  traversed.
+   procedure Put_Signal_Name (Stream : FILEs; Sig : Ghdl_Signal_Ptr);
+end Grt.Disp_Signals;
diff --git a/src/translate/grt/grt-disp_tree.adb b/src/translate/grt/grt-disp_tree.adb
new file mode 100644
index 000000000..7d5811960
--- /dev/null
+++ b/src/translate/grt/grt-disp_tree.adb
@@ -0,0 +1,461 @@
+--  GHDL Run Time (GRT) - Tree displayer.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Disp_Rti; use Grt.Disp_Rti;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Types; use Grt.Types;
+with Grt.Errors; use Grt.Errors;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Hooks; use Grt.Hooks;
+
+package body Grt.Disp_Tree is
+   --  Set by --disp-tree, to display the design hierarchy.
+   type Disp_Tree_Kind is
+     (
+      Disp_Tree_None,  --  Do not disp tree.
+      Disp_Tree_Inst,  --  Disp entities, arch, package, blocks, components.
+      Disp_Tree_Proc,  --  As above plus processes
+      Disp_Tree_Port   --  As above plus ports and signals.
+     );
+   Disp_Tree_Flag : Disp_Tree_Kind := Disp_Tree_None;
+
+
+   --  Get next interesting child.
+   procedure Get_Tree_Child (Parent : Ghdl_Rtin_Block_Acc;
+                             Index : in out Ghdl_Index_Type;
+                             Child : out Ghdl_Rti_Access)
+   is
+   begin
+      --  Exit if no more children.
+      while Index < Parent.Nbr_Child loop
+         Child := Parent.Children (Index);
+         Index := Index + 1;
+         case Child.Kind is
+            when Ghdl_Rtik_Package
+              | Ghdl_Rtik_Entity
+              | Ghdl_Rtik_Architecture
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_For_Generate
+              | Ghdl_Rtik_If_Generate
+              | Ghdl_Rtik_Instance =>
+               return;
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard =>
+               if Disp_Tree_Flag >= Disp_Tree_Port then
+                  return;
+               end if;
+            when Ghdl_Rtik_Process =>
+               if Disp_Tree_Flag >= Disp_Tree_Proc then
+                  return;
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+      Child := null;
+   end Get_Tree_Child;
+
+   procedure Disp_Tree_Child (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Process
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_If_Generate =>
+            declare
+               Blk : constant Ghdl_Rtin_Block_Acc :=
+                 To_Ghdl_Rtin_Block_Acc (Rti);
+            begin
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_Package_Body
+           | Ghdl_Rtik_Package =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+               Lib : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Rti);
+               if Rti.Kind = Ghdl_Rtik_Package_Body then
+                  Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+               end if;
+               Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
+               Disp_Name (Lib.Name);
+               Put ('.');
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_For_Generate =>
+            declare
+               Blk : constant Ghdl_Rtin_Block_Acc :=
+                 To_Ghdl_Rtin_Block_Acc (Rti);
+               Iter : Ghdl_Rtin_Object_Acc;
+               Addr : Address;
+            begin
+               Disp_Name (Blk.Name);
+               Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+               Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+               Put ('(');
+               Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
+               Put (')');
+            end;
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Iterator =>
+            Disp_Name (To_Ghdl_Rtin_Object_Acc (Rti).Name);
+         when Ghdl_Rtik_Instance =>
+            Disp_Name (To_Ghdl_Rtin_Instance_Acc (Rti).Name);
+         when others =>
+            null;
+      end case;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Package
+           | Ghdl_Rtik_Package_Body =>
+            Put (" [package]");
+         when Ghdl_Rtik_Entity =>
+            Put (" [entity]");
+         when Ghdl_Rtik_Architecture =>
+            Put (" [arch]");
+         when Ghdl_Rtik_Process =>
+            Put (" [process]");
+         when Ghdl_Rtik_Block =>
+            Put (" [block]");
+         when Ghdl_Rtik_For_Generate =>
+            Put (" [for-generate]");
+         when Ghdl_Rtik_If_Generate =>
+            Put (" [if-generate ");
+            if Ctxt.Base = Null_Address then
+               Put ("false]");
+            else
+               Put ("true]");
+            end if;
+         when Ghdl_Rtik_Signal =>
+            Put (" [signal]");
+         when Ghdl_Rtik_Port =>
+            Put (" [port ");
+            case Rti.Mode and Ghdl_Rti_Signal_Mode_Mask is
+               when Ghdl_Rti_Signal_Mode_In =>
+                  Put ("in");
+               when Ghdl_Rti_Signal_Mode_Out =>
+                  Put ("out");
+               when Ghdl_Rti_Signal_Mode_Inout =>
+                  Put ("inout");
+               when Ghdl_Rti_Signal_Mode_Buffer =>
+                  Put ("buffer");
+               when Ghdl_Rti_Signal_Mode_Linkage =>
+                  Put ("linkage");
+               when others =>
+                  Put ("?");
+            end case;
+            Put ("]");
+         when Ghdl_Rtik_Guard =>
+            Put (" [guard]");
+         when Ghdl_Rtik_Iterator =>
+            Put (" [iterator]");
+         when Ghdl_Rtik_Instance =>
+            Put (" [instance]");
+         when others =>
+            null;
+      end case;
+   end Disp_Tree_Child;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String);
+
+   procedure Disp_Tree_Block1
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+      Child : Ghdl_Rti_Access;
+      Child2 : Ghdl_Rti_Access;
+      Index : Ghdl_Index_Type;
+
+      procedure Disp_Header (Nctxt : Rti_Context;
+                             Force_Cont : Boolean := False)
+      is
+      begin
+         Put (Pfx);
+
+         if Blk.Common.Kind /= Ghdl_Rtik_Entity
+           and Child2 = null
+           and Force_Cont = False
+         then
+            Put ("`-");
+         else
+            Put ("+-");
+         end if;
+
+         Disp_Tree_Child (Child, Nctxt);
+         New_Line;
+      end Disp_Header;
+
+      procedure Disp_Sub_Block
+        (Sub_Blk : Ghdl_Rtin_Block_Acc; Nctxt : Rti_Context)
+      is
+         Npfx : String (1 .. Pfx'Length + 2);
+      begin
+         Npfx (1 .. Pfx'Length) := Pfx;
+         Npfx (Pfx'Length + 2) := ' ';
+         if Child2 = null then
+            Npfx (Pfx'Length + 1) := ' ';
+         else
+            Npfx (Pfx'Length + 1) := '|';
+         end if;
+         Disp_Tree_Block (Sub_Blk, Nctxt, Npfx);
+      end Disp_Sub_Block;
+
+   begin
+      Index := 0;
+      Get_Tree_Child (Blk, Index, Child);
+      while Child /= null loop
+         Get_Tree_Child (Blk, Index, Child2);
+
+         case Child.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block =>
+               declare
+                  Nblk : constant Ghdl_Rtin_Block_Acc :=
+                    To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => Ctxt.Base + Nblk.Loc,
+                            Block => Child);
+                  Disp_Header (Nctxt, False);
+                  Disp_Sub_Block (Nblk, Nctxt);
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Nblk : constant Ghdl_Rtin_Block_Acc :=
+                    To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+                  Length : Ghdl_Index_Type;
+                  Old_Child2 : Ghdl_Rti_Access;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
+                            Block => Child);
+                  Length := Get_For_Generate_Length (Nblk, Ctxt);
+                  Disp_Header (Nctxt, Length > 1);
+                  Old_Child2 := Child2;
+                  if Length > 1 then
+                     Child2 := Child;
+                  end if;
+                  for I in 1 .. Length loop
+                     Disp_Sub_Block (Nblk, Nctxt);
+                     if I /= Length then
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                        if I = Length - 1 then
+                           Child2 := Old_Child2;
+                        end if;
+                        Disp_Header (Nctxt);
+                     end if;
+                  end loop;
+                  Child2 := Old_Child2;
+               end;
+            when Ghdl_Rtik_If_Generate =>
+               declare
+                  Nblk : constant Ghdl_Rtin_Block_Acc :=
+                    To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
+                            Block => Child);
+                  Disp_Header (Nctxt);
+                  if Nctxt.Base /= Null_Address then
+                     Disp_Sub_Block (Nblk, Nctxt);
+                  end if;
+               end;
+            when Ghdl_Rtik_Instance =>
+               declare
+                  Inst : Ghdl_Rtin_Instance_Acc;
+                  Sub_Ctxt : Rti_Context;
+                  Sub_Blk : Ghdl_Rtin_Block_Acc;
+                  Npfx : String (1 .. Pfx'Length + 4);
+                  Comp : Ghdl_Rtin_Component_Acc;
+                  Ch : Ghdl_Rti_Access;
+               begin
+                  Disp_Header (Ctxt);
+                  Inst := To_Ghdl_Rtin_Instance_Acc (Child);
+                  Get_Instance_Context (Inst, Ctxt, Sub_Ctxt);
+                  Sub_Blk := To_Ghdl_Rtin_Block_Acc (Sub_Ctxt.Block);
+                  if Inst.Instance.Kind = Ghdl_Rtik_Component
+                    and then Disp_Tree_Flag >= Disp_Tree_Port
+                  then
+                     --  Disp generics and ports of the component.
+                     Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
+                     for I in 1 .. Comp.Nbr_Child loop
+                        Ch := Comp.Children (I - 1);
+                        if Ch.Kind = Ghdl_Rtik_Port then
+                           --  Disp only port (and not generics).
+                           Put (Pfx);
+                           if Child2 = null then
+                              Put ("  ");
+                           else
+                              Put ("| ");
+                           end if;
+                           if I = Comp.Nbr_Child and then Sub_Blk = null then
+                              Put ("`-");
+                           else
+                              Put ("+-");
+                           end if;
+                           Disp_Tree_Child (Ch, Sub_Ctxt);
+                           New_Line;
+                        end if;
+                     end loop;
+                  end if;
+                  if Sub_Blk /= null then
+                     Npfx (1 .. Pfx'Length) := Pfx;
+                     if Child2 = null then
+                        Npfx (Pfx'Length + 1) := ' ';
+                     else
+                        Npfx (Pfx'Length + 1) := '|';
+                     end if;
+                     Npfx (Pfx'Length + 2) := ' ';
+                     Npfx (Pfx'Length + 3) := '`';
+                     Npfx (Pfx'Length + 4) := '-';
+                     Put (Npfx);
+                     Disp_Tree_Child (Sub_Blk.Parent, Sub_Ctxt);
+                     New_Line;
+                     Npfx (Pfx'Length + 3) := ' ';
+                     Npfx (Pfx'Length + 4) := ' ';
+                     Disp_Tree_Block (Sub_Blk, Sub_Ctxt, Npfx);
+                  end if;
+               end;
+            when others =>
+               Disp_Header (Ctxt);
+         end case;
+
+         Child := Child2;
+      end loop;
+   end Disp_Tree_Block1;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+   begin
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Architecture =>
+            declare
+               Npfx : String (1 .. Pfx'Length + 2);
+               Nctxt : Rti_Context;
+            begin
+               --  The entity.
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Disp_Tree_Block1
+                 (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Nctxt, Pfx);
+               --  Then the architecture.
+               Put (Pfx);
+               Put ("`-");
+               Disp_Tree_Child (To_Ghdl_Rti_Access (Blk), Ctxt);
+               New_Line;
+               Npfx (1 .. Pfx'Length) := Pfx;
+               Npfx (Pfx'Length + 1) := ' ';
+               Npfx (Pfx'Length + 2) := ' ';
+               Disp_Tree_Block1 (Blk, Ctxt, Npfx);
+            end;
+         when Ghdl_Rtik_Package_Body =>
+            Disp_Tree_Block1
+              (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Ctxt, Pfx);
+         when others =>
+            Disp_Tree_Block1 (Blk, Ctxt, Pfx);
+      end case;
+   end Disp_Tree_Block;
+
+   procedure Disp_Hierarchy
+   is
+      Ctxt : Rti_Context;
+      Parent : Ghdl_Rtin_Block_Acc;
+      Child : Ghdl_Rti_Access;
+   begin
+      if Disp_Tree_Flag = Disp_Tree_None then
+         return;
+      end if;
+
+      Ctxt := Get_Top_Context;
+      Parent := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+
+      Disp_Tree_Child (Parent.Parent, Ctxt);
+      New_Line;
+      Disp_Tree_Block (Parent, Ctxt, "");
+
+      for I in 1 .. Ghdl_Rti_Top.Nbr_Child loop
+         Child := Ghdl_Rti_Top.Children (I - 1);
+         Ctxt := (Base => Null_Address,
+                  Block => Child);
+         Disp_Tree_Child (Child, Ctxt);
+         New_Line;
+         Disp_Tree_Block (To_Ghdl_Rtin_Block_Acc (Child), Ctxt, "");
+      end loop;
+   end Disp_Hierarchy;
+
+   function Disp_Tree_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt'Length >= 11 and then Opt (1 .. 11) = "--disp-tree" then
+         if Opt'Length = 11 then
+            Disp_Tree_Flag := Disp_Tree_Port;
+         elsif Opt (12 .. Opt'Last) = "=port" then
+            Disp_Tree_Flag := Disp_Tree_Port;
+         elsif Opt (12 .. Opt'Last) = "=proc" then
+            Disp_Tree_Flag := Disp_Tree_Proc;
+         elsif Opt (12 .. Opt'Last) = "=inst" then
+            Disp_Tree_Flag := Disp_Tree_Inst;
+         elsif Opt (12 .. Opt'Last) = "=none" then
+            Disp_Tree_Flag := Disp_Tree_None;
+         else
+            Error ("bad argument for --disp-tree option, try --help");
+         end if;
+         return True;
+      else
+         return False;
+      end if;
+   end Disp_Tree_Option;
+
+   procedure Disp_Tree_Help
+   is
+      procedure P (Str : String) renames Put_Line;
+   begin
+      P (" --disp-tree[=KIND] disp the design hierarchy after elaboration");
+      P ("       KIND is inst, proc, port (default)");
+   end Disp_Tree_Help;
+
+   Disp_Tree_Hooks : aliased constant Hooks_Type :=
+     (Option => Disp_Tree_Option'Access,
+      Help => Disp_Tree_Help'Access,
+      Init => null,
+      Start => Disp_Hierarchy'Access,
+      Finish => null);
+
+   procedure Register is
+   begin
+      Register_Hooks (Disp_Tree_Hooks'Access);
+   end Register;
+
+end Grt.Disp_Tree;
diff --git a/src/translate/grt/grt-disp_tree.ads b/src/translate/grt/grt-disp_tree.ads
new file mode 100644
index 000000000..e3bc983a7
--- /dev/null
+++ b/src/translate/grt/grt-disp_tree.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+package Grt.Disp_Tree is
+   procedure Register;
+end Grt.Disp_Tree;
diff --git a/src/translate/grt/grt-errors.adb b/src/translate/grt/grt-errors.adb
new file mode 100644
index 000000000..eddea38c1
--- /dev/null
+++ b/src/translate/grt/grt-errors.adb
@@ -0,0 +1,253 @@
+--  GHDL Run Time (GRT) - Error handling.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Options; use Grt.Options;
+with Grt.Hooks; use Grt.Hooks;
+
+package body Grt.Errors is
+   --  Called in case of premature exit.
+   --  CODE is 0 for success, 1 for failure.
+   procedure Ghdl_Exit (Code : Integer);
+   pragma No_Return (Ghdl_Exit);
+
+   procedure Ghdl_Exit (Code : Integer)
+   is
+      procedure C_Exit (Status : Integer);
+      pragma Import (C, C_Exit, "exit");
+      pragma No_Return (C_Exit);
+   begin
+      C_Exit (Code);
+   end Ghdl_Exit;
+
+   procedure Maybe_Return_Via_Longjump (Val : Integer);
+   pragma Import (C, Maybe_Return_Via_Longjump,
+                  "__ghdl_maybe_return_via_longjump");
+
+   procedure Exit_Simulation is
+   begin
+      Maybe_Return_Via_Longjump (-2);
+      Internal_Error ("exit_simulation");
+   end Exit_Simulation;
+
+   procedure Fatal_Error is
+   begin
+      if Error_Hook /= null then
+         --  Call the hook, but avoid infinite loop by reseting it.
+         declare
+            Current_Hook : constant Proc_Hook_Type := Error_Hook;
+         begin
+            Error_Hook := null;
+            Current_Hook.all;
+         end;
+      end if;
+      Maybe_Return_Via_Longjump (-1);
+      if Expect_Failure then
+         Ghdl_Exit (0);
+      else
+         Ghdl_Exit (1);
+      end if;
+   end Fatal_Error;
+
+   procedure Put_Err (Str : String) is
+   begin
+      Put (stderr, Str);
+   end Put_Err;
+
+   procedure Put_Err (Str : Ghdl_C_String) is
+   begin
+      Put (stderr, Str);
+   end Put_Err;
+
+   procedure Put_Err (N : Integer) is
+   begin
+      Put_I32 (stderr, Ghdl_I32 (N));
+   end Put_Err;
+
+   procedure Newline_Err is
+   begin
+      New_Line (stderr);
+   end Newline_Err;
+
+--    procedure Put_Err (Str : Ghdl_Str_Len_Type)
+--    is
+--       S : String (1 .. 3);
+--    begin
+--       if Str.Str = null then
+--          S (1) := ''';
+--          S (2) := Character'Val (Str.Len);
+--          S (3) := ''';
+--          Put_Err (S);
+--       else
+--          Put_Err (Str.Str (1 .. Str.Len));
+--       end if;
+--    end Put_Err;
+
+   procedure Report_H (Str : String := "") is
+   begin
+      Put_Err (Str);
+   end Report_H;
+
+   procedure Report_C (Str : String) is
+   begin
+      Put_Err (Str);
+   end Report_C;
+
+   procedure Report_C (Str : Ghdl_C_String)
+   is
+      Len : constant Natural := strlen (Str);
+   begin
+      Put_Err (Str (1 .. Len));
+   end Report_C;
+
+   procedure Report_C (N : Integer)
+     renames Put_Err;
+
+   procedure Report_Now_C is
+   begin
+      Put_Time (stderr, Grt.Types.Current_Time);
+   end Report_Now_C;
+
+   procedure Report_E (Str : String) is
+   begin
+      Put_Err (Str);
+      Newline_Err;
+   end Report_E;
+
+   procedure Report_E (Str : Std_String_Ptr)
+   is
+      subtype Ada_Str is String (1 .. Natural (Str.Bounds.Dim_1.Length));
+   begin
+      if Ada_Str'Length > 0 then
+         Put_Err (Ada_Str (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      end if;
+      Newline_Err;
+   end Report_E;
+
+   procedure Error_H is
+   begin
+      Put_Err (Progname);
+      Put_Err (":error: ");
+   end Error_H;
+
+   Cont : Boolean := False;
+
+   procedure Error_C (Str : String) is
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (Str);
+   end Error_C;
+
+   procedure Error_C (Str : Ghdl_C_String)
+   is
+      Len : constant Natural := strlen (Str);
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (Str (1 .. Len));
+   end Error_C;
+
+   procedure Error_C (N : Integer) is
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (N);
+   end Error_C;
+
+--    procedure Error_C (Inst : Ghdl_Instance_Name_Acc)
+--    is
+--    begin
+--       if not Cont then
+--          Error_H;
+--          Cont := True;
+--       end if;
+--       if Inst.Parent /= null then
+--          Error_C (Inst.Parent);
+--          Put_Err (".");
+--       end if;
+--       case Inst.Kind is
+--          when Ghdl_Name_Architecture =>
+--             Put_Err ("(");
+--             Put_Err (Inst.Name.all);
+--             Put_Err (")");
+--          when others =>
+--             if Inst.Name /= null then
+--                Put_Err (Inst.Name.all);
+--             end if;
+--       end case;
+--    end Error_C;
+
+   procedure Error_E (Str : String := "") is
+   begin
+      Put_Err (Str);
+      Newline_Err;
+      Cont := False;
+      Fatal_Error;
+   end Error_E;
+
+   procedure Error_C_Std (Str : Std_String_Uncons)
+   is
+      subtype Str_Subtype is String (1 .. Str'Length);
+   begin
+      Error_C (Str_Subtype (Str));
+   end Error_C_Std;
+
+   procedure Error (Str : String) is
+   begin
+      Error_H;
+      Put_Err (Str);
+      Newline_Err;
+      Fatal_Error;
+   end Error;
+
+   procedure Info (Str : String) is
+   begin
+      Put_Err (Progname);
+      Put_Err (":info: ");
+      Put_Err (Str);
+      Newline_Err;
+   end Info;
+
+   procedure Internal_Error (Msg : String) is
+   begin
+      Put_Err (Progname);
+      Put_Err (":internal error: ");
+      Put_Err (Msg);
+      Newline_Err;
+      Fatal_Error;
+   end Internal_Error;
+
+   procedure Grt_Overflow_Error is
+   begin
+      Error ("overflow detected");
+   end Grt_Overflow_Error;
+end Grt.Errors;
diff --git a/src/translate/grt/grt-errors.ads b/src/translate/grt/grt-errors.ads
new file mode 100644
index 000000000..c797a71bd
--- /dev/null
+++ b/src/translate/grt/grt-errors.ads
@@ -0,0 +1,84 @@
+--  GHDL Run Time (GRT) - Error handling.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Hooks;
+
+package Grt.Errors is
+   pragma Preelaborate (Grt.Errors);
+
+   --  Multi-call error procedure.
+   --  Start and continue with Error_C, finish by an Error_E.
+   procedure Error_C (Str : String);
+   procedure Error_C (N : Integer);
+   procedure Error_C (Str : Ghdl_C_String);
+   procedure Error_C_Std (Str : Std_String_Uncons);
+   --procedure Error_C (Inst : Ghdl_Instance_Name_Acc);
+   procedure Error_E (Str : String := "");
+   -- procedure Error_E_Std (Str : Std_String_Uncons);
+   pragma No_Return (Error_E);
+
+   --  Multi-call report procedure.  Do not exit at end.
+   procedure Report_H (Str : String := "");
+   procedure Report_C (Str : Ghdl_C_String);
+   procedure Report_C (Str : String);
+   procedure Report_C (N : Integer);
+   procedure Report_Now_C;
+   procedure Report_E (Str : String);
+   procedure Report_E (Str : Std_String_Ptr);
+
+   --  Complete error message.
+   procedure Error (Str : String);
+
+   --  Internal error.  The message must contain the subprogram name which
+   --  has called this procedure.
+   procedure Internal_Error (Msg : String);
+   pragma No_Return (Internal_Error);
+
+   --  Display a message which is not an error.
+   procedure Info (Str : String);
+
+   --  Display an error message for an overflow.
+   procedure Grt_Overflow_Error;
+
+   --  Called at end of error message.  Central point for failures.
+   procedure Fatal_Error;
+   pragma No_Return (Fatal_Error);
+   pragma Export (C, Fatal_Error, "__ghdl_fatal");
+
+   Exit_Status : Integer := 0;
+   procedure Exit_Simulation;
+
+   --  Hook called in case of error.
+   Error_Hook : Grt.Hooks.Proc_Hook_Type := null;
+
+   --  If true, an error is expected and the exit status is inverted.
+   Expect_Failure : Boolean := False;
+
+private
+   pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
+
+   pragma No_Return (Error);
+end Grt.Errors;
+
diff --git a/src/translate/grt/grt-files.adb b/src/translate/grt/grt-files.adb
new file mode 100644
index 000000000..30d51cf43
--- /dev/null
+++ b/src/translate/grt/grt-files.adb
@@ -0,0 +1,452 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
+with Grt.Table;
+with System; use System;
+pragma Elaborate_All (Grt.Table);
+
+package body Grt.Files is
+   subtype C_Files is Grt.Stdio.FILEs;
+
+   Auto_Flush : constant Boolean := False;
+
+   type File_Entry_Type is record
+      Stream : C_Files;
+      Signature : Ghdl_C_String;
+      Is_Text : Boolean;
+      Is_Alive : Boolean;
+   end record;
+
+   package Files_Table is new Grt.Table
+     (Table_Component_Type => File_Entry_Type,
+      Table_Index_Type => Ghdl_File_Index,
+      Table_Low_Bound => 1,
+      Table_Initial => 2);
+
+   function Get_File (Index : Ghdl_File_Index) return C_Files
+   is
+   begin
+      if Index not in Files_Table.First .. Files_Table.Last then
+         Internal_Error ("get_file: bad file index");
+      end if;
+      return Files_Table.Table (Index).Stream;
+   end Get_File;
+
+   procedure Check_File_Mode (Index : Ghdl_File_Index; Is_Text : Boolean)
+   is
+   begin
+      if Files_Table.Table (Index).Is_Text /= Is_Text then
+         Internal_Error ("check_file_mode: bad file mode");
+      end if;
+   end Check_File_Mode;
+
+   function Create_File (Is_Text : Boolean; Sig : Ghdl_C_String)
+                        return Ghdl_File_Index is
+   begin
+      Files_Table.Append ((Stream => NULL_Stream,
+                           Signature => Sig,
+                           Is_Text => Is_Text,
+                           Is_Alive => True));
+      return Files_Table.Last;
+   end Create_File;
+
+   procedure Destroy_File (Is_Text : Boolean; Index : Ghdl_File_Index) is
+   begin
+      if Get_File (Index) /= NULL_Stream then
+         Internal_Error ("destroy_file");
+      end if;
+      Check_File_Mode (Index, Is_Text);
+      Files_Table.Table (Index).Is_Alive := False;
+      if Index = Files_Table.Last then
+         while Files_Table.Last >= Files_Table.First
+           and then Files_Table.Table (Files_Table.Last).Is_Alive = False
+         loop
+            Files_Table.Decrement_Last;
+         end loop;
+      end if;
+   end Destroy_File;
+
+   procedure File_Error (File : Ghdl_File_Index)
+   is
+      pragma Unreferenced (File);
+   begin
+      Internal_Error ("file: IO error");
+   end File_Error;
+
+   function Ghdl_Text_File_Elaborate return Ghdl_File_Index is
+   begin
+      return Create_File (True, null);
+   end Ghdl_Text_File_Elaborate;
+
+   function Ghdl_File_Elaborate (Sig : Ghdl_C_String) return Ghdl_File_Index
+   is
+   begin
+      return Create_File (False, Sig);
+   end Ghdl_File_Elaborate;
+
+   procedure Ghdl_Text_File_Finalize (File : Ghdl_File_Index) is
+   begin
+      Destroy_File (True, File);
+   end Ghdl_Text_File_Finalize;
+
+   procedure Ghdl_File_Finalize (File : Ghdl_File_Index) is
+   begin
+      Destroy_File (False, File);
+   end Ghdl_File_Finalize;
+
+   function Ghdl_File_Endfile (File : Ghdl_File_Index) return Boolean
+   is
+      Stream : C_Files;
+      C : int;
+   begin
+      Stream := Get_File (File);
+      if feof (Stream) /= 0 then
+         return True;
+      end if;
+      C := fgetc (Stream);
+      if C < 0 then
+         return True;
+      end if;
+      if ungetc (C, Stream) /= C then
+         Error ("internal error: ungetc");
+      end if;
+      return False;
+   end Ghdl_File_Endfile;
+
+   Sig_Header : constant String := "#GHDL-BINARY-FILE-0.0" & Nl;
+
+   function File_Open (File : Ghdl_File_Index;
+                       Mode : Ghdl_I32;
+                       Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+      Name : String (1 .. Integer (Str.Bounds.Dim_1.Length) + 1);
+      Str_Mode : String (1 .. 3);
+      F : C_Files;
+      Sig : Ghdl_C_String;
+      Sig_Len : Natural;
+   begin
+      F := Get_File (File);
+
+      if F /= NULL_Stream then
+         --  File was already open.
+         return Status_Error;
+      end if;
+
+      --  Copy file name and convert it to a C string (NUL terminated).
+      for I in 1 .. Str.Bounds.Dim_1.Length loop
+         Name (Natural (I)) := Str.Base (I - 1);
+      end loop;
+      Name (Name'Last) := NUL;
+
+      if Name = "STD_INPUT" & NUL then
+         if Mode /= Read_Mode then
+            return Mode_Error;
+         end if;
+         F := stdin;
+      elsif Name = "STD_OUTPUT" & NUL then
+         if Mode /= Write_Mode then
+            return Mode_Error;
+         end if;
+         F := stdout;
+      else
+         case Mode is
+            when Read_Mode =>
+               Str_Mode (1) := 'r';
+            when Write_Mode =>
+               Str_Mode (1) := 'w';
+            when Append_Mode =>
+               Str_Mode (1) := 'a';
+            when others =>
+               --  Bad mode, cannot happen.
+               Internal_Error ("file_open: bad open mode");
+         end case;
+         if Files_Table.Table (File).Is_Text then
+            Str_Mode (2) := NUL;
+         else
+            Str_Mode (2) := 'b';
+            Str_Mode (3) := NUL;
+         end if;
+         F := fopen (Name'Address, Str_Mode'Address);
+         if F = NULL_Stream then
+            return Name_Error;
+         end if;
+      end if;
+      Sig := Files_Table.Table (File).Signature;
+      if Sig /= null then
+         Sig_Len := strlen (Sig);
+         case Mode is
+            when Write_Mode =>
+               if fwrite (Sig_Header'Address, 1, Sig_Header'Length, F)
+                 /= Sig_Header'Length
+               then
+                  File_Error (File);
+               end if;
+               if fwrite (Sig (1)'Address, 1, size_t (Sig_Len), F)
+                 /= size_t (Sig_Len)
+               then
+                  File_Error (File);
+               end if;
+            when Read_Mode =>
+               declare
+                  Hdr : String (1 .. Sig_Header'Length);
+                  Sig_Buf : String (1 .. Sig_Len);
+               begin
+                  if fread (Hdr'Address, 1, Hdr'Length, F) /= Hdr'Length then
+                     File_Error (File);
+                  end if;
+                  if Hdr /= Sig_Header then
+                     File_Error (File);
+                  end if;
+                  if fread (Sig_Buf'Address, 1, Sig_Buf'Length, F)
+                    /= Sig_Buf'Length
+                  then
+                     File_Error (File);
+                  end if;
+                  if Sig_Buf /= Sig (1 .. Sig_Len) then
+                     File_Error (File);
+                  end if;
+               end;
+            when Append_Mode =>
+               null;
+            when others =>
+               null;
+         end case;
+      end if;
+      Files_Table.Table (File).Stream := F;
+      return Open_Ok;
+   end File_Open;
+
+   procedure Ghdl_Text_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+   is
+      Res : Ghdl_I32;
+   begin
+      Check_File_Mode (File, True);
+
+      Res := File_Open (File, Mode, Str);
+
+      if Res /= Open_Ok then
+         Error_C ("open: cannot open text file ");
+         Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_E;
+      end if;
+   end Ghdl_Text_File_Open;
+
+   procedure Ghdl_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+   is
+      Res : Ghdl_I32;
+   begin
+      Check_File_Mode (File, False);
+
+      Res := File_Open (File, Mode, Str);
+
+      if Res /= Open_Ok then
+         Error_C ("open: cannot open file ");
+         Error_C_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1));
+         Error_E;
+      end if;
+   end Ghdl_File_Open;
+
+   function Ghdl_Text_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+   begin
+      Check_File_Mode (File, True);
+      return File_Open (File, Mode, Str);
+   end Ghdl_Text_File_Open_Status;
+
+   function Ghdl_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+   begin
+      Check_File_Mode (File, False);
+      return File_Open (File, Mode, Str);
+   end Ghdl_File_Open_Status;
+
+   procedure Ghdl_Text_Write (File : Ghdl_File_Index; Str : Std_String_Ptr)
+   is
+      Res : C_Files;
+      R : size_t;
+      R1 : int;
+      pragma Unreferenced (R, R1);
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, True);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fwrite (Str.Base (0)'Address,
+                   size_t (Str.Bounds.Dim_1.Length), 1, Res);
+      --  FIXME: check r
+      --  Write '\n'.
+      R1 := fputc (Character'Pos (Nl), Res);
+      if Auto_Flush then
+         fflush (Res);
+      end if;
+   end Ghdl_Text_Write;
+
+   procedure Ghdl_Write_Scalar (File : Ghdl_File_Index;
+                                Ptr : Ghdl_Ptr;
+                                Length : Ghdl_Index_Type)
+   is
+      Res : C_Files;
+      R : size_t;
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, False);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fwrite (System.Address (Ptr), size_t (Length), 1, Res);
+      if R /= 1 then
+         Error ("write_scalar failed");
+      end if;
+      if Auto_Flush then
+         fflush (Res);
+      end if;
+   end Ghdl_Write_Scalar;
+
+   procedure Ghdl_Read_Scalar (File : Ghdl_File_Index;
+                               Ptr : Ghdl_Ptr;
+                               Length : Ghdl_Index_Type)
+   is
+      Res : C_Files;
+      R : size_t;
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, False);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fread (System.Address (Ptr), size_t (Length), 1, Res);
+      if R /= 1 then
+         Error ("read_scalar failed");
+      end if;
+   end Ghdl_Read_Scalar;
+
+   function Ghdl_Text_Read_Length (File : Ghdl_File_Index;
+                                   Str : Std_String_Ptr)
+     return Std_Integer
+   is
+      Stream : C_Files;
+      C : int;
+      Len : Ghdl_Index_Type;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, True);
+      Len := Str.Bounds.Dim_1.Length;
+      --  Read until EOL (or EOF).
+      --  Store as much as possible.
+      for I in Ghdl_Index_Type loop
+         C := fgetc (Stream);
+         if C < 0 then
+            Error ("read: end of file reached");
+            return Std_Integer (I);
+         end if;
+         if I < Len then
+            Str.Base (I) := Character'Val (C);
+         end if;
+         --  End of line is '\n' or LF or character # 10.
+         if C = 10 then
+            return Std_Integer (I + 1);
+         end if;
+      end loop;
+      return 0;
+   end Ghdl_Text_Read_Length;
+
+   procedure Ghdl_Untruncated_Text_Read
+     (Res : Ghdl_Untruncated_Text_Read_Result_Acc;
+      File : Ghdl_File_Index;
+      Str : Std_String_Ptr)
+   is
+      Stream : C_Files;
+      Len : int;
+      Idx : Ghdl_Index_Type;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, True);
+      Len := int (Str.Bounds.Dim_1.Length);
+      if fgets (Str.Base (0)'Address, Len, Stream) = Null_Address then
+         Internal_Error ("ghdl_untruncated_text_read: end of file");
+      end if;
+      --  Compute the length.
+      for I in Ghdl_Index_Type loop
+         if Str.Base (I) = NUL then
+            Idx := I;
+            exit;
+         end if;
+      end loop;
+      Res.Len := Std_Integer (Idx);
+   end Ghdl_Untruncated_Text_Read;
+
+   procedure File_Close (File : Ghdl_File_Index; Is_Text : Boolean)
+   is
+      Stream : C_Files;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, Is_Text);
+      --  LRM 3.4.1  File Operations
+      --  If F is not associated with an external file, then FILE_CLOSE has
+      --  no effect.
+      if Stream = NULL_Stream then
+         return;
+      end if;
+      if fclose (Stream) /= 0 then
+         Internal_Error ("file_close: fclose error");
+      end if;
+      Files_Table.Table (File).Stream := NULL_Stream;
+   end File_Close;
+
+   procedure Ghdl_Text_File_Close (File : Ghdl_File_Index) is
+   begin
+      File_Close (File, True);
+   end Ghdl_Text_File_Close;
+
+   procedure Ghdl_File_Close (File : Ghdl_File_Index) is
+   begin
+      File_Close (File, False);
+   end Ghdl_File_Close;
+
+   procedure Ghdl_File_Flush (File : Ghdl_File_Index)
+   is
+      Stream : C_Files;
+   begin
+      Stream := Get_File (File);
+      if Stream = NULL_Stream then
+         return;
+      end if;
+      fflush (Stream);
+   end Ghdl_File_Flush;
+end Grt.Files;
+
diff --git a/src/translate/grt/grt-files.ads b/src/translate/grt/grt-files.ads
new file mode 100644
index 000000000..14f998468
--- /dev/null
+++ b/src/translate/grt/grt-files.ads
@@ -0,0 +1,123 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Interfaces;
+
+package Grt.Files is
+   type Ghdl_File_Index is new Interfaces.Integer_32;
+
+   --  File open mode.
+   Read_Mode   : constant Ghdl_I32 := 0;
+   Write_Mode  : constant Ghdl_I32 := 1;
+   Append_Mode : constant Ghdl_I32 := 2;
+
+   --  file_open_status.
+   Open_Ok      : constant Ghdl_I32 := 0;
+   Status_Error : constant Ghdl_I32 := 1;
+   Name_Error   : constant Ghdl_I32 := 2;
+   Mode_Error   : constant Ghdl_I32 := 3;
+
+   --  General files.
+   function Ghdl_File_Endfile (File : Ghdl_File_Index) return Boolean;
+
+   --  Elaboration.
+   function Ghdl_Text_File_Elaborate return Ghdl_File_Index;
+   function Ghdl_File_Elaborate (Sig : Ghdl_C_String) return Ghdl_File_Index;
+
+   --  Finalization.
+   procedure Ghdl_Text_File_Finalize (File : Ghdl_File_Index);
+   procedure Ghdl_File_Finalize (File : Ghdl_File_Index);
+
+   --  Subprograms.
+   procedure Ghdl_Text_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr);
+   function Ghdl_Text_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32;
+
+   procedure Ghdl_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr);
+   function Ghdl_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32;
+
+   procedure Ghdl_Text_Write (File : Ghdl_File_Index; Str : Std_String_Ptr);
+   procedure Ghdl_Write_Scalar (File : Ghdl_File_Index;
+                                Ptr : Ghdl_Ptr;
+                                Length : Ghdl_Index_Type);
+
+   procedure Ghdl_Read_Scalar (File : Ghdl_File_Index;
+                               Ptr : Ghdl_Ptr;
+                               Length : Ghdl_Index_Type);
+
+   function Ghdl_Text_Read_Length
+     (File : Ghdl_File_Index; Str : Std_String_Ptr) return Std_Integer;
+
+   type Ghdl_Untruncated_Text_Read_Result is record
+      Len : Std_Integer;
+   end record;
+
+   type Ghdl_Untruncated_Text_Read_Result_Acc is
+     access Ghdl_Untruncated_Text_Read_Result;
+
+   procedure Ghdl_Untruncated_Text_Read
+     (Res : Ghdl_Untruncated_Text_Read_Result_Acc;
+      File : Ghdl_File_Index;
+      Str : Std_String_Ptr);
+
+   procedure Ghdl_Text_File_Close (File : Ghdl_File_Index);
+   procedure Ghdl_File_Close (File : Ghdl_File_Index);
+
+   procedure Ghdl_File_Flush (File : Ghdl_File_Index);
+private
+   pragma Export (Ada, Ghdl_File_Endfile, "__ghdl_file_endfile");
+
+   pragma Export (C, Ghdl_Text_File_Elaborate, "__ghdl_text_file_elaborate");
+   pragma Export (C, Ghdl_File_Elaborate, "__ghdl_file_elaborate");
+
+   pragma Export (C, Ghdl_Text_File_Finalize, "__ghdl_text_file_finalize");
+   pragma Export (C, Ghdl_File_Finalize, "__ghdl_file_finalize");
+
+   pragma Export (C, Ghdl_Text_File_Open, "__ghdl_text_file_open");
+   pragma Export (C, Ghdl_Text_File_Open_Status,
+                  "__ghdl_text_file_open_status");
+
+   pragma Export (C, Ghdl_File_Open, "__ghdl_file_open");
+   pragma Export (C, Ghdl_File_Open_Status, "__ghdl_file_open_status");
+
+   pragma Export (C, Ghdl_Text_Write, "__ghdl_text_write");
+   pragma Export (C, Ghdl_Write_Scalar, "__ghdl_write_scalar");
+
+   pragma Export (C, Ghdl_Read_Scalar, "__ghdl_read_scalar");
+
+   pragma Export (C, Ghdl_Text_Read_Length, "__ghdl_text_read_length");
+   pragma Export (C, Ghdl_Untruncated_Text_Read,
+                  "std__textio__untruncated_text_read");
+
+   pragma Export (C, Ghdl_Text_File_Close, "__ghdl_text_file_close");
+   pragma Export (C, Ghdl_File_Close, "__ghdl_file_close");
+
+   pragma Export (C, Ghdl_File_Flush, "__ghdl_file_flush");
+end Grt.Files;
diff --git a/src/translate/grt/grt-hooks.adb b/src/translate/grt/grt-hooks.adb
new file mode 100644
index 000000000..6a77aaf01
--- /dev/null
+++ b/src/translate/grt/grt-hooks.adb
@@ -0,0 +1,161 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package body Grt.Hooks is
+   type Hooks_Cell;
+   type Hooks_Cell_Acc is access Hooks_Cell;
+   type Hooks_Cell is record
+      Hooks : Hooks_Acc;
+      Next : Hooks_Cell_Acc;
+   end record;
+
+   First_Hooks : Hooks_Cell_Acc := null;
+   Last_Hooks : Hooks_Cell_Acc := null;
+
+   procedure Register_Hooks (Hooks : Hooks_Acc)
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := new Hooks_Cell'(Hooks => Hooks,
+                              Next => null);
+      if Last_Hooks = null then
+         First_Hooks := Cell;
+      else
+         Last_Hooks.Next := Cell;
+      end if;
+      Last_Hooks := Cell;
+   end Register_Hooks;
+
+   type Hook_Cell;
+   type Hook_Cell_Acc is access Hook_Cell;
+   type Hook_Cell is record
+      Hook : Proc_Hook_Type;
+      Next : Hook_Cell_Acc;
+   end record;
+
+   --  Chain of cycle hooks.
+   Cycle_Hook : Hook_Cell_Acc := null;
+   Last_Cycle_Hook : Hook_Cell_Acc := null;
+
+   procedure Register_Cycle_Hook (Proc : Proc_Hook_Type)
+   is
+      Cell : Hook_Cell_Acc;
+   begin
+      Cell := new Hook_Cell'(Hook => Proc,
+                             Next => null);
+      if Cycle_Hook = null then
+         Cycle_Hook := Cell;
+      else
+         Last_Cycle_Hook.Next := Cell;
+      end if;
+      Last_Cycle_Hook := Cell;
+   end Register_Cycle_Hook;
+
+   procedure Call_Cycle_Hooks
+   is
+      Cell : Hook_Cell_Acc;
+   begin
+      Cell := Cycle_Hook;
+      while Cell /= null loop
+         Cell.Hook.all;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Cycle_Hooks;
+
+   function Call_Option_Hooks (Opt : String) return Boolean
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Option /= null
+           and then Cell.Hooks.Option.all (Opt)
+         then
+            return True;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+      return False;
+   end Call_Option_Hooks;
+
+   procedure Call_Help_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Help /= null then
+            Cell.Hooks.Help.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Help_Hooks;
+
+   procedure Call_Init_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Init /= null then
+            Cell.Hooks.Init.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Init_Hooks;
+
+   procedure Call_Start_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Start /= null then
+            Cell.Hooks.Start.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Start_Hooks;
+
+   procedure Call_Finish_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Finish /= null then
+            Cell.Hooks.Finish.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Finish_Hooks;
+
+   procedure Proc_Hook_Nil is
+   begin
+      null;
+   end Proc_Hook_Nil;
+end Grt.Hooks;
+
+
diff --git a/src/translate/grt/grt-hooks.ads b/src/translate/grt/grt-hooks.ads
new file mode 100644
index 000000000..20846c7f8
--- /dev/null
+++ b/src/translate/grt/grt-hooks.ads
@@ -0,0 +1,70 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+package Grt.Hooks is
+   pragma Preelaborate (Grt.Hooks);
+
+   type Option_Hook_Type is access function (Opt : String) return Boolean;
+   type Proc_Hook_Type is access procedure;
+
+   type Hooks_Type is record
+      --  Called for every unknown command line argument.
+      --  Return TRUE if handled.
+      Option : Option_Hook_Type;
+
+      --  Display command line help.
+      Help : Proc_Hook_Type;
+
+      --  Called at initialization (after decoding options).
+      Init : Proc_Hook_Type;
+
+      --  Called just after elaboration.
+      Start : Proc_Hook_Type;
+
+      --  Called at the end of execution.
+      Finish : Proc_Hook_Type;
+   end record;
+
+   type Hooks_Acc is access constant Hooks_Type;
+
+   --  Registers hook.
+   procedure Register_Hooks (Hooks : Hooks_Acc);
+
+   --  Register an hook which will call PROC after every non-delta cycles.
+   procedure Register_Cycle_Hook (Proc : Proc_Hook_Type);
+
+   --  Call hooks.
+   function Call_Option_Hooks (Opt : String) return Boolean;
+   procedure Call_Help_Hooks;
+   procedure Call_Init_Hooks;
+   procedure Call_Start_Hooks;
+   procedure Call_Finish_Hooks;
+
+   --  Call non-delta cycles hooks.
+   procedure Call_Cycle_Hooks;
+   pragma Inline_Always (Call_Cycle_Hooks);
+
+   --  Nil procedure.
+   procedure Proc_Hook_Nil;
+end Grt.Hooks;
diff --git a/src/translate/grt/grt-images.adb b/src/translate/grt/grt-images.adb
new file mode 100644
index 000000000..342c98f2a
--- /dev/null
+++ b/src/translate/grt/grt-images.adb
@@ -0,0 +1,387 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Ada.Unchecked_Conversion;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Processes; use Grt.Processes;
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Images is
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Basep);
+
+   function To_Std_String_Boundp is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Boundp);
+
+   procedure Set_String_Bounds (Res : Std_String_Ptr; Len : Ghdl_Index_Type)
+   is
+   begin
+      Res.Bounds := To_Std_String_Boundp
+        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      Res.Bounds.Dim_1 := (Left => 1,
+                           Right => Std_Integer (Len),
+                           Dir => Dir_To,
+                           Length => Len);
+   end Set_String_Bounds;
+
+   procedure Return_String (Res : Std_String_Ptr; Str : String)
+   is
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
+      for I in 0 .. Str'Length - 1 loop
+         Res.Base (Ghdl_Index_Type (I)) := Str (Str'First + I);
+      end loop;
+      Set_String_Bounds (Res, Str'Length);
+   end Return_String;
+
+   procedure Return_Enum
+     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+      Str : Ghdl_C_String;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str := Enum_Rti.Names (Index);
+      Return_String (Res, Str (1 .. strlen (Str)));
+   end Return_Enum;
+
+   procedure Ghdl_Image_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_B1'Pos (Val));
+   end Ghdl_Image_B1;
+
+   procedure Ghdl_Image_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_E8'Pos (Val));
+   end Ghdl_Image_E8;
+
+   procedure Ghdl_Image_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_E32'Pos (Val));
+   end Ghdl_Image_E32;
+
+   procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
+   is
+      Str : String (1 .. 11);
+      First : Natural;
+   begin
+      To_String (Str, First, Val);
+      Return_String (Res, Str (First .. Str'Last));
+   end Ghdl_Image_I32;
+
+   procedure Ghdl_Image_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
+   is
+      Str : String (1 .. 21);
+      First : Natural;
+      Phys : constant Ghdl_Rtin_Type_Physical_Acc
+        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Unit_Name := Get_Physical_Unit_Name (Phys.Units (0));
+      Unit_Len := strlen (Unit_Name);
+      declare
+         L : constant Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Image_P64;
+
+   procedure Ghdl_Image_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
+   is
+      Str : String (1 .. 11);
+      First : Natural;
+      Phys : constant Ghdl_Rtin_Type_Physical_Acc
+        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Unit_Name := Get_Physical_Unit_Name (Phys.Units (0));
+      Unit_Len := strlen (Unit_Name);
+      declare
+         L : constant Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Image_P32;
+
+   procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
+   is
+      Str : String (1 .. 24);
+      P : Natural;
+   begin
+      To_String (Str, P, Val);
+      Return_String (Res, Str (1 .. P));
+   end Ghdl_Image_F64;
+
+   procedure Ghdl_To_String_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
+     renames Ghdl_Image_I32;
+   procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
+     renames Ghdl_Image_F64;
+
+   procedure Ghdl_To_String_F64_Digits
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32)
+   is
+      Str : String_Real_Digits;
+      P : Natural;
+   begin
+      To_String (Str, P, Val, Nbr_Digits);
+      Return_String (Res, Str (1 .. P));
+   end Ghdl_To_String_F64_Digits;
+
+   procedure Ghdl_To_String_F64_Format
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Format : Std_String_Ptr)
+   is
+      C_Format : String (1 .. Positive (Format.Bounds.Dim_1.Length + 1));
+      Str : Grt.Vstrings.String_Real_Format;
+      P : Natural;
+   begin
+      for I in 1 .. C_Format'Last - 1 loop
+         C_Format (I) := Format.Base (Ghdl_Index_Type (I - 1));
+      end loop;
+      C_Format (C_Format'Last) := NUL;
+
+      To_String (Str, P, Val, To_Ghdl_C_String (C_Format'Address));
+      Return_String (Res, Str (1 .. P));
+   end Ghdl_To_String_F64_Format;
+
+   subtype Log_Base_Type is Ghdl_Index_Type range 3 .. 4;
+   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
+     "0123456789ABCDEF";
+
+   procedure Ghdl_BV_To_String (Res : Std_String_Ptr;
+                                Val : Std_Bit_Vector_Basep;
+                                Len : Ghdl_Index_Type;
+                                Log_Base : Log_Base_Type)
+   is
+      Res_Len : constant Ghdl_Index_Type := (Len + Log_Base - 1) / Log_Base;
+      Pos : Ghdl_Index_Type;
+      V : Natural;
+      Sh : Natural range 0 .. 4;
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Res_Len));
+      V := 0;
+      Sh := 0;
+      Pos := Res_Len - 1;
+      for I in reverse 1 .. Len loop
+         V := V + Std_Bit'Pos (Val (I - 1)) * (2 ** Sh);
+         Sh := Sh + 1;
+         if Sh = Natural (Log_Base) or else I = 1 then
+            Res.Base (Pos) := Hex_Chars (V);
+            Pos := Pos - 1;
+            Sh := 0;
+            V := 0;
+         end if;
+      end loop;
+      Set_String_Bounds (Res, Res_Len);
+   end Ghdl_BV_To_String;
+
+   procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr;
+                                 Base : Std_Bit_Vector_Basep;
+                                 Len : Ghdl_Index_Type) is
+   begin
+      Ghdl_BV_To_String (Res, Base, Len, 3);
+   end Ghdl_BV_To_Ostring;
+
+   procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr;
+                                 Base : Std_Bit_Vector_Basep;
+                                 Len : Ghdl_Index_Type) is
+   begin
+      Ghdl_BV_To_String (Res, Base, Len, 4);
+   end Ghdl_BV_To_Hstring;
+
+   procedure To_String_Enum
+     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+      Str : Ghdl_C_String;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str := Enum_Rti.Names (Index);
+      if Str (1) = ''' then
+         Return_String (Res, Str (2 .. 2));
+      else
+         Return_String (Res, Str (1 .. strlen (Str)));
+      end if;
+   end To_String_Enum;
+
+   procedure Ghdl_To_String_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_B1'Pos (Val));
+   end Ghdl_To_String_B1;
+
+   procedure Ghdl_To_String_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_E8'Pos (Val));
+   end Ghdl_To_String_E8;
+
+   procedure Ghdl_To_String_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access) is
+   begin
+      To_String_Enum (Res, Rti, Ghdl_E32'Pos (Val));
+   end Ghdl_To_String_E32;
+
+   procedure Ghdl_To_String_Char (Res : Std_String_Ptr; Val : Std_Character) is
+   begin
+      Return_String (Res, (1 => Val));
+   end Ghdl_To_String_Char;
+
+   procedure Ghdl_To_String_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
+     renames Ghdl_Image_P32;
+
+   procedure Ghdl_To_String_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
+     renames Ghdl_Image_P64;
+
+   procedure Ghdl_Time_To_String_Unit
+     (Res : Std_String_Ptr;
+      Val : Std_Time; Unit : Std_Time; Rti : Ghdl_Rti_Access)
+   is
+      Str : Grt.Vstrings.String_Time_Unit;
+      First : Natural;
+      Phys : constant Ghdl_Rtin_Type_Physical_Acc
+        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Unit_Len : Natural;
+   begin
+      Unit_Name := null;
+      for I in 1 .. Phys.Nbr loop
+         if Get_Physical_Unit_Value (Phys.Units (I - 1), Rti) = Ghdl_I64 (Unit)
+         then
+            Unit_Name := Get_Physical_Unit_Name (Phys.Units (I - 1));
+            exit;
+         end if;
+      end loop;
+      if Unit_Name = null then
+         Error ("no unit for to_string");
+      end if;
+      Grt.Vstrings.To_String (Str, First, Ghdl_I64 (Val), Ghdl_I64 (Unit));
+      Unit_Len := strlen (Unit_Name);
+      declare
+         L : constant Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Time_To_String_Unit;
+
+   procedure Ghdl_Array_Char_To_String_B1
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_B1_Array_Base_Ptr := To_Ghdl_B1_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_B1'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_B1;
+
+   procedure Ghdl_Array_Char_To_String_E8
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_E8_Array_Base_Ptr := To_Ghdl_E8_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_E8'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_E8;
+
+   procedure Ghdl_Array_Char_To_String_E32
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str : Ghdl_C_String;
+      Arr : constant Ghdl_E32_Array_Base_Ptr :=
+        To_Ghdl_E32_Array_Base_Ptr (Val);
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
+      for I in 1 .. Len loop
+         Str := Enum_Rti.Names (Ghdl_E32'Pos (Arr (I - 1)));
+         Res.Base (I - 1) := Str (2);
+      end loop;
+      Set_String_Bounds (Res, Len);
+   end Ghdl_Array_Char_To_String_E32;
+
+--     procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
+--     is
+--        --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+--        --  + exp_digits (4) -> 24.
+--        Str : String (1 .. 25);
+
+--        procedure Snprintf_G (Str : System.Address;
+--                              Size : Integer;
+--                              Arg : Ghdl_F64);
+--        pragma Import (C, Snprintf_G, "__ghdl_snprintf_g");
+
+--        function strlen (Str : System.Address) return Integer;
+--        pragma Import (C, strlen);
+--     begin
+--        Snprintf_G (Str'Address, Str'Length, Val);
+--        Return_String (Res, Str (1 .. strlen (Str'Address)));
+--     end Ghdl_Image_F64;
+
+end Grt.Images;
diff --git a/src/translate/grt/grt-images.ads b/src/translate/grt/grt-images.ads
new file mode 100644
index 000000000..cd8911091
--- /dev/null
+++ b/src/translate/grt/grt-images.ads
@@ -0,0 +1,110 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Images is
+   --  For all images procedures, the result is allocated on the secondary
+   --  stack.
+
+   procedure Ghdl_Image_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32);
+   procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
+   procedure Ghdl_Image_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access);
+
+   procedure Ghdl_To_String_I32 (Res : Std_String_Ptr; Val : Ghdl_I32);
+   procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
+   procedure Ghdl_To_String_F64_Digits
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32);
+   procedure Ghdl_To_String_F64_Format
+     (Res : Std_String_Ptr; Val : Ghdl_F64; Format : Std_String_Ptr);
+   procedure Ghdl_To_String_B1
+     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_E32
+     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_Char
+     (Res : Std_String_Ptr; Val : Std_Character);
+   procedure Ghdl_To_String_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_To_String_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Time_To_String_Unit
+     (Res : Std_String_Ptr;
+      Val : Std_Time; Unit : Std_Time; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_B1
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_E8
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Array_Char_To_String_E32
+     (Res : Std_String_Ptr;
+      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access);
+
+   procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr;
+                                 Base : Std_Bit_Vector_Basep;
+                                 Len : Ghdl_Index_Type);
+   procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr;
+                                 Base : Std_Bit_Vector_Basep;
+                                 Len : Ghdl_Index_Type);
+private
+   pragma Export (Ada, Ghdl_Image_B1, "__ghdl_image_b1");
+   pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
+   pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32");
+   pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32");
+   pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64");
+   pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64");
+   pragma Export (C, Ghdl_Image_P32, "__ghdl_image_p32");
+
+   pragma Export (C, Ghdl_To_String_I32, "__ghdl_to_string_i32");
+   pragma Export (C, Ghdl_To_String_F64, "__ghdl_to_string_f64");
+   pragma Export (C, Ghdl_To_String_F64_Digits, "__ghdl_to_string_f64_digits");
+   pragma Export (C, Ghdl_To_String_F64_Format, "__ghdl_to_string_f64_format");
+   pragma Export (Ada, Ghdl_To_String_B1, "__ghdl_to_string_b1");
+   pragma Export (C, Ghdl_To_String_E8, "__ghdl_to_string_e8");
+   pragma Export (C, Ghdl_To_String_E32, "__ghdl_to_string_e32");
+   pragma Export (C, Ghdl_To_String_Char, "__ghdl_to_string_char");
+   pragma Export (C, Ghdl_To_String_P32, "__ghdl_to_string_p32");
+   pragma Export (C, Ghdl_To_String_P64, "__ghdl_to_string_p64");
+   pragma Export (C, Ghdl_Time_To_String_Unit, "__ghdl_time_to_string_unit");
+   pragma Export (C, Ghdl_Array_Char_To_String_B1,
+                  "__ghdl_array_char_to_string_b1");
+   pragma Export (C, Ghdl_Array_Char_To_String_E8,
+                  "__ghdl_array_char_to_string_e8");
+   pragma Export (C, Ghdl_Array_Char_To_String_E32,
+                  "__ghdl_array_char_to_string_e32");
+   pragma Export (C, Ghdl_BV_To_Ostring, "__ghdl_bv_to_ostring");
+   pragma Export (C, Ghdl_BV_To_Hstring, "__ghdl_bv_to_hstring");
+end Grt.Images;
diff --git a/src/translate/grt/grt-lib.adb b/src/translate/grt/grt-lib.adb
new file mode 100644
index 000000000..d2b095c67
--- /dev/null
+++ b/src/translate/grt/grt-lib.adb
@@ -0,0 +1,298 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+with Grt.Options;
+
+package body Grt.Lib is
+   --procedure Memcpy (Dst : Address; Src : Address; Size : Size_T);
+   --pragma Import (C, Memcpy);
+
+   procedure Ghdl_Memcpy
+     (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type)
+   is
+      procedure Memmove
+        (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
+      pragma Import (C, Memmove);
+   begin
+      Memmove (Dest, Src, Size);
+   end Ghdl_Memcpy;
+
+   procedure Do_Report (Msg : String;
+                        Str : Std_String_Ptr;
+                        Default_Str : String;
+                        Severity : Integer;
+                        Loc : Ghdl_Location_Ptr)
+   is
+      Level : constant Integer := Severity mod 256;
+   begin
+      Report_H;
+      Report_C (Loc.Filename);
+      Report_C (":");
+      Report_C (Loc.Line);
+      Report_C (":");
+      Report_C (Loc.Col);
+      Report_C (":@");
+      Report_Now_C;
+      Report_C (":(");
+      Report_C (Msg);
+      Report_C (" ");
+      case Level is
+         when Note_Severity =>
+            Report_C ("note");
+         when Warning_Severity =>
+            Report_C ("warning");
+         when Error_Severity =>
+            Report_C ("error");
+         when Failure_Severity =>
+            Report_C ("failure");
+         when others =>
+            Report_C ("???");
+      end case;
+      Report_C ("): ");
+      if Str /= null then
+         Report_E (Str);
+      else
+         Report_E (Default_Str);
+      end if;
+      if Level >= Grt.Options.Severity_Level then
+         Error_C (Msg);
+         Error_E (" failed");
+      end if;
+   end Do_Report;
+
+   procedure Ghdl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+   is
+   begin
+      Do_Report ("assertion", Str, "Assertion violation", Severity, Loc);
+   end Ghdl_Assert_Failed;
+
+   procedure Ghdl_Ieee_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+   is
+      use Grt.Options;
+   begin
+      if Ieee_Asserts = Disable_Asserts
+        or else (Ieee_Asserts = Disable_Asserts_At_Time_0 and Current_Time = 0)
+      then
+         return;
+      else
+         Do_Report ("assertion", Str, "Assertion violation", Severity, Loc);
+      end if;
+   end Ghdl_Ieee_Assert_Failed;
+
+   procedure Ghdl_Psl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
+   begin
+      Do_Report ("psl assertion", Str, "Assertion violation", Severity, Loc);
+   end Ghdl_Psl_Assert_Failed;
+
+   procedure Ghdl_Psl_Cover
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
+   begin
+      Do_Report ("psl cover", Str, "sequence covered", Severity, Loc);
+   end Ghdl_Psl_Cover;
+
+   procedure Ghdl_Psl_Cover_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr) is
+   begin
+      Do_Report ("psl cover failure",
+                 Str, "sequence not covered", Severity, Loc);
+   end Ghdl_Psl_Cover_Failed;
+
+   procedure Ghdl_Report
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr)
+   is
+   begin
+      Do_Report ("report", Str, "Assertion violation", Severity, Loc);
+   end Ghdl_Report;
+
+   procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
+                                 Line : Ghdl_I32;
+                                 Code : Ghdl_Index_Type)
+   is
+   begin
+      case Code is
+         when 1 =>
+            Error_C ("missing return in function");
+         when 2 =>
+            Error_C ("block already configured");
+         when 3 =>
+            Error_C ("bad configuration");
+         when others =>
+            Error_C ("unknown error code ");
+            Error_C (Integer (Code));
+      end case;
+      Error_C (" at ");
+      if Filename = null then
+         Error_C ("*unknown*");
+      else
+         Error_C (Filename);
+      end if;
+      Error_C (":");
+      Error_C (Integer(Line));
+      Error_E ("");
+   end Ghdl_Program_Error;
+
+   procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
+                                         Line: Ghdl_I32)
+   is
+   begin
+      Error_C ("bound check failure at ");
+      Error_C (Filename);
+      Error_C (":");
+      Error_C (Integer (Line));
+      Error_E ("");
+   end Ghdl_Bound_Check_Failed_L1;
+
+   function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
+     return Ghdl_I32
+   is
+      pragma Suppress (Overflow_Check);
+
+      R : Ghdl_I32;
+      Res : Ghdl_I32;
+      P : Ghdl_I32;
+      T : Ghdl_I64;
+   begin
+      if E < 0 then
+         Error ("negative exponent");
+      end if;
+      Res := 1;
+      P := V;
+      R := E;
+      loop
+         if R mod 2 = 1 then
+            T := Ghdl_I64 (Res) * Ghdl_I64 (P);
+            Res := Ghdl_I32 (T);
+            if Ghdl_I64 (Res) /= T then
+               Error ("overflow in exponentiation");
+            end if;
+         end if;
+         R := R / 2;
+         exit when R = 0;
+         P := P * P;
+      end loop;
+      return Res;
+   end Ghdl_Integer_Exp;
+
+   function C_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+   pragma Import (C, C_Malloc, "malloc");
+
+   function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr is
+   begin
+      return C_Malloc (Size);
+   end Ghdl_Malloc;
+
+   function Ghdl_Malloc0 (Size : Ghdl_Index_Type) return Ghdl_Ptr
+   is
+      procedure Memset (Ptr : Ghdl_Ptr; C : Integer; Size : Ghdl_Index_Type);
+      pragma Import (C, Memset);
+
+      Res : Ghdl_Ptr;
+   begin
+      Res := C_Malloc (Size);
+      Memset (Res, 0, Size);
+      return Res;
+   end Ghdl_Malloc0;
+
+   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr)
+   is
+      procedure C_Free (Ptr : Ghdl_Ptr);
+      pragma Import (C, C_Free, "free");
+   begin
+      C_Free (Ptr);
+   end Ghdl_Deallocate;
+
+   function Ghdl_Real_Exp (X : Ghdl_Real; Exp : Ghdl_I32)
+     return Ghdl_Real
+   is
+      R : Ghdl_I32;
+      Res : Ghdl_Real;
+      P : Ghdl_Real;
+   begin
+      Res := 1.0;
+      P := X;
+      R := Exp;
+      if R >= 0 then
+         loop
+            if R mod 2 = 1 then
+               Res := Res * P;
+            end if;
+            R := R / 2;
+            exit when R = 0;
+            P := P * P;
+         end loop;
+         return Res;
+      else
+         R := -R;
+         loop
+            if R mod 2 = 1 then
+               Res := Res * P;
+            end if;
+            R := R / 2;
+            exit when R = 0;
+            P := P * P;
+         end loop;
+         if Res = 0.0 then
+            Error ("division per 0.0");
+            return 0.0;
+         end if;
+         return 1.0 / Res;
+      end if;
+   end Ghdl_Real_Exp;
+
+   function Ghdl_Get_Resolution_Limit return Std_Time is
+   begin
+      return 1;
+   end Ghdl_Get_Resolution_Limit;
+
+   procedure Ghdl_Control_Simulation
+     (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer) is
+   begin
+      Report_H;
+      --  Report_C (Grt.Options.Progname);
+      Report_C ("simulation ");
+      if Stop then
+         Report_C ("stopped");
+      else
+         Report_C ("finished");
+      end if;
+      Report_C (" @");
+      Report_Now_C;
+      if Has_Status then
+         Report_C (" with status ");
+         Report_C (Integer (Status));
+      end if;
+      Report_E ("");
+      if Has_Status then
+         Exit_Status := Integer (Status);
+      end if;
+      Exit_Simulation;
+   end Ghdl_Control_Simulation;
+
+end Grt.Lib;
diff --git a/src/translate/grt/grt-lib.ads b/src/translate/grt/grt-lib.ads
new file mode 100644
index 000000000..4dac2c8d2
--- /dev/null
+++ b/src/translate/grt/grt-lib.ads
@@ -0,0 +1,127 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Lib is
+   pragma Preelaborate (Grt.Lib);
+
+   procedure Ghdl_Memcpy
+     (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
+
+   procedure Ghdl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+   procedure Ghdl_Ieee_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   procedure Ghdl_Psl_Assert_Failed
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr);
+
+   --  Called when a sequence is covered (in a cover directive)
+   procedure Ghdl_Psl_Cover
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   procedure Ghdl_Psl_Cover_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   procedure Ghdl_Report
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   Note_Severity    : constant Integer := 0;
+   Warning_Severity : constant Integer := 1;
+   Error_Severity   : constant Integer := 2;
+   Failure_Severity : constant Integer := 3;
+
+   procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
+                                         Line: Ghdl_I32);
+
+   --  Program error has occured:
+   --  * configuration of an already configured block.
+   procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
+                                 Line : Ghdl_I32;
+                                 Code : Ghdl_Index_Type);
+
+   function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
+     return Ghdl_I32;
+
+   function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+
+   --  Allocate and clear SIZE bytes.
+   function Ghdl_Malloc0 (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+
+   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr);
+
+   function Ghdl_Real_Exp (X : Ghdl_Real; Exp : Ghdl_I32)
+     return Ghdl_Real;
+
+   type Ghdl_Std_Ulogic_Boolean_Array_Type is array (Ghdl_E8 range 0 .. 8)
+     of Ghdl_B1;
+
+   Ghdl_Std_Ulogic_To_Boolean_Array :
+     constant Ghdl_Std_Ulogic_Boolean_Array_Type := (False, --  U
+                                                     False, --  X
+                                                     False, --  0
+                                                     True,  --  1
+                                                     False, --  Z
+                                                     False, --  W
+                                                     False, --  L
+                                                     True,  --  H
+                                                     False  --  -
+                                                    );
+
+   function Ghdl_Get_Resolution_Limit return Std_Time;
+   procedure Ghdl_Control_Simulation
+     (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer);
+private
+   pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy");
+
+   pragma Export (C, Ghdl_Assert_Failed, "__ghdl_assert_failed");
+   pragma Export (C, Ghdl_Ieee_Assert_Failed, "__ghdl_ieee_assert_failed");
+   pragma Export (C, Ghdl_Psl_Assert_Failed, "__ghdl_psl_assert_failed");
+   pragma Export (C, Ghdl_Psl_Cover, "__ghdl_psl_cover");
+   pragma Export (C, Ghdl_Psl_Cover_Failed, "__ghdl_psl_cover_failed");
+   pragma Export (C, Ghdl_Report, "__ghdl_report");
+
+   pragma Export (C, Ghdl_Bound_Check_Failed_L1,
+                  "__ghdl_bound_check_failed_l1");
+   pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error");
+
+   pragma Export (C, Ghdl_Malloc, "__ghdl_malloc");
+   pragma Export (C, Ghdl_Malloc0, "__ghdl_malloc0");
+   pragma Export (C, Ghdl_Deallocate, "__ghdl_deallocate");
+
+   pragma Export (C, Ghdl_Integer_Exp, "__ghdl_integer_exp");
+   pragma Export (C, Ghdl_Real_Exp, "__ghdl_real_exp");
+
+   pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array,
+                  "__ghdl_std_ulogic_to_boolean_array");
+
+   pragma Export (C, Ghdl_Get_Resolution_Limit,
+                  "__ghdl_get_resolution_limit");
+   pragma Export (Ada, Ghdl_Control_Simulation,
+                  "__ghdl_control_simulation");
+end Grt.Lib;
diff --git a/src/translate/grt/grt-main.adb b/src/translate/grt/grt-main.adb
new file mode 100644
index 000000000..116ea7b2e
--- /dev/null
+++ b/src/translate/grt/grt-main.adb
@@ -0,0 +1,190 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Types; use Grt.Types;
+with Grt.Errors;
+with Grt.Stacks;
+with Grt.Processes;
+with Grt.Signals;
+with Grt.Options; use Grt.Options;
+with Grt.Stats;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Disp;
+with Grt.Modules;
+
+--  The following packages are not referenced in this package.
+--  These are subprograms called only from GHDL generated code.
+--  They are with'ed in order to be present in the binary.
+pragma Warnings (Off);
+with Grt.Files;
+with Grt.Types;
+with Grt.Lib;
+with Grt.Shadow_Ieee;
+with Grt.Images;
+with Grt.Values;
+with Grt.Names;
+pragma Warnings (On);
+
+package body Grt.Main is
+   procedure Ghdl_Elaborate;
+   pragma Import (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   --  Wrapper around elaboration just to return 0.
+   function Ghdl_Elaborate_Wrapper return Integer is
+   begin
+      Ghdl_Elaborate;
+      return 0;
+   end Ghdl_Elaborate_Wrapper;
+
+   procedure Disp_Stats_Hook (Code : Integer);
+   pragma Convention (C, Disp_Stats_Hook);
+
+   procedure Disp_Stats_Hook (Code : Integer)
+   is
+      pragma Unreferenced (Code);
+   begin
+      Stats.End_Simulation;
+      Stats.Disp_Stats;
+   end Disp_Stats_Hook;
+
+   procedure Check_Flag_String
+   is
+      Err : Boolean;
+   begin
+      --  The conditions may be statically known.
+      pragma Warnings (Off);
+
+      Err := False;
+      if (Std_Integer'Size = 32 and Flag_String (3) /= 'i')
+        or else (Std_Integer'Size = 64 and Flag_String (3) /= 'I')
+      then
+         Err := True;
+      end if;
+      if (Std_Time'Size = 32 and Flag_String (4) /= 't')
+        or else (Std_Time'Size = 64 and Flag_String (4) /= 'T')
+      then
+         Err := True;
+      end if;
+
+      pragma Warnings (On);
+
+      if Err then
+         Grt.Errors.Error
+           ("GRT is not consistent with the flags used for your design");
+      end if;
+   end Check_Flag_String;
+
+   procedure Run
+   is
+      use Grt.Errors;
+      Stop : Boolean;
+      Status : Integer;
+   begin
+      --  Register modules.
+      --  They may insert hooks.
+      Grt.Modules.Register_Modules;
+
+      --  If the time resolution is to be set by the user, select a default
+      --  resolution.  Options may override it.
+      if Flag_String (5) = '?' then
+         Set_Time_Resolution ('n');
+      end if;
+
+      --  Decode options.
+      Grt.Options.Decode (Stop);
+
+      --  Check coherency between GRT and GHDL generated code.
+      Check_Flag_String;
+
+      --  Early stop (for options such as --help).
+      if Stop then
+         return;
+      end if;
+
+      --  Internal initializations.
+      Grt.Stacks.Stack_Init;
+
+      Grt.Hooks.Call_Init_Hooks;
+
+      Grt.Processes.Init;
+
+      Grt.Signals.Init;
+
+      if Flag_Stats then
+         Stats.Start_Elaboration;
+      end if;
+
+      --  Elaboration.  Run through longjump to catch errors.
+      if Grt.Processes.Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0
+      then
+         Grt.Errors.Error ("error during elaboration");
+         return;
+      end if;
+
+      if Flag_Stats then
+         Stats.Start_Order;
+      end if;
+
+      Grt.Hooks.Call_Start_Hooks;
+
+      if not Flag_No_Run then
+         Grt.Signals.Order_All_Signals;
+
+         if Grt.Options.Disp_Signals_Map then
+            Grt.Disp_Signals.Disp_Signals_Map;
+         end if;
+         if Grt.Options.Disp_Signals_Table then
+            Grt.Disp_Signals.Disp_Signals_Table;
+         end if;
+         if Disp_Signals_Order then
+            Grt.Disp.Disp_Signals_Order;
+         end if;
+         if Disp_Sensitivity then
+            Grt.Disp_Signals.Disp_All_Sensitivity;
+         end if;
+
+         --  Do the simulation.
+         Status := Grt.Processes.Simulation;
+      end if;
+
+      if Flag_Stats then
+         Disp_Stats_Hook (0);
+      end if;
+
+      if Expect_Failure then
+         if Status >= 0 then
+            Expect_Failure := False;
+            Error ("error expected, but none occured");
+         end if;
+      else
+         if Status < 0 then
+            Error ("simulation failed");
+         end if;
+      end if;
+   end Run;
+
+end Grt.Main;
diff --git a/src/translate/grt/grt-main.ads b/src/translate/grt/grt-main.ads
new file mode 100644
index 000000000..4f78477f2
--- /dev/null
+++ b/src/translate/grt/grt-main.ads
@@ -0,0 +1,29 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package Grt.Main is
+   --  Elaborate and simulate the design.
+   procedure Run;
+end Grt.Main;
diff --git a/src/translate/grt/grt-modules.adb b/src/translate/grt/grt-modules.adb
new file mode 100644
index 000000000..e5304f04d
--- /dev/null
+++ b/src/translate/grt/grt-modules.adb
@@ -0,0 +1,47 @@
+--  GHDL Run Time (GRT) -  Modules.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Vcd;
+with Grt.Vcdz;
+with Grt.Vpi;
+with Grt.Waves;
+with Grt.Vital_Annotate;
+with Grt.Disp_Tree;
+with Grt.Disp_Rti;
+
+package body Grt.Modules is
+   procedure Register_Modules is
+   begin
+      --  List of modules to be registered.
+      Grt.Disp_Tree.Register;
+      Grt.Vcd.Register;
+      Grt.Vcdz.Register;
+      Grt.Waves.Register;
+      Grt.Vpi.Register;
+      Grt.Vital_Annotate.Register;
+      Grt.Disp_Rti.Register;
+   end Register_Modules;
+end Grt.Modules;
diff --git a/src/translate/grt/grt-modules.ads b/src/translate/grt/grt-modules.ads
new file mode 100644
index 000000000..23c7d6e7a
--- /dev/null
+++ b/src/translate/grt/grt-modules.ads
@@ -0,0 +1,29 @@
+--  GHDL Run Time (GRT) -  Modules.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package Grt.Modules is
+   --  Register optional modules.
+   procedure Register_Modules;
+end Grt.Modules;
diff --git a/src/translate/grt/grt-names.adb b/src/translate/grt/grt-names.adb
new file mode 100644
index 000000000..e7928f75c
--- /dev/null
+++ b/src/translate/grt/grt-names.adb
@@ -0,0 +1,105 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+--with Grt.Errors; use Grt.Errors;
+with Ada.Unchecked_Conversion;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Processes; use Grt.Processes;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Vstrings; use Grt.Vstrings;
+
+package body Grt.Names is
+   function To_Str_String_Boundp is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Boundp);
+
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => String_Ptr, Target => Std_String_Basep);
+
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Basep);
+
+   procedure Get_Name (Res : Std_String_Ptr;
+                       Ctxt : Rti_Context;
+                       Name : Ghdl_Str_Len_Ptr;
+                       Is_Path : Boolean)
+   is
+      procedure Memcpy (Dst : Address; Src : Address; Len : Integer);
+      pragma Import (C, Memcpy);
+
+      Bounds : Std_String_Boundp;
+      Len : Natural;
+
+      Rstr : Rstring;
+      R_Len : Natural;
+   begin
+      if Ctxt.Block /= null then
+         Prepend (Rstr, ':');
+         Get_Path_Name (Rstr, Ctxt, ':', not Is_Path);
+         R_Len := Length (Rstr);
+         Len := R_Len + Name.Len;
+      else
+         Len := Name.Len;
+      end if;
+
+      Bounds := To_Str_String_Boundp
+        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      Bounds.Dim_1.Left := 1;
+      Bounds.Dim_1.Right := Ghdl_I32 (Len);
+      Bounds.Dim_1.Dir := Dir_To;
+      Bounds.Dim_1.Length := Ghdl_Index_Type (Len);
+      Res.Bounds := Bounds;
+      if Ctxt.Block /= null then
+         Res.Base := To_Std_String_Basep
+           (Ghdl_Stack2_Allocate (Ghdl_Index_Type (Len)));
+         Memcpy (Res.Base (0)'Address, Get_Address (Rstr), R_Len);
+         Memcpy (Res.Base (Ghdl_Index_Type (R_Len))'Address,
+                 Name.Str (1)'Address,
+                 Name.Len);
+         Free (Rstr);
+      else
+         Res.Base := To_Std_String_Basep (Name.Str);
+      end if;
+   end Get_Name;
+
+   procedure Ghdl_Get_Path_Name (Res : Std_String_Ptr;
+                                 Ctxt : Ghdl_Rti_Access;
+                                 Base : Address;
+                                 Name : Ghdl_Str_Len_Ptr)
+   is
+   begin
+      Get_Name (Res, (Base, Ctxt), Name, True);
+   end Ghdl_Get_Path_Name;
+
+   procedure Ghdl_Get_Instance_Name (Res : Std_String_Ptr;
+                                     Ctxt : Ghdl_Rti_Access;
+                                     Base : Address;
+                                     Name : Ghdl_Str_Len_Ptr)
+   is
+   begin
+      Get_Name (Res, (Base, Ctxt), Name, False);
+   end Ghdl_Get_Instance_Name;
+
+end Grt.Names;
diff --git a/src/translate/grt/grt-names.ads b/src/translate/grt/grt-names.ads
new file mode 100644
index 000000000..e0c284231
--- /dev/null
+++ b/src/translate/grt/grt-names.ads
@@ -0,0 +1,42 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Names is
+   procedure Ghdl_Get_Path_Name (Res : Std_String_Ptr;
+                                 Ctxt : Ghdl_Rti_Access;
+                                 Base : Address;
+                                 Name : Ghdl_Str_Len_Ptr);
+
+   procedure Ghdl_Get_Instance_Name (Res : Std_String_Ptr;
+                                     Ctxt : Ghdl_Rti_Access;
+                                     Base : Address;
+                                     Name : Ghdl_Str_Len_Ptr);
+private
+   pragma Export (C, Ghdl_Get_Path_Name, "__ghdl_get_path_name");
+   pragma Export (C, Ghdl_Get_Instance_Name, "__ghdl_get_instance_name");
+end Grt.Names;
diff --git a/src/translate/grt/grt-options.adb b/src/translate/grt/grt-options.adb
new file mode 100644
index 000000000..df1eb4ec8
--- /dev/null
+++ b/src/translate/grt/grt-options.adb
@@ -0,0 +1,507 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Interfaces; use Interfaces;
+with Grt.Errors; use Grt.Errors;
+with Grt.Astdio;
+with Grt.Hooks;
+
+package body Grt.Options is
+
+   Std_Standard_Time_Fs : Std_Time;
+   Std_Standard_Time_Ps : Std_Time;
+   Std_Standard_Time_Ns : Std_Time;
+   Std_Standard_Time_Us : Std_Time;
+   Std_Standard_Time_Ms : Std_Time;
+   Std_Standard_Time_Sec : Std_Time;
+   Std_Standard_Time_Min : Std_Time;
+   Std_Standard_Time_Hr : Std_Time;
+   pragma Export (C, Std_Standard_Time_Fs, "std__standard__time__BT__fs");
+   pragma Weak_External (Std_Standard_Time_Fs);
+   pragma Export (C, Std_Standard_Time_Ps, "std__standard__time__BT__ps");
+   pragma Weak_External (Std_Standard_Time_Ps);
+   pragma Export (C, Std_Standard_Time_Ns, "std__standard__time__BT__ns");
+   pragma Weak_External (Std_Standard_Time_Ns);
+   pragma Export (C, Std_Standard_Time_Us, "std__standard__time__BT__us");
+   pragma Weak_External (Std_Standard_Time_Us);
+   pragma Export (C, Std_Standard_Time_Ms, "std__standard__time__BT__ms");
+   pragma Weak_External (Std_Standard_Time_Ms);
+   pragma Export (C, Std_Standard_Time_Sec, "std__standard__time__BT__sec");
+   pragma Weak_External (Std_Standard_Time_Sec);
+   pragma Export (C, Std_Standard_Time_Min, "std__standard__time__BT__min");
+   pragma Weak_External (Std_Standard_Time_Min);
+   pragma Export (C, Std_Standard_Time_Hr, "std__standard__time__BT__hr");
+   pragma Weak_External (Std_Standard_Time_Hr);
+
+   procedure Set_Time_Resolution (Res : Character)
+   is
+   begin
+      Std_Standard_Time_Hr := 0;
+      case Res is
+         when 'f' =>
+            Std_Standard_Time_Fs := 1;
+            Std_Standard_Time_Ps := 1000;
+            Std_Standard_Time_Ns := 1000_000;
+            Std_Standard_Time_Us := 1000_000_000;
+            Std_Standard_Time_Ms := Std_Time'Last;
+            Std_Standard_Time_Sec := Std_Time'Last;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'p' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 1;
+            Std_Standard_Time_Ns := 1000;
+            Std_Standard_Time_Us := 1000_000;
+            Std_Standard_Time_Ms := 1000_000_000;
+            Std_Standard_Time_Sec := Std_Time'Last;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'n' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 1;
+            Std_Standard_Time_Us := 1000;
+            Std_Standard_Time_Ms := 1000_000;
+            Std_Standard_Time_Sec := 1000_000_000;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'u' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 1;
+            Std_Standard_Time_Ms := 1000;
+            Std_Standard_Time_Sec := 1000_000;
+            Std_Standard_Time_Min := 60_000_000;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'm' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 1;
+            Std_Standard_Time_Sec := 1000;
+            Std_Standard_Time_Min := 60_000;
+            Std_Standard_Time_Hr := 3600_000;
+         when 's' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 1;
+            Std_Standard_Time_Min := 60;
+            Std_Standard_Time_Hr := 3600;
+         when 'M' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 0;
+            Std_Standard_Time_Min := 1;
+            Std_Standard_Time_Hr := 60;
+         when 'h' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 0;
+            Std_Standard_Time_Min := 0;
+            Std_Standard_Time_Hr := 1;
+         when others =>
+            Error ("bad time resolution");
+      end case;
+   end Set_Time_Resolution;
+
+   procedure Help
+   is
+      use Grt.Astdio;
+      procedure P (Str : String) renames Put_Line;
+      Prog_Name : Ghdl_C_String;
+   begin
+      if Argc > 0 then
+         Prog_Name := Argv (0);
+         Put ("Usage: ");
+         Put (Prog_Name (1 .. strlen (Prog_Name)));
+         Put (" [OPTIONS]");
+         New_Line;
+      end if;
+
+      P ("Options are:");
+      P (" --help, -h        disp this help");
+      P (" --assert-level=LEVEL   stop simulation if assert at LEVEL");
+      P ("       LEVEL is note,warning,error,failure,none");
+      P (" --ieee-asserts=POLICY  enable or disable asserts from IEEE");
+      P ("       POLICY is enable,disable,disable-at-0");
+      P (" --stop-time=X     stop the simulation at time X");
+      P ("       X is expressed as a time value, without spaces: 1ns, ps...");
+      P (" --stop-delta=X    stop the simulation cycle after X delta");
+      P (" --expect-failure  invert exit status");
+      P (" --stack-size=X    set the stack size of non-sensitized processes");
+      P (" --stack-max-size=X  set the maximum stack size");
+      P (" --no-run          do not simulate, only elaborate");
+      --  P (" --threads=N       use N threads for simulation");
+      Grt.Hooks.Call_Help_Hooks;
+      P ("trace options:");
+      P (" --disp-time       disp time as simulation advances");
+      P (" --trace-signals   disp signals after each cycle");
+      P (" --trace-processes disp process name before each cycle");
+      P (" --stats           display run-time statistics");
+      P ("debug options:");
+      P (" --disp-order      disp signals order");
+      P (" --disp-sources    disp sources while displaying signals");
+      P (" --disp-sig-types  disp signal types");
+      P (" --disp-signals-map    disp map bw declared sigs and internal sigs");
+      P (" --disp-signals-table  disp internal signals");
+      P (" --checks          do internal checks after each process run");
+      P (" --activity=LEVEL  watch activity of LEVEL signals");
+      P ("       LEVEL is all, min (default) or none (unsafe)");
+   end Help;
+
+   --  Extract from STR a number.
+   --  First, all leading blanks are skipped.
+   --  Then, all next digits are eaten.
+   --  The position of the first non digit or one past the upper bound is
+   --  returned into POS.
+   --  If there is no digits, OK is set to false, else to true.
+   procedure Extract_Integer
+     (Str : String;
+      Ok : out Boolean;
+      Result : out Integer_64;
+      Pos : out Natural)
+   is
+   begin
+      Pos := Str'First;
+      --  Skip blanks.
+      while Pos <= Str'Last and then Str (Pos) = ' ' loop
+         Pos := Pos + 1;
+      end loop;
+      Ok := False;
+      Result := 0;
+      loop
+         exit when Pos > Str'Last or else Str (Pos) not in '0' .. '9';
+         Ok := True;
+         Result := Result * 10
+           + (Character'Pos (Str (Pos)) - Character'Pos ('0'));
+         Pos := Pos + 1;
+      end loop;
+   end Extract_Integer;
+
+   function Extract_Size (Str : String; Option_Name : String) return Natural
+   is
+      Ok : Boolean;
+      Val : Integer_64;
+      Pos : Natural;
+   begin
+      Extract_Integer (Str, Ok, Val, Pos);
+      if not Ok then
+         Val := 1;
+      end if;
+      if Pos > Str'Last then
+         --  No suffix.
+         if Val > Integer_64(Natural'Last) then
+            Error_C ("Size exceeds limit for option ");
+            Error_E (Option_Name);
+         else
+            return Natural (Val);
+         end if;
+      end if;
+      if Pos = Str'Last
+        or else (Pos + 1 = Str'Last
+                 and then (Str (Pos + 1) = 'b' or Str (Pos + 1) = 'o'))
+      then
+         if Str (Pos) = 'k' or Str (Pos) = 'K' then
+            return Natural (Val) * 1024;
+         elsif Str (Pos) = 'm' or Str (Pos) = 'M' then
+            return Natural (Val) * 1024 * 1024;
+         end if;
+      end if;
+      Error_C ("bad memory unit for option ");
+      Error_E (Option_Name);
+   end Extract_Size;
+
+   function To_Lower (C : Character) return Character is
+   begin
+      if C in 'A' .. 'Z' then
+         return Character'Val (Character'Pos (C) + 32);
+      else
+         return C;
+      end if;
+   end To_Lower;
+
+   procedure Decode_Option
+     (Option : String; Status : out Decode_Option_Status)
+   is
+      pragma Assert (Option'First = 1);
+      Len : constant Natural := Option'Last;
+   begin
+      Status := Decode_Option_Ok;
+      if Option = "--" then
+         Status := Decode_Option_Last;
+      elsif Option = "--help" or else Option = "-h" then
+         Help;
+         Status := Decode_Option_Help;
+      elsif Option = "--disp-time" then
+         Disp_Time := True;
+      elsif Option = "--trace-signals" then
+         Trace_Signals := True;
+         Disp_Time := True;
+      elsif Option = "--trace-processes" then
+         Trace_Processes := True;
+         Disp_Time := True;
+      elsif Option = "--disp-order" then
+         Disp_Signals_Order := True;
+      elsif Option = "--checks" then
+         Checks := True;
+      elsif Option = "--disp-sources" then
+         Disp_Sources := True;
+      elsif Option = "--disp-sig-types" then
+         Disp_Sig_Types := True;
+      elsif Option = "--disp-signals-map" then
+         Disp_Signals_Map := True;
+      elsif Option = "--disp-signals-table" then
+         Disp_Signals_Table := True;
+      elsif Option = "--disp-sensitivity" then
+         Disp_Sensitivity := True;
+      elsif Option = "--stats" then
+         Flag_Stats := True;
+      elsif Option = "--no-run" then
+         Flag_No_Run := True;
+      elsif Len > 18 and then Option (1 .. 18) = "--time-resolution=" then
+         declare
+            Res : Character;
+            Unit : String (1 .. 3);
+         begin
+            Res := '?';
+            if Len >= 20 then
+               Unit (1) := To_Lower (Option (19));
+               Unit (2) := To_Lower (Option (20));
+               if Len = 20 then
+                  if Unit (1 .. 2) = "fs" then
+                     Res := 'f';
+                  elsif Unit (1 .. 2) = "ps" then
+                     Res := 'p';
+                  elsif Unit (1 .. 2) = "ns" then
+                     Res := 'n';
+                  elsif Unit (1 .. 2) = "us" then
+                     Res := 'u';
+                  elsif Unit (1 .. 2) = "ms" then
+                     Res := 'm';
+                  elsif Unit (1 .. 2) = "hr" then
+                     Res := 'h';
+                  end if;
+               elsif Len = 21 then
+                  Unit (3) := To_Lower (Option (21));
+                  if Unit = "min" then
+                     Res := 'M';
+                  elsif Unit = "sec" then
+                     Res := 's';
+                  end if;
+               end if;
+            end if;
+            if Res = '?' then
+               Error_C ("bad unit for '");
+               Error_C (Option);
+               Error_E ("'");
+            else
+               if Flag_String (5) = '-' then
+                  Error ("time resolution is ignored");
+               elsif Flag_String (5) = '?' then
+                  if Stop_Time /= Std_Time'Last then
+                     Error ("time resolution must be set "
+                              & "before --stop-time");
+                  else
+                     Set_Time_Resolution (Res);
+                  end if;
+               elsif Flag_String (5) /= Res then
+                  Error ("time resolution is fixed during analysis");
+               end if;
+            end if;
+         end;
+      elsif Len > 12 and then Option (1 .. 12) = "--stop-time=" then
+         declare
+            Ok : Boolean;
+            Pos : Natural;
+            Time : Integer_64;
+            Unit : String (1 .. 3);
+         begin
+            Extract_Integer (Option (13 .. Len), Ok, Time, Pos);
+            if not Ok then
+               Time := 1;
+            end if;
+            if (Len - Pos + 1) not in 2 .. 3 then
+               Error_C ("bad unit for '");
+               Error_C (Option);
+               Error_E ("'");
+               return;
+            end if;
+            Unit (1) := To_Lower (Option (Pos));
+            Unit (2) := To_Lower (Option (Pos + 1));
+            if Len = Pos + 2 then
+               Unit (3) := To_Lower (Option (Pos + 2));
+            else
+               Unit (3) := ' ';
+            end if;
+            if Unit = "fs " then
+               null;
+            elsif Unit = "ps " then
+               Time := Time * (10 ** 3);
+            elsif Unit = "ns " then
+               Time := Time * (10 ** 6);
+            elsif Unit = "us " then
+               Time := Time * (10 ** 9);
+            elsif Unit = "ms " then
+               Time := Time * (10 ** 12);
+            elsif Unit = "sec" then
+               Time := Time * (10 ** 15);
+            elsif Unit = "min" then
+               Time := Time * (10 ** 15) * 60;
+            elsif Unit = "hr " then
+               Time := Time * (10 ** 15) * 3600;
+            else
+               Error_C ("bad unit name for '");
+               Error_C (Option);
+               Error_E ("'");
+            end if;
+            Stop_Time := Std_Time (Time);
+         end;
+      elsif Len > 13 and then Option (1 .. 13) = "--stop-delta=" then
+         declare
+            Ok : Boolean;
+            Pos : Natural;
+            Time : Integer_64;
+         begin
+            Extract_Integer (Option (14 .. Len), Ok, Time, Pos);
+            if not Ok or else Pos <= Len then
+               Error_C ("bad value in '");
+               Error_C (Option);
+               Error_E ("'");
+            else
+               if Time > Integer_64 (Integer'Last) then
+                  Stop_Delta := Integer'Last;
+               else
+                  Stop_Delta := Integer (Time);
+               end if;
+            end if;
+         end;
+      elsif Len > 15 and then Option (1 .. 15) = "--assert-level=" then
+         if Option (16 .. Len) = "note" then
+            Severity_Level := Note_Severity;
+         elsif Option (16 .. Len) = "warning" then
+            Severity_Level := Warning_Severity;
+         elsif Option (16 .. Len) = "error" then
+            Severity_Level := Error_Severity;
+         elsif Option (16 .. Len) = "failure" then
+            Severity_Level := Failure_Severity;
+         elsif Option (16 .. Len) = "none" then
+            Severity_Level := 4;
+         else
+            Error ("bad argument for --assert-level option, try --help");
+         end if;
+      elsif Len > 15 and then Option (1 .. 15) = "--ieee-asserts=" then
+         if Option (16 .. Len) = "disable" then
+            Ieee_Asserts := Disable_Asserts;
+         elsif Option (16 .. Len) = "enable" then
+            Ieee_Asserts := Enable_Asserts;
+         elsif Option (16 .. Len) = "disable-at-0" then
+            Ieee_Asserts := Disable_Asserts_At_Time_0;
+         else
+            Error ("bad argument for --ieee-asserts option, try --help");
+         end if;
+      elsif Option = "--expect-failure" then
+         Expect_Failure := True;
+      elsif Len >= 13 and then Option (1 .. 13) = "--stack-size=" then
+         Stack_Size := Extract_Size
+           (Option (14 .. Len), "--stack-size");
+         if Stack_Size > Stack_Max_Size then
+            Stack_Max_Size := Stack_Size;
+         end if;
+      elsif Len >= 17 and then Option (1 .. 17) = "--stack-max-size=" then
+         Stack_Max_Size := Extract_Size
+           (Option (18 .. Len), "--stack-size");
+         if Stack_Size > Stack_Max_Size then
+            Stack_Size := Stack_Max_Size;
+         end if;
+      elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then
+         if Option (12 .. Len) = "none" then
+            Flag_Activity := Activity_None;
+         elsif Option (12 .. Len) = "min" then
+            Flag_Activity := Activity_Minimal;
+         elsif Option (12 .. Len) = "all" then
+            Flag_Activity := Activity_All;
+         else
+            Error ("bad argument for --activity, try --help");
+         end if;
+      elsif Len > 10 and then Option (1 .. 10) = "--threads=" then
+         declare
+            Ok : Boolean;
+            Pos : Natural;
+            Val : Integer_64;
+         begin
+            Extract_Integer (Option (11 .. Len), Ok, Val, Pos);
+            if not Ok or else Pos <= Len then
+               Error_C ("bad value in '");
+               Error_C (Option);
+               Error_E ("'");
+            else
+               Nbr_Threads := Integer (Val);
+            end if;
+         end;
+      elsif not Grt.Hooks.Call_Option_Hooks (Option) then
+         Error_C ("unknown option '");
+         Error_C (Option);
+         Error_E ("', try --help");
+      end if;
+   end Decode_Option;
+
+   procedure Decode (Stop : out Boolean)
+   is
+      Arg : Ghdl_C_String;
+      Len : Natural;
+      Status : Decode_Option_Status;
+   begin
+      Stop := False;
+      Last_Opt := Argc - 1;
+      for I in 1 .. Argc - 1 loop
+         Arg := Argv (I);
+         Len := strlen (Arg);
+         declare
+            Argument : constant String := Arg (1 .. Len);
+         begin
+            Decode_Option (Argument, Status);
+            case Status is
+               when Decode_Option_Last =>
+                  Last_Opt := I;
+                  exit;
+               when Decode_Option_Help =>
+                  Stop := True;
+               when Decode_Option_Ok =>
+                  null;
+            end case;
+         end;
+      end loop;
+   end Decode;
+end Grt.Options;
diff --git a/src/translate/grt/grt-options.ads b/src/translate/grt/grt-options.ads
new file mode 100644
index 000000000..88b1f5084
--- /dev/null
+++ b/src/translate/grt/grt-options.ads
@@ -0,0 +1,154 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Lib; use Grt.Lib;
+
+package Grt.Options is
+   pragma Preelaborate (Grt.Options);
+
+   --  Name of the program, set by argv[0].
+   --  Must be set before calling DECODE.
+   Progname : Ghdl_C_String;
+
+   --  Arguments.
+   --  This mimics argc/argv of 'main'.
+   --  These must be set before calling DECODE.
+   Argc : Integer;
+
+   type Argv_Array_Type is array (Natural) of Ghdl_C_String;
+   type Argv_Type is access Argv_Array_Type;
+
+   Argv : Argv_Type;
+
+   --  Last option decoded.
+   --  Following arguments are reserved for the program.
+   Last_Opt : Integer;
+
+   --  Consistent flags used for analysis.
+   --  Format is "VVitr", where:
+   --    'VV' is the version (87, 93 or 08).
+   --    'i' is the integer size ('i' for 32 bits, 'I' for 64 bits).
+   --    't' is the time size ('t' for 32 bits, 'T' for 64 bits).
+   --    'r' is the resolution ('?' for to be set by the user, '-' for any).
+   Flag_String : constant String (1 .. 5);
+   pragma Import (C, Flag_String, "__ghdl_flag_string");
+
+   --  Display options help.
+   --  Should not be called directly.
+   procedure Help;
+
+   --  Status from Decode_Option.
+   type Decode_Option_Status is
+     (
+      --  Last option, next arguments aren't options.
+      Decode_Option_Last,
+
+      --  --help option, program shouldn't run.
+      Decode_Option_Help,
+
+      --  Option was successfuly decoded.
+      Decode_Option_Ok);
+
+   --  Decode option Option and set Status.
+   procedure Decode_Option
+     (Option : String; Status : out Decode_Option_Status);
+
+   --  Decode command line options.
+   --  If STOP is true, there nothing must happen (set by --help).
+   procedure Decode (Stop : out Boolean);
+
+   --  Set by --disp-time (and --trace-signals, --trace-processes) to display
+   --  time and deltas.
+   Disp_Time : Boolean := False;
+
+   --  Set by --trace-signals, to display signals after each cycle.
+   Trace_Signals : Boolean := False;
+
+   --  Set by --trace-processes, to display process name before being run.
+   Trace_Processes : Boolean := False;
+
+   --  Set by --disp-sig-types, to display signals and they types.
+   Disp_Sig_Types : Boolean := False;
+
+   Disp_Sources : Boolean := False;
+   Disp_Signals_Map : Boolean := False;
+   Disp_Signals_Table : Boolean := False;
+   Disp_Sensitivity : Boolean := False;
+
+   --  Set by --disp-order to diplay evaluation order of signals.
+   Disp_Signals_Order : Boolean := False;
+
+   --  Set by --stats to display statistics.
+   Flag_Stats : Boolean := False;
+
+   --  Set by --checks to do internal checks.
+   Checks : Boolean := False;
+
+   --  Level at which an assert stop the simulation.
+   Severity_Level : Integer := Failure_Severity;
+
+   --  How assertions are handled.
+   type Assert_Handling is
+     (Enable_Asserts,
+      Disable_Asserts_At_Time_0,
+      Disable_Asserts);
+
+   --  Handling of assertions from IEEE library.
+   Ieee_Asserts : Assert_Handling := Enable_Asserts;
+
+   --  Set by --stop-time=XXX to stop the simulation at or just after XXX.
+   --  (unit is fs in fact).
+   Stop_Time : Std_Time := Std_Time'Last;
+
+   --  Set by --stop-delta=XXX to stop the simulation after XXX delta cycles.
+   Stop_Delta : Natural := 5000;
+
+   --  The default stack size for non-sensitized processes.
+   Stack_Size : Natural := 8 * 1024;
+
+   --  The maximum stack size for non-sensitized processes.
+   Stack_Max_Size : Natural := 128 * 1024;
+
+   --  Set by --no-run
+   --  If set, do not simulate, only elaborate.
+   Flag_No_Run : Boolean := False;
+
+   type Activity_Mode is (Activity_All, Activity_Minimal, Activity_None);
+   Flag_Activity : Activity_Mode := Activity_Minimal;
+
+   --  Set by --thread=
+   --  Number of threads used to do the simulation.
+   --  1 mean no additionnal threads, 0 means as many threads as number of
+   --  CPUs.
+   Nbr_Threads : Natural := 1;
+
+   --  Set the time resolution.
+   --  Only call this subprogram if you are allowed to set the time resolution.
+   procedure Set_Time_Resolution (Res : Character);
+private
+   pragma Export (C, Stack_Size);
+   pragma Export (C, Stack_Max_Size);
+   pragma Export (C, Nbr_Threads, "grt_nbr_threads");
+end Grt.Options;
diff --git a/src/translate/grt/grt-processes.adb b/src/translate/grt/grt-processes.adb
new file mode 100644
index 000000000..64db682e2
--- /dev/null
+++ b/src/translate/grt/grt-processes.adb
@@ -0,0 +1,1042 @@
+--  GHDL Run Time (GRT) -  processes.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Table;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Disp;
+with Grt.Astdio;
+with Grt.Errors; use Grt.Errors;
+with Grt.Options;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Stats;
+with Grt.Threads; use Grt.Threads;
+pragma Elaborate_All (Grt.Table);
+
+package body Grt.Processes is
+   Last_Time : constant Std_Time := Std_Time'Last;
+
+   --  Identifier for a process.
+   type Process_Id is new Integer;
+
+   --  Table of processes.
+   package Process_Table is new Grt.Table
+     (Table_Component_Type => Process_Acc,
+      Table_Index_Type => Process_Id,
+      Table_Low_Bound => 1,
+      Table_Initial => 16);
+
+   type Finalizer_Type is record
+      --  Subprogram containing process code.
+      Subprg : Proc_Acc;
+
+      --  Instance (THIS parameter) for the subprogram.
+      This : Instance_Acc;
+   end record;
+
+   --  List of finalizer.
+   package Finalizer_Table is new Grt.Table
+     (Table_Component_Type => Finalizer_Type,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 2);
+
+   --  List of processes to be resume at next cycle.
+   type Process_Acc_Array is array (Natural range <>) of Process_Acc;
+   type Process_Acc_Array_Acc is access Process_Acc_Array;
+
+   Resume_Process_Table : Process_Acc_Array_Acc;
+   Last_Resume_Process : Natural := 0;
+   Postponed_Resume_Process_Table : Process_Acc_Array_Acc;
+   Last_Postponed_Resume_Process : Natural := 0;
+
+   --  Number of postponed processes.
+   Nbr_Postponed_Processes : Natural := 0;
+   Nbr_Non_Postponed_Processes : Natural := 0;
+
+   --  Number of resumed processes.
+   Nbr_Resumed_Processes : Natural := 0;
+
+   --  Earliest time out within non-sensitized processes.
+   Process_First_Timeout : Std_Time := Last_Time;
+   Process_Timeout_Chain : Process_Acc := null;
+
+   procedure Init is
+   begin
+      null;
+   end Init;
+
+   function Get_Nbr_Processes return Natural is
+   begin
+      return Natural (Process_Table.Last);
+   end Get_Nbr_Processes;
+
+   function Get_Nbr_Sensitized_Processes return Natural
+   is
+      Res : Natural := 0;
+   begin
+      for I in Process_Table.First .. Process_Table.Last loop
+         if Process_Table.Table (I).State = State_Sensitized then
+            Res := Res + 1;
+         end if;
+      end loop;
+      return Res;
+   end Get_Nbr_Sensitized_Processes;
+
+   function Get_Nbr_Resumed_Processes return Natural is
+   begin
+      return Nbr_Resumed_Processes;
+   end Get_Nbr_Resumed_Processes;
+
+   procedure Process_Register (This : Instance_Acc;
+                               Proc : Proc_Acc;
+                               Ctxt : Rti_Context;
+                               State : Process_State;
+                               Postponed : Boolean)
+   is
+      Stack : Stack_Type;
+      P : Process_Acc;
+   begin
+      if State /= State_Sensitized and then not One_Stack then
+         Stack := Stack_Create (Proc, This);
+         if Stack = Null_Stack then
+            Internal_Error ("cannot allocate stack: memory exhausted");
+         end if;
+      else
+         Stack := Null_Stack;
+      end if;
+      P := new Process_Type'(Subprg => Proc,
+                             This => This,
+                             Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => Postponed,
+                             State => State,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Stack => Stack);
+      Process_Table.Append (P);
+      --  Used to create drivers.
+      Set_Current_Process (P);
+      if Postponed then
+         Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
+      else
+         Nbr_Non_Postponed_Processes := Nbr_Non_Postponed_Processes + 1;
+      end if;
+   end Process_Register;
+
+   procedure Ghdl_Process_Register
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, False);
+   end Ghdl_Process_Register;
+
+   procedure Ghdl_Sensitized_Process_Register
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Sensitized, False);
+   end Ghdl_Sensitized_Process_Register;
+
+   procedure Ghdl_Postponed_Process_Register
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, True);
+   end Ghdl_Postponed_Process_Register;
+
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Sensitized, True);
+   end Ghdl_Postponed_Sensitized_Process_Register;
+
+   procedure Verilog_Process_Register (This : Instance_Acc;
+                                       Proc : Proc_Acc;
+                                       Ctxt : Rti_Context)
+   is
+      P : Process_Acc;
+   begin
+      P := new Process_Type'(Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => False,
+                             State => State_Sensitized,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Subprg => Proc,
+                             This => This,
+                             Stack => Null_Stack);
+      Process_Table.Append (P);
+      --  Used to create drivers.
+      Set_Current_Process (P);
+   end Verilog_Process_Register;
+
+   procedure Ghdl_Initial_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc)
+   is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+   end Ghdl_Initial_Register;
+
+   procedure Ghdl_Always_Register (Instance : Instance_Acc;
+                                   Proc : Proc_Acc)
+   is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+   end Ghdl_Always_Register;
+
+   procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Resume_Process_If_Event
+        (Sig, Process_Table.Table (Process_Table.Last));
+   end Ghdl_Process_Add_Sensitivity;
+
+   procedure Ghdl_Finalize_Register (Instance : Instance_Acc;
+                                     Proc : Proc_Acc)
+   is
+   begin
+      Finalizer_Table.Append (Finalizer_Type'(Proc, Instance));
+   end Ghdl_Finalize_Register;
+
+   procedure Call_Finalizers is
+      El : Finalizer_Type;
+   begin
+      for I in Finalizer_Table.First .. Finalizer_Table.Last loop
+         El := Finalizer_Table.Table (I);
+         El.Subprg.all (El.This);
+      end loop;
+   end Call_Finalizers;
+
+   procedure Resume_Process (Proc : Process_Acc)
+   is
+   begin
+      if not Proc.Resumed then
+         Proc.Resumed := True;
+         if Proc.Postponed then
+            Last_Postponed_Resume_Process := Last_Postponed_Resume_Process + 1;
+            Postponed_Resume_Process_Table (Last_Postponed_Resume_Process)
+              := Proc;
+         else
+            Last_Resume_Process := Last_Resume_Process + 1;
+            Resume_Process_Table (Last_Resume_Process) := Proc;
+         end if;
+      end if;
+   end Resume_Process;
+
+   function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
+     return System.Address
+   is
+   begin
+      return Grt.Stack2.Allocate (Get_Stack2, Size);
+   end Ghdl_Stack2_Allocate;
+
+   function Ghdl_Stack2_Mark return Mark_Id
+   is
+      St2 : Stack2_Ptr := Get_Stack2;
+   begin
+      if St2 = Null_Stack2_Ptr then
+         St2 := Grt.Stack2.Create;
+         Set_Stack2 (St2);
+      end if;
+      return Grt.Stack2.Mark (St2);
+   end Ghdl_Stack2_Mark;
+
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
+   begin
+      Grt.Stack2.Release (Get_Stack2, Mark);
+   end Ghdl_Stack2_Release;
+
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+      El : Action_List_Acc;
+   begin
+      El := new Action_List'(Dynamic => True,
+                             Next => Sig.Event_List,
+                             Proc => Proc,
+                             Prev => null,
+                             Sig => Sig,
+                             Chain => Proc.Sensitivity);
+      if Sig.Event_List /= null and then Sig.Event_List.Dynamic then
+         Sig.Event_List.Prev := El;
+      end if;
+      Sig.Event_List := El;
+      Proc.Sensitivity := El;
+   end Ghdl_Process_Wait_Add_Sensitivity;
+
+   procedure Update_Process_First_Timeout (Proc : Process_Acc) is
+   begin
+      if Proc.Timeout < Process_First_Timeout then
+         Process_First_Timeout := Proc.Timeout;
+      end if;
+      Proc.Timeout_Chain_Next := Process_Timeout_Chain;
+      Proc.Timeout_Chain_Prev := null;
+      if Process_Timeout_Chain /= null then
+         Process_Timeout_Chain.Timeout_Chain_Prev := Proc;
+      end if;
+      Process_Timeout_Chain := Proc;
+   end Update_Process_First_Timeout;
+
+   procedure Remove_Process_From_Timeout_Chain (Proc : Process_Acc) is
+   begin
+      --  Remove Proc from the timeout list.
+      if Proc.Timeout_Chain_Prev /= null then
+         Proc.Timeout_Chain_Prev.Timeout_Chain_Next :=
+           Proc.Timeout_Chain_Next;
+      elsif Process_Timeout_Chain = Proc then
+         --  Only if Proc is in the chain.
+         Process_Timeout_Chain := Proc.Timeout_Chain_Next;
+      end if;
+      if Proc.Timeout_Chain_Next /= null then
+         Proc.Timeout_Chain_Next.Timeout_Chain_Prev :=
+           Proc.Timeout_Chain_Prev;
+         Proc.Timeout_Chain_Next := null;
+      end if;
+      --  Be sure a second call won't corrupt the chain.
+      Proc.Timeout_Chain_Prev := null;
+   end Remove_Process_From_Timeout_Chain;
+
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      if Time < 0 then
+         --  LRM93 8.1
+         Error ("negative timeout clause");
+      end if;
+      Proc.Timeout := Current_Time + Time;
+      Update_Process_First_Timeout (Proc);
+   end Ghdl_Process_Wait_Set_Timeout;
+
+   function Ghdl_Process_Wait_Has_Timeout return Boolean
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      -- Note: in case of timeout, the timeout is removed when process is
+      -- woken up.
+      return Proc.State = State_Timeout;
+   end Ghdl_Process_Wait_Has_Timeout;
+
+   procedure Ghdl_Process_Wait_Wait
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      if Proc.State = State_Sensitized then
+         Error ("wait statement in a sensitized process");
+      end if;
+      --  Suspend this process.
+      Proc.State := State_Wait;
+--       if Cur_Proc.Timeout = Bad_Time then
+--          Cur_Proc.Timeout := Std_Time'Last;
+--       end if;
+   end Ghdl_Process_Wait_Wait;
+
+   function Ghdl_Process_Wait_Suspend return Boolean
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      Ghdl_Process_Wait_Wait;
+      if One_Stack then
+         Internal_Error ("wait_suspend");
+      else
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
+      return Ghdl_Process_Wait_Has_Timeout;
+   end Ghdl_Process_Wait_Suspend;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Action_List, Action_List_Acc);
+
+   procedure Ghdl_Process_Wait_Close
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+      El : Action_List_Acc;
+      N_El : Action_List_Acc;
+   begin
+      --  Remove the sensitivity.
+      El := Proc.Sensitivity;
+      Proc.Sensitivity := null;
+      while El /= null loop
+         pragma Assert (El.Proc = Get_Current_Process);
+         if El.Prev = null then
+            El.Sig.Event_List := El.Next;
+         else
+            pragma Assert (El.Prev.Dynamic);
+            El.Prev.Next := El.Next;
+         end if;
+         if El.Next /= null and then El.Next.Dynamic then
+            El.Next.Prev := El.Prev;
+         end if;
+         N_El := El.Chain;
+         Free (El);
+         El := N_El;
+      end loop;
+
+      --  Remove Proc from the timeout list.
+      Remove_Process_From_Timeout_Chain (Proc);
+
+      --  This is necessary when the process has been woken-up by an event
+      --  before the timeout triggers.
+      if Process_First_Timeout = Proc.Timeout then
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+
+         declare
+            Next_Timeout : Std_Time;
+            P : Process_Acc;
+         begin
+            Next_Timeout := Last_Time;
+            P := Process_Timeout_Chain;
+            while P /= null loop
+               case P.State is
+                  when State_Delayed
+                    | State_Wait =>
+                     if P.Timeout > 0
+                       and then P.Timeout < Next_Timeout
+                     then
+                        Next_Timeout := P.Timeout;
+                     end if;
+                  when others =>
+                     null;
+               end case;
+               P := P.Timeout_Chain_Next;
+            end loop;
+            Process_First_Timeout := Next_Timeout;
+         end;
+      else
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+      end if;
+      Proc.State := State_Ready;
+   end Ghdl_Process_Wait_Close;
+
+   procedure Ghdl_Process_Wait_Exit
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      if Proc.State = State_Sensitized then
+         Error ("wait statement in a sensitized process");
+      end if;
+      --  Mark this process as dead, in order to kill it.
+      --  It cannot be killed now, since this code is still in the process.
+      Proc.State := State_Dead;
+
+      --  Suspend this process.
+      if not One_Stack then
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
+   end Ghdl_Process_Wait_Exit;
+
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      if Proc.State = State_Sensitized then
+         Error ("wait statement in a sensitized process");
+      end if;
+      if Time < 0 then
+         --  LRM93 8.1
+         Error ("negative timeout clause");
+      end if;
+      Proc.Timeout := Current_Time + Time;
+      Proc.State := State_Wait;
+      Update_Process_First_Timeout (Proc);
+      --  Suspend this process.
+      if One_Stack then
+         Internal_Error ("wait_timeout");
+      else
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
+      --  Clean-up.
+      Proc.Timeout := Bad_Time;
+      Remove_Process_From_Timeout_Chain (Proc);
+      Proc.State := State_Ready;
+   end Ghdl_Process_Wait_Timeout;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32)
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      Proc.Timeout := Current_Time + Std_Time (Del);
+      Proc.State := State_Delayed;
+      Update_Process_First_Timeout (Proc);
+   end Ghdl_Process_Delay;
+
+   --  Protected object lock.
+   --  Note: there is no real locks, since the kernel is single threading.
+   --  Multi lock is allowed, and rules are just checked.
+   type Object_Lock is record
+      --  The owner of the lock.
+      --  Nul_Process_Id means the lock is free.
+      Process : Process_Acc;
+      --  Number of times the lock has been acquired.
+      Count : Natural;
+   end record;
+
+   type Object_Lock_Acc is access Object_Lock;
+   type Object_Lock_Acc_Acc is access Object_Lock_Acc;
+
+   function To_Lock_Acc_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Object_Lock_Acc_Acc);
+
+   procedure Ghdl_Protected_Enter (Obj : System.Address)
+   is
+      Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process = null then
+         if Lock.Count /= 0 then
+            Internal_Error ("protected_enter");
+         end if;
+         Lock.Process := Get_Current_Process;
+         Lock.Count := 1;
+      else
+         if Lock.Process /= Get_Current_Process then
+            Internal_Error ("protected_enter(2)");
+         end if;
+         Lock.Count := Lock.Count + 1;
+      end if;
+   end Ghdl_Protected_Enter;
+
+   procedure Ghdl_Protected_Leave (Obj : System.Address)
+   is
+      Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process /= Get_Current_Process then
+         Internal_Error ("protected_leave(1)");
+      end if;
+
+      if Lock.Count = 0 then
+         Internal_Error ("protected_leave(2)");
+      end if;
+      Lock.Count := Lock.Count - 1;
+      if Lock.Count = 0 then
+         Lock.Process := null;
+      end if;
+   end Ghdl_Protected_Leave;
+
+   procedure Ghdl_Protected_Init (Obj : System.Address)
+   is
+      Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      Lock.all := new Object_Lock'(Process => null, Count => 0);
+   end Ghdl_Protected_Init;
+
+   procedure Ghdl_Protected_Fini (Obj : System.Address)
+   is
+      procedure Deallocate is new Ada.Unchecked_Deallocation
+        (Object => Object_Lock, Name => Object_Lock_Acc);
+
+      Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      if Lock.all.Count /= 0 or Lock.all.Process /= null then
+         Internal_Error ("protected_fini");
+      end if;
+      Deallocate (Lock.all);
+   end Ghdl_Protected_Fini;
+
+   function Compute_Next_Time return Std_Time
+   is
+      Res : Std_Time;
+   begin
+      --  f) The time of the next simulation cycle, Tn, is determined by
+      --     setting it to the earliest of
+      --     1) TIME'HIGH
+      Res := Std_Time'Last;
+
+      --     2) The next time at which a driver becomes active, or
+      Res := Std_Time'Min (Res, Grt.Signals.Find_Next_Time);
+
+      if Res = Current_Time then
+         return Res;
+      end if;
+
+      --     3) The next time at which a process resumes.
+      if Process_First_Timeout < Res then
+         --  No signals to be updated.
+         Grt.Signals.Flush_Active_List;
+
+         Res := Process_First_Timeout;
+      end if;
+
+      return Res;
+   end Compute_Next_Time;
+
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc)
+   is
+   begin
+      Grt.Rtis_Utils.Put (Stream, Proc.Rti);
+   end Disp_Process_Name;
+
+   procedure Disp_All_Processes
+   is
+      use Grt.Stdio;
+      use Grt.Astdio;
+   begin
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : constant Process_Acc := Process_Table.Table (I);
+         begin
+            Disp_Process_Name (stdout, Proc);
+            New_Line (stdout);
+            Put (stdout, "  State: ");
+            case Proc.State is
+               when State_Sensitized =>
+                  Put (stdout, "sensitized");
+               when State_Wait =>
+                  Put (stdout, "wait");
+                  if Proc.Timeout /= Bad_Time then
+                     Put (stdout, " until ");
+                     Put_Time (stdout, Proc.Timeout);
+                  end if;
+               when State_Ready =>
+                  Put (stdout, "ready");
+               when State_Timeout =>
+                  Put (stdout, "timeout");
+               when State_Delayed =>
+                  Put (stdout, "delayed");
+               when State_Dead =>
+                  Put (stdout, "dead");
+            end case;
+--              Put (stdout, ": time: ");
+--              Put_U64 (stdout, Proc.Stats_Time);
+--              Put (stdout, ", runs: ");
+--              Put_U32 (stdout, Proc.Stats_Run);
+            New_Line (stdout);
+         end;
+      end loop;
+   end Disp_All_Processes;
+
+   pragma Unreferenced (Disp_All_Processes);
+
+   --  Run resumed processes.
+   --  If POSTPONED is true, resume postponed processes, else resume
+   --  non-posponed processes.
+   --  Returns one of these values:
+   --  No process has been run.
+   Run_None : constant Integer := 1;
+   --  At least one process was run.
+   Run_Resumed : constant Integer := 2;
+   --  Simulation is finished.
+   Run_Finished : constant Integer := 3;
+   --  Failure, simulation should stop.
+   Run_Failure : constant Integer := -1;
+
+   Mt_Last : Natural;
+   Mt_Table : Process_Acc_Array_Acc;
+   Mt_Index : aliased Natural;
+
+   procedure Run_Processes_Threads
+   is
+      Proc : Process_Acc;
+      Idx : Natural;
+   begin
+      loop
+         --  Atomically get a process to be executed
+         Idx := Grt.Threads.Atomic_Inc (Mt_Index'Access);
+         if Idx > Mt_Last then
+            return;
+         end if;
+         Proc := Mt_Table (Idx);
+
+         if Grt.Options.Trace_Processes then
+            Grt.Astdio.Put ("run process ");
+            Disp_Process_Name (Stdio.stdout, Proc);
+            Grt.Astdio.Put (" [");
+            Grt.Astdio.Put (Stdio.stdout, To_Address (Proc.This));
+            Grt.Astdio.Put ("]");
+            Grt.Astdio.New_Line;
+         end if;
+         if not Proc.Resumed then
+            Internal_Error ("run non-resumed process");
+         end if;
+         Proc.Resumed := False;
+         Set_Current_Process (Proc);
+         if Proc.State = State_Sensitized or else One_Stack then
+            Proc.Subprg.all (Proc.This);
+         else
+            Stack_Switch (Proc.Stack, Get_Main_Stack);
+         end if;
+         if Grt.Options.Checks then
+            Ghdl_Signal_Internal_Checks;
+            Grt.Stack2.Check_Empty (Get_Stack2);
+         end if;
+      end loop;
+   end Run_Processes_Threads;
+
+   function Run_Processes (Postponed : Boolean) return Integer
+   is
+      Table : Process_Acc_Array_Acc;
+      Last : Natural;
+   begin
+      if Options.Flag_Stats then
+         Stats.Start_Processes;
+      end if;
+
+      if Postponed then
+         Table := Postponed_Resume_Process_Table;
+         Last := Last_Postponed_Resume_Process;
+         Last_Postponed_Resume_Process := 0;
+      else
+         Table := Resume_Process_Table;
+         Last := Last_Resume_Process;
+         Last_Resume_Process := 0;
+      end if;
+      Nbr_Resumed_Processes := Nbr_Resumed_Processes + Last;
+
+      if Options.Nbr_Threads = 1 then
+         for I in 1 .. Last loop
+            declare
+               Proc : constant Process_Acc := Table (I);
+            begin
+               if not Proc.Resumed then
+                  Internal_Error ("run non-resumed process");
+               end if;
+               if Grt.Options.Trace_Processes then
+                  Grt.Astdio.Put ("run process ");
+                  Disp_Process_Name (Stdio.stdout, Proc);
+                  Grt.Astdio.Put (" [");
+                  Grt.Astdio.Put (Stdio.stdout, To_Address (Proc.This));
+                  Grt.Astdio.Put ("]");
+                  Grt.Astdio.New_Line;
+               end if;
+
+               Proc.Resumed := False;
+               Set_Current_Process (Proc);
+               if Proc.State = State_Sensitized or else One_Stack then
+                  Proc.Subprg.all (Proc.This);
+               else
+                  Stack_Switch (Proc.Stack, Get_Main_Stack);
+               end if;
+               if Grt.Options.Checks then
+                  Ghdl_Signal_Internal_Checks;
+                  Grt.Stack2.Check_Empty (Get_Stack2);
+               end if;
+            end;
+         end loop;
+      else
+         Mt_Last := Last;
+         Mt_Table := Table;
+         Mt_Index := 1;
+         Threads.Run_Parallel (Run_Processes_Threads'Access);
+      end if;
+
+      if Last >= 1 then
+         return Run_Resumed;
+      else
+         return Run_None;
+      end if;
+   end Run_Processes;
+
+   function Initialization_Phase return Integer
+   is
+      Status : Integer;
+   begin
+      --  Allocate processes arrays.
+      Resume_Process_Table :=
+        new Process_Acc_Array (1 .. Nbr_Non_Postponed_Processes);
+      Postponed_Resume_Process_Table :=
+        new Process_Acc_Array (1 .. Nbr_Postponed_Processes);
+
+      --  LRM93 12.6.4
+      --  At the beginning of initialization, the current time, Tc, is assumed
+      --  to be 0 ns.
+      Current_Time := 0;
+
+      --  The initialization phase consists of the following steps:
+      --  - The driving value and the effective value of each explicitly
+      --    declared signal are computed, and the current value of the signal
+      --    is set to the effective value.  This value is assumed to have been
+      --    the value of the signal for an infinite length of time prior to
+      --    the start of the simulation.
+      Init_Signals;
+
+      --  - The value of each implicit signal of the form S'Stable(T) or
+      --    S'Quiet(T) is set to true.  The value of each implicit signal of
+      --    the form S'Delayed is set to the initial value of its prefix, S.
+      --  GHDL: already done when the signals are created.
+      null;
+
+      --  - The value of each implicit GUARD signal is set to the result of
+      --    evaluating the corresponding guard expression.
+      null;
+
+      for I in Process_Table.First .. Process_Table.Last loop
+         Resume_Process (Process_Table.Table (I));
+      end loop;
+
+      --  - Each nonpostponed process in the model is executed until it
+      --    suspends.
+      Status := Run_Processes (Postponed => False);
+      if Status = Run_Failure then
+         return Run_Failure;
+      end if;
+
+      --  - Each postponed process in the model is executed until it suspends.
+      Status := Run_Processes (Postponed => True);
+      if Status = Run_Failure then
+         return Run_Failure;
+      end if;
+
+      --  - The time of the next simulation cycle (which in this case is the
+      --    first simulation cycle), Tn, is calculated according to the rules
+      --    of step f of the simulation cycle, below.
+      Current_Time := Compute_Next_Time;
+
+      --  Clear current_delta, will be set by Simulation_Cycle.
+      Current_Delta := 0;
+
+      return Run_Resumed;
+   end Initialization_Phase;
+
+   --  Launch a simulation cycle.
+   --  Set FINISHED to true if this is the last cycle.
+   function Simulation_Cycle return Integer
+   is
+      Tn : Std_Time;
+      Status : Integer;
+   begin
+      --  LRM93 12.6.4
+      --  A simulation cycle consists of the following steps:
+      --
+      --  a) The current time, Tc is set equal to Tn.  Simulation is complete
+      --     when Tn = TIME'HIGH and there are no active drivers or process
+      --     resumptions at Tn.
+      --  GHDL: this is done at the last step of the cycle.
+      null;
+
+      --  b) Each active explicit signal in the model is updated.  (Events
+      --     may occur on signals as a result).
+      --  c) Each implicit signal in the model is updated.  (Events may occur
+      --     on signals as a result.)
+      if Options.Flag_Stats then
+         Stats.Start_Update;
+      end if;
+      Update_Signals;
+      if Options.Flag_Stats then
+         Stats.Start_Resume;
+      end if;
+
+      --  d) For each process P, if P is currently sensitive to a signal S and
+      --     if an event has occured on S in this simulation cycle, then P
+      --     resumes.
+      if Current_Time = Process_First_Timeout then
+         Tn := Last_Time;
+         declare
+            Proc : Process_Acc;
+         begin
+            Proc := Process_Timeout_Chain;
+            while Proc /= null loop
+               case Proc.State is
+                  when State_Sensitized =>
+                     null;
+                  when State_Delayed =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Sensitized;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Wait =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Timeout;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Timeout
+                    | State_Ready =>
+                     Internal_Error ("process in timeout");
+                  when State_Dead =>
+                     null;
+               end case;
+               Proc := Proc.Timeout_Chain_Next;
+            end loop;
+         end;
+         Process_First_Timeout := Tn;
+      end if;
+
+      --  e) Each nonpostponed that has resumed in the current simulation cycle
+      --     is executed until it suspends.
+      Status := Run_Processes (Postponed => False);
+      if Status = Run_Failure then
+         return Run_Failure;
+      end if;
+
+      --  f) The time of the next simulation cycle, Tn, is determined by
+      --     setting it to the earliest of
+      --     1) TIME'HIGH
+      --     2) The next time at which a driver becomes active, or
+      --     3) The next time at which a process resumes.
+      --     If Tn = Tc, then the next simulation cycle (if any) will be a
+      --     delta cycle.
+      if Options.Flag_Stats then
+         Stats.Start_Next_Time;
+      end if;
+      Tn := Compute_Next_Time;
+
+      --  g) If the next simulation cycle will be a delta cycle, the remainder
+      --     of the step is skipped.
+      --     Otherwise, each postponed process that has resumed but has not
+      --     been executed since its last resumption is executed until it
+      --     suspends.  Then Tn is recalculated according to the rules of
+      --     step f.  It is an error if the execution of any postponed
+      --     process causes a delta cycle to occur immediatly after the
+      --     current simulation cycle.
+      if Tn = Current_Time then
+         if Current_Time = Last_Time and then Status = Run_None then
+            return Run_Finished;
+         else
+            Current_Delta := Current_Delta + 1;
+            return Run_Resumed;
+         end if;
+      else
+         Current_Delta := 0;
+         if Nbr_Postponed_Processes /= 0 then
+            Status := Run_Processes (Postponed => True);
+         end if;
+         if Status = Run_Resumed then
+            Flush_Active_List;
+            if Options.Flag_Stats then
+               Stats.Start_Next_Time;
+            end if;
+            Tn := Compute_Next_Time;
+            if Tn = Current_Time then
+               Error ("postponed process causes a delta cycle");
+            end if;
+         elsif Status = Run_Failure then
+            return Run_Failure;
+         end if;
+         Current_Time := Tn;
+         return Run_Resumed;
+      end if;
+   end Simulation_Cycle;
+
+   function Simulation return Integer
+   is
+      use Options;
+      Status : Integer;
+   begin
+      if Nbr_Threads /= 1 then
+         Threads.Init;
+      end if;
+
+--       if Disp_Sig_Types then
+--          Grt.Disp.Disp_Signals_Type;
+--       end if;
+
+      Status := Run_Through_Longjump (Initialization_Phase'Access);
+      if Status /= Run_Resumed then
+         return -1;
+      end if;
+
+      Nbr_Delta_Cycles := 0;
+      Nbr_Cycles := 0;
+      if Trace_Signals then
+         Grt.Disp_Signals.Disp_All_Signals;
+      end if;
+
+      if Current_Time /= 0 then
+         --  This is the end of a cycle.  This can happen when the time is not
+         --  zero after initialization.
+         Cycle_Time := 0;
+         Grt.Hooks.Call_Cycle_Hooks;
+      end if;
+
+      loop
+         Cycle_Time := Current_Time;
+         if Disp_Time then
+            Grt.Disp.Disp_Now;
+         end if;
+         Status := Run_Through_Longjump (Simulation_Cycle'Access);
+         exit when Status < 0;
+         if Trace_Signals then
+            Grt.Disp_Signals.Disp_All_Signals;
+         end if;
+
+         --  Statistics.
+         if Current_Delta = 0 then
+            Nbr_Cycles := Nbr_Cycles + 1;
+         else
+            Nbr_Delta_Cycles := Nbr_Delta_Cycles + 1;
+         end if;
+
+         exit when Status = Run_Finished;
+         if Current_Delta = 0 then
+            Grt.Hooks.Call_Cycle_Hooks;
+         end if;
+
+         if Current_Delta >= Stop_Delta then
+            Error ("simulation stopped by --stop-delta");
+            exit;
+         end if;
+         if Current_Time > Stop_Time then
+            if Current_Time /= Last_Time then
+               Info ("simulation stopped by --stop-time");
+            end if;
+            exit;
+         end if;
+      end loop;
+
+      if Nbr_Threads /= 1 then
+         Threads.Finish;
+      end if;
+
+      Call_Finalizers;
+
+      Grt.Hooks.Call_Finish_Hooks;
+
+      if Status = Run_Failure then
+         return -1;
+      else
+         return Exit_Status ;
+      end if;
+   end Simulation;
+
+end Grt.Processes;
diff --git a/src/translate/grt/grt-processes.ads b/src/translate/grt/grt-processes.ads
new file mode 100644
index 000000000..22326eb5e
--- /dev/null
+++ b/src/translate/grt/grt-processes.ads
@@ -0,0 +1,260 @@
+--  GHDL Run Time (GRT) -  processes.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with Grt.Stacks; use Grt.Stacks;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr;
+with Grt.Stdio;
+
+package Grt.Processes is
+   pragma Suppress (All_Checks);
+
+   --  Internal initialisations.
+   procedure Init;
+
+   --  Do the VHDL simulation.
+   --  Return 0 in case of success (end of time reached).
+   function Simulation return Integer;
+
+   --  Number of delta cycles.
+   Nbr_Delta_Cycles : Integer;
+   --  Number of non-delta cycles.
+   Nbr_Cycles : Integer;
+
+   --  If true, the simulation should be stopped.
+   Break_Simulation : Boolean;
+
+   --  If true, there is one stack for all processes.  Non-sensitized
+   --  processes must save their state.
+   One_Stack : Boolean := False;
+
+   type Process_Type is private;
+   --  type Process_Acc is access all Process_Type;
+
+   --  Return the identifier of the current process.
+   --  During the elaboration, this is the identifier of the last process
+   --  being elaborated.  So, this function can be used to create signal
+   --  drivers.
+
+   --  Return the total number of processes and number of sensitized processes.
+   --  Used for statistics.
+   function Get_Nbr_Processes return Natural;
+   function Get_Nbr_Sensitized_Processes return Natural;
+
+   --  Total number of resumed processes.
+   function Get_Nbr_Resumed_Processes return Natural;
+
+   --  Disp the name of process PROC.
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc);
+
+   --  Register a process during elaboration.
+   --  This procedure is called by vhdl elaboration code.
+   procedure Ghdl_Process_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc;
+                                    Ctxt : Ghdl_Rti_Access;
+                                    Addr : System.Address);
+   procedure Ghdl_Sensitized_Process_Register (Instance : Instance_Acc;
+                                               Proc : Proc_Acc;
+                                               Ctxt : Ghdl_Rti_Access;
+                                               Addr : System.Address);
+   procedure Ghdl_Postponed_Process_Register (Instance : Instance_Acc;
+                                              Proc : Proc_Acc;
+                                              Ctxt : Ghdl_Rti_Access;
+                                              Addr : System.Address);
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : Instance_Acc;
+      Proc : Proc_Acc;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address);
+
+   --  For verilog processes.
+   procedure Ghdl_Finalize_Register (Instance : Instance_Acc;
+                                     Proc : Proc_Acc);
+
+   procedure Ghdl_Initial_Register (Instance : Instance_Acc;
+                                    Proc : Proc_Acc);
+   procedure Ghdl_Always_Register (Instance : Instance_Acc;
+                                   Proc : Proc_Acc);
+
+   --  Add a simple signal in the sensitivity of the last registered
+   --  (sensitized) process.
+   procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+
+   --  Resume a process.
+   procedure Resume_Process (Proc : Process_Acc);
+
+   --  Wait without timeout or sensitivity: wait;
+   procedure Ghdl_Process_Wait_Exit;
+   --  Wait for a timeout (without sensitivity): wait for X;
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
+
+   --  Full wait statement:
+   --  1. Call Ghdl_Process_Wait_Set_Timeout (if there is a timeout)
+   --  2. Call Ghdl_Process_Wait_Add_Sensitivity (for each signal)
+   --  3. Call Ghdl_Process_Wait_Suspend, go to 4 if it returns true (timeout)
+   --     Evaluate the condition and go to 4 if true
+   --     Else, restart 3
+   --  4. Call Ghdl_Process_Wait_Close
+
+   --  Add a timeout for a wait.
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+   --  Add a sensitivity for a wait.
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+   --  Wait until timeout or sensitivity.
+   --  Return TRUE in case of timeout.
+   function Ghdl_Process_Wait_Suspend return Boolean;
+   --  Finish a wait statement.
+   procedure Ghdl_Process_Wait_Close;
+
+   --  For one stack setups, wait_suspend is decomposed into the suspension
+   --  procedure and the function to get resume status.
+   procedure Ghdl_Process_Wait_Wait;
+   function Ghdl_Process_Wait_Has_Timeout return Boolean;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32);
+
+   --  Secondary stack.
+   function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
+     return System.Address;
+   function Ghdl_Stack2_Mark return Mark_Id;
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id);
+
+   --  Protected variables.
+   procedure Ghdl_Protected_Enter (Obj : System.Address);
+   procedure Ghdl_Protected_Leave (Obj : System.Address);
+   procedure Ghdl_Protected_Init (Obj : System.Address);
+   procedure Ghdl_Protected_Fini (Obj : System.Address);
+
+   type Run_Handler is access function return Integer;
+
+   --  Run HAND through a wrapper that catch some errors (in particular on
+   --  windows).  Returns < 0 in case of error.
+   function Run_Through_Longjump (Hand : Run_Handler) return Integer;
+   pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
+
+private
+   --  State of a process.
+   type Process_State is
+     (
+      --  Sensitized process.  Its state cannot change.
+      State_Sensitized,
+
+      --  Non-sensitized process, ready to run.
+      State_Ready,
+
+      --  Verilog process, being suspended.
+      State_Delayed,
+
+      --  Non-sensitized process being suspended.
+      State_Wait,
+
+      --  Non-sensitized process being awaked by a wait timeout.  This state
+      --  is transcient.
+      --  This is necessary so that the process will exit immediately from the
+      --  wait statements without checking if the wait condition is true.
+      State_Timeout,
+
+      --  Non-sensitized process waiting until end.
+      State_Dead);
+
+   type Process_Type is record
+      --  Stack for the process.
+      --  This must be the first field of the record (and this is the only
+      --  part visible).
+      --  Must be NULL_STACK for sensitized processes.
+      Stack : Stacks.Stack_Type;
+
+      --  Subprogram containing process code.
+      Subprg : Proc_Acc;
+
+      --  Instance (THIS parameter) for the subprogram.
+      This : Instance_Acc;
+
+      --  Name of the process.
+      Rti : Rtis_Addr.Rti_Context;
+
+      --  True if the process is resumed and will be run at next cycle.
+      Resumed : Boolean;
+
+      --  True if the process is postponed.
+      Postponed : Boolean;
+
+      State : Process_State;
+
+      --  Timeout value for wait.
+      Timeout : Std_Time;
+
+      --  Sensitivity list while the (non-sensitized) process is waiting.
+      Sensitivity : Action_List_Acc;
+
+      Timeout_Chain_Next : Process_Acc;
+      Timeout_Chain_Prev : Process_Acc;
+   end record;
+
+   pragma Export (C, Ghdl_Process_Register,
+                  "__ghdl_process_register");
+   pragma Export (C, Ghdl_Sensitized_Process_Register,
+                  "__ghdl_sensitized_process_register");
+   pragma Export (C, Ghdl_Postponed_Process_Register,
+                  "__ghdl_postponed_process_register");
+   pragma Export (C, Ghdl_Postponed_Sensitized_Process_Register,
+                  "__ghdl_postponed_sensitized_process_register");
+
+   pragma Export (C, Ghdl_Finalize_Register, "__ghdl_finalize_register");
+
+   pragma Export (C, Ghdl_Always_Register, "__ghdl_always_register");
+   pragma Export (C, Ghdl_Initial_Register, "__ghdl_initial_register");
+
+   pragma Export (C, Ghdl_Process_Add_Sensitivity,
+                  "__ghdl_process_add_sensitivity");
+
+   pragma Export (C, Ghdl_Process_Wait_Exit,
+                  "__ghdl_process_wait_exit");
+   pragma Export (C, Ghdl_Process_Wait_Timeout,
+                  "__ghdl_process_wait_timeout");
+   pragma Export (C, Ghdl_Process_Wait_Add_Sensitivity,
+                  "__ghdl_process_wait_add_sensitivity");
+   pragma Export (C, Ghdl_Process_Wait_Set_Timeout,
+                  "__ghdl_process_wait_set_timeout");
+   pragma Export (Ada, Ghdl_Process_Wait_Suspend,
+                  "__ghdl_process_wait_suspend");
+   pragma Export (C, Ghdl_Process_Wait_Close,
+                  "__ghdl_process_wait_close");
+
+   pragma Export (C, Ghdl_Process_Delay, "__ghdl_process_delay");
+
+   pragma Export (C, Ghdl_Stack2_Allocate, "__ghdl_stack2_allocate");
+   pragma Export (C, Ghdl_Stack2_Mark, "__ghdl_stack2_mark");
+   pragma Export (C, Ghdl_Stack2_Release, "__ghdl_stack2_release");
+
+   pragma Export (C, Ghdl_Protected_Enter, "__ghdl_protected_enter");
+   pragma Export (C, Ghdl_Protected_Leave, "__ghdl_protected_leave");
+   pragma Export (C, Ghdl_Protected_Init, "__ghdl_protected_init");
+   pragma Export (C, Ghdl_Protected_Fini, "__ghdl_protected_fini");
+end Grt.Processes;
diff --git a/src/translate/grt/grt-readline.ads b/src/translate/grt/grt-readline.ads
new file mode 100644
index 000000000..1a3083981
--- /dev/null
+++ b/src/translate/grt/grt-readline.ads
@@ -0,0 +1,30 @@
+--  Although being part of GRT, the readline binding should be independent of
+--  it (for easier reuse).
+
+with System; use System;
+
+package Grt.Readline is
+   subtype Fat_String is String (Positive);
+   type Char_Ptr is access Fat_String;
+   pragma Convention (C, Char_Ptr);
+   --  A C string (which is NUL terminated) is represented as a (thin) access
+   --  to a fat string (a string whose range is 1 .. integer'Last).
+   --  The use of an access to a constrained array allows a representation
+   --  compatible with C.  Indexing of object of that type is safe only for
+   --  indexes until the NUL character.
+
+   function Readline (Prompt : Char_Ptr) return Char_Ptr;
+   function Readline (Prompt : Address) return Char_Ptr;
+   pragma Import (C, Readline);
+
+   procedure Free (Buf : Char_Ptr);
+   pragma Import (C, Free);
+
+   procedure Add_History (Line : Char_Ptr);
+   pragma Import (C, Add_History);
+
+   function Strlen (Str : Char_Ptr) return Natural;
+   pragma Import (C, Strlen);
+
+   pragma Linker_Options ("-lreadline");
+end Grt.Readline;
diff --git a/src/translate/grt/grt-rtis.adb b/src/translate/grt/grt-rtis.adb
new file mode 100644
index 000000000..26d976459
--- /dev/null
+++ b/src/translate/grt/grt-rtis.adb
@@ -0,0 +1,45 @@
+--  GHDL Run Time (GRT) -  Run Time Informations.
+--  Copyright (C) 2013 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package body Grt.Rtis is
+   procedure Ghdl_Rti_Add_Package (Pkg : Ghdl_Rti_Access) is
+   begin
+      Ghdl_Rti_Top.Children (Ghdl_Rti_Top.Nbr_Child) := Pkg;
+      Ghdl_Rti_Top.Nbr_Child := Ghdl_Rti_Top.Nbr_Child + 1;
+   end Ghdl_Rti_Add_Package;
+
+   procedure Ghdl_Rti_Add_Top (Max_Pkg : Ghdl_Index_Type;
+                               Pkgs : Ghdl_Rti_Arr_Acc;
+                               Top : Ghdl_Rti_Access;
+                               Instance : Address)
+   is
+      pragma Unreferenced (Max_Pkg);
+   begin
+      Ghdl_Rti_Top.Parent := Top;
+      Ghdl_Rti_Top.Children := Pkgs;
+      Ghdl_Rti_Top_Instance := Instance;
+   end Ghdl_Rti_Add_Top;
+
+end Grt.Rtis;
diff --git a/src/translate/grt/grt-rtis.ads b/src/translate/grt/grt-rtis.ads
new file mode 100644
index 000000000..6bb76597e
--- /dev/null
+++ b/src/translate/grt/grt-rtis.ads
@@ -0,0 +1,379 @@
+--  GHDL Run Time (GRT) -  Run Time Informations.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Ada.Unchecked_Conversion;
+
+package Grt.Rtis is
+   pragma Preelaborate (Grt.Rtis);
+
+   type Ghdl_Rtik is
+     (Ghdl_Rtik_Top,
+      Ghdl_Rtik_Library,        -- use scalar
+      Ghdl_Rtik_Package,
+      Ghdl_Rtik_Package_Body,
+      Ghdl_Rtik_Entity,
+      Ghdl_Rtik_Architecture,
+      Ghdl_Rtik_Process,
+      Ghdl_Rtik_Block,
+      Ghdl_Rtik_If_Generate,
+      Ghdl_Rtik_For_Generate,
+      Ghdl_Rtik_Instance, --10
+      Ghdl_Rtik_Constant,
+      Ghdl_Rtik_Iterator,
+      Ghdl_Rtik_Variable,
+      Ghdl_Rtik_Signal,
+      Ghdl_Rtik_File, -- 15
+      Ghdl_Rtik_Port,
+      Ghdl_Rtik_Generic,
+      Ghdl_Rtik_Alias,
+      Ghdl_Rtik_Guard,
+      Ghdl_Rtik_Component, -- 20
+      Ghdl_Rtik_Attribute,
+      Ghdl_Rtik_Type_B1,        --  Enum
+      Ghdl_Rtik_Type_E8,
+      Ghdl_Rtik_Type_E32,
+      Ghdl_Rtik_Type_I32,       --  25 Scalar
+      Ghdl_Rtik_Type_I64,
+      Ghdl_Rtik_Type_F64,
+      Ghdl_Rtik_Type_P32,
+      Ghdl_Rtik_Type_P64,
+      Ghdl_Rtik_Type_Access,
+      Ghdl_Rtik_Type_Array,
+      Ghdl_Rtik_Type_Record,
+      Ghdl_Rtik_Type_File,
+      Ghdl_Rtik_Subtype_Scalar,
+      Ghdl_Rtik_Subtype_Array,
+      Ghdl_Rtik_Subtype_Unconstrained_Array,
+      Ghdl_Rtik_Subtype_Record,
+      Ghdl_Rtik_Subtype_Access,
+      Ghdl_Rtik_Type_Protected,
+      Ghdl_Rtik_Element,
+      Ghdl_Rtik_Unit64,
+      Ghdl_Rtik_Unitptr,
+      Ghdl_Rtik_Attribute_Transaction,
+      Ghdl_Rtik_Attribute_Quiet,
+      Ghdl_Rtik_Attribute_Stable,
+      Ghdl_Rtik_Error);
+   for Ghdl_Rtik'Size use 8;
+
+   type Ghdl_Rti_Depth is range 0 .. 255;
+   for Ghdl_Rti_Depth'Size use 8;
+
+   type Ghdl_Rti_U8 is mod 2 ** 8;
+   for Ghdl_Rti_U8'Size use 8;
+
+   --  This structure is common to all RTI nodes.
+   type Ghdl_Rti_Common is record
+      --  Kind of the RTI, list is above.
+      Kind : Ghdl_Rtik;
+
+      Depth : Ghdl_Rti_Depth;
+
+      --  * array types and subtypes, record types, protected types:
+      --    bit 0: set for complex type
+      --    bit 1: set for anonymous type definition
+      --    bit 2: set only for physical type with non-static units (time)
+      --  * signals:
+      --    bit 0-3: mode (1: linkage, 2: buffer, 3 : out, 4 : inout, 5: in)
+      --    bit 4-5: kind (0 : none, 1 : register, 2 : bus)
+      --    bit 6: set if has 'active attributes
+      Mode : Ghdl_Rti_U8;
+
+      --  * Types and subtypes definition:
+      --    maximum depth of all RTIs referenced.
+      --  * Others:
+      --    0
+      Max_Depth : Ghdl_Rti_Depth;
+   end record;
+
+   type Ghdl_Rti_Access is access all Ghdl_Rti_Common;
+
+   --  Fat array of rti accesses.
+   type Ghdl_Rti_Array is array (Ghdl_Index_Type) of Ghdl_Rti_Access;
+   type Ghdl_Rti_Arr_Acc is access Ghdl_Rti_Array;
+
+   subtype Ghdl_Rti_Loc is Integer_Address;
+   Null_Rti_Loc : constant Ghdl_Rti_Loc := 0;
+
+   type Ghdl_C_String_Array is array (Ghdl_Index_Type) of Ghdl_C_String;
+   type Ghdl_C_String_Array_Ptr is access Ghdl_C_String_Array;
+
+   type Ghdl_Rtin_Block is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Parent : Ghdl_Rti_Access;
+      Size : Ghdl_Index_Type;
+      Nbr_Child : Ghdl_Index_Type;
+      Children : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Block_Acc is access Ghdl_Rtin_Block;
+   function To_Ghdl_Rtin_Block_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Block_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Block_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Object is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Obj_Type : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Object_Acc is access Ghdl_Rtin_Object;
+   function To_Ghdl_Rtin_Object_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Object_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Object_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Instance is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Parent : Ghdl_Rti_Access;
+      Instance : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Instance_Acc is access Ghdl_Rtin_Instance;
+   function To_Ghdl_Rtin_Instance_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Instance_Acc);
+
+   --  Must be kept in sync with grt.types.mode_signal_type.
+   Ghdl_Rti_Signal_Mode_Mask    : constant Ghdl_Rti_U8 := 15;
+   Ghdl_Rti_Signal_Mode_None    : constant Ghdl_Rti_U8 := 0;
+   Ghdl_Rti_Signal_Mode_Linkage : constant Ghdl_Rti_U8 := 1;
+   Ghdl_Rti_Signal_Mode_Buffer  : constant Ghdl_Rti_U8 := 2;
+   Ghdl_Rti_Signal_Mode_Out     : constant Ghdl_Rti_U8 := 3;
+   Ghdl_Rti_Signal_Mode_Inout   : constant Ghdl_Rti_U8 := 4;
+   Ghdl_Rti_Signal_Mode_In      : constant Ghdl_Rti_U8 := 5;
+
+   Ghdl_Rti_Signal_Kind_Mask     : constant Ghdl_Rti_U8 := 3 * 16;
+   Ghdl_Rti_Signal_Kind_Offset   : constant Ghdl_Rti_U8 := 1 * 16;
+   Ghdl_Rti_Signal_Kind_No       : constant Ghdl_Rti_U8 := 0 * 16;
+   Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 1 * 16;
+   Ghdl_Rti_Signal_Kind_Bus      : constant Ghdl_Rti_U8 := 2 * 16;
+
+   Ghdl_Rti_Signal_Has_Active    : constant Ghdl_Rti_U8 := 64;
+
+   type Ghdl_Rtin_Component is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr_Child : Ghdl_Index_Type;
+      Children : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Component_Acc is access Ghdl_Rtin_Component;
+   function To_Ghdl_Rtin_Component_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Component_Acc);
+
+   type Ghdl_Rtin_Type_Enum is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr : Ghdl_Index_Type;
+      --  Characters are represented as 'X', identifiers are represented as is,
+      --  extended identifiers are represented as is too.
+      Names : Ghdl_C_String_Array_Ptr;
+   end record;
+   type Ghdl_Rtin_Type_Enum_Acc is access Ghdl_Rtin_Type_Enum;
+   function To_Ghdl_Rtin_Type_Enum_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Enum_Acc);
+
+   type Ghdl_Rtin_Type_Scalar is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+   end record;
+   type Ghdl_Rtin_Type_Scalar_Acc is access Ghdl_Rtin_Type_Scalar;
+   function To_Ghdl_Rtin_Type_Scalar_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Scalar_Acc);
+
+   type Ghdl_Rtin_Subtype_Scalar is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Basetype : Ghdl_Rti_Access;
+      Range_Loc : Ghdl_Rti_Loc;
+   end record;
+   type Ghdl_Rtin_Subtype_Scalar_Acc is access Ghdl_Rtin_Subtype_Scalar;
+   function To_Ghdl_Rtin_Subtype_Scalar_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Subtype_Scalar_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Subtype_Scalar_Acc, Target => Ghdl_Rti_Access);
+
+   --  True if the type is complex, set in Mode field.
+   Ghdl_Rti_Type_Complex_Mask : constant Ghdl_Rti_U8 := 1;
+   Ghdl_Rti_Type_Complex      : constant Ghdl_Rti_U8 := 1;
+
+   --  True if the type is anonymous
+   Ghdl_Rti_Type_Anonymous_Mask : constant Ghdl_Rti_U8 := 2;
+   Ghdl_Rti_Type_Anonymous      : constant Ghdl_Rti_U8 := 2;
+
+   type Ghdl_Rtin_Type_Array is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Element : Ghdl_Rti_Access;
+      Nbr_Dim : Ghdl_Index_Type;
+      Indexes : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Array_Acc is access Ghdl_Rtin_Type_Array;
+   function To_Ghdl_Rtin_Type_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Array_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Type_Array_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Subtype_Array is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Basetype : Ghdl_Rtin_Type_Array_Acc;
+      Bounds : Ghdl_Rti_Loc;
+      Valsize : Ghdl_Rti_Loc;
+      Sigsize : Ghdl_Rti_Loc;
+   end record;
+   type Ghdl_Rtin_Subtype_Array_Acc is access Ghdl_Rtin_Subtype_Array;
+   function To_Ghdl_Rtin_Subtype_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Subtype_Array_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Subtype_Array_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Type_Fileacc is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Base : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Type_Fileacc_Acc is access Ghdl_Rtin_Type_Fileacc;
+   function To_Ghdl_Rtin_Type_Fileacc_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Fileacc_Acc);
+
+   type Ghdl_Rtin_Element is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Eltype : Ghdl_Rti_Access;
+      Val_Off : Ghdl_Index_Type;
+      Sig_Off : Ghdl_Index_Type;
+   end record;
+   type Ghdl_Rtin_Element_Acc is access Ghdl_Rtin_Element;
+   function To_Ghdl_Rtin_Element_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Element_Acc);
+
+   type Ghdl_Rtin_Type_Record is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbrel : Ghdl_Index_Type;
+      Elements : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Record_Acc is access Ghdl_Rtin_Type_Record;
+   function To_Ghdl_Rtin_Type_Record_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Record_Acc);
+
+   type Ghdl_Rtin_Unit64 is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Value : Ghdl_I64;
+   end record;
+   type Ghdl_Rtin_Unit64_Acc is access Ghdl_Rtin_Unit64;
+   function To_Ghdl_Rtin_Unit64_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit64_Acc);
+
+   type Ghdl_Rtin_Unitptr is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Addr : Ghdl_Value_Ptr;
+   end record;
+   type Ghdl_Rtin_Unitptr_Acc is access Ghdl_Rtin_Unitptr;
+   function To_Ghdl_Rtin_Unitptr_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unitptr_Acc);
+
+   --  Mode field is set to 4 if units value is per address.  Otherwise,
+   --  mode is 0.
+   type Ghdl_Rtin_Type_Physical is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr : Ghdl_Index_Type;
+      Units : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Physical_Acc is access Ghdl_Rtin_Type_Physical;
+   function To_Ghdl_Rtin_Type_Physical_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Physical_Acc);
+
+   --  Instance linkage.
+
+   --  At the beginning of a component structure (or the object for a direct
+   --  instantiation), there is a Ghdl_Component_Link_Type record.
+   --  These record contains a pointer to the instance (down link),
+   --  and RTIS to the statement and its parent (up link).
+   type Ghdl_Component_Link_Type;
+   type Ghdl_Component_Link_Acc is access Ghdl_Component_Link_Type;
+
+   --  At the beginning of an entity structure, there is a Ghdl_Link_Type,
+   --  which contains the RTI for the architecture (down-link) and a pointer
+   --  to the instantiation object (up-link).
+   type Ghdl_Entity_Link_Type is record
+      Rti : Ghdl_Rti_Access;
+      Parent : Ghdl_Component_Link_Acc;
+   end record;
+
+   type Ghdl_Entity_Link_Acc is access Ghdl_Entity_Link_Type;
+
+   function To_Ghdl_Entity_Link_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Entity_Link_Acc);
+
+   type Ghdl_Component_Link_Type is record
+      Instance : Ghdl_Entity_Link_Acc;
+      Stmt : Ghdl_Rti_Access;
+   end record;
+
+   function To_Ghdl_Component_Link_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Component_Link_Acc);
+
+   --  TOP rti.
+   Ghdl_Rti_Top : Ghdl_Rtin_Block :=
+     (Common => (Ghdl_Rtik_Top, 0, 0, 0),
+      Name => null,
+      Loc => Null_Rti_Loc,
+      Parent => null,
+      Size => 0,
+      Nbr_Child => 0,
+      Children => null);
+
+   --  Address of the top instance.
+   Ghdl_Rti_Top_Instance : Address;
+
+   --  Instances have a pointer to their RTI at offset 0.
+   type Ghdl_Rti_Acc_Acc is access Ghdl_Rti_Access;
+   function To_Ghdl_Rti_Acc_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Rti_Acc_Acc);
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Address);
+
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Rti_Access);
+
+   procedure Ghdl_Rti_Add_Top (Max_Pkg : Ghdl_Index_Type;
+                               Pkgs : Ghdl_Rti_Arr_Acc;
+                               Top : Ghdl_Rti_Access;
+                               Instance : Address);
+   pragma Export (C, Ghdl_Rti_Add_Top, "__ghdl_rti_add_top");
+
+   --  Register a package
+   procedure Ghdl_Rti_Add_Package (Pkg : Ghdl_Rti_Access);
+   pragma Export (C, Ghdl_Rti_Add_Package, "__ghdl_rti_add_package");
+end Grt.Rtis;
diff --git a/src/translate/grt/grt-rtis_addr.adb b/src/translate/grt/grt-rtis_addr.adb
new file mode 100644
index 000000000..70a0e2118
--- /dev/null
+++ b/src/translate/grt/grt-rtis_addr.adb
@@ -0,0 +1,299 @@
+--  GHDL Run Time (GRT) -  RTI address handling.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Addr is
+   function "+" (L : Address; R : Ghdl_Rti_Loc) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) + R);
+   end "+";
+
+   function "+" (L : Address; R : Ghdl_Index_Type) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) + Integer_Address (R));
+   end "+";
+
+   function "-" (L : Address; R : Ghdl_Rti_Loc) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) - R);
+   end "-";
+
+   function Align (L : Address; R : Ghdl_Rti_Loc) return Address
+   is
+      Nad : Integer_Address;
+   begin
+      Nad := To_Integer (L + (R - 1));
+      return To_Address (Nad - (Nad mod R));
+   end Align;
+
+   function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+      case Ctxt.Block.Kind is
+         when Ghdl_Rtik_Process
+           | Ghdl_Rtik_Block =>
+            return (Base => Ctxt.Base - Blk.Loc,
+                    Block => Blk.Parent);
+         when Ghdl_Rtik_Architecture =>
+            if Blk.Loc /= Null_Rti_Loc then
+               Internal_Error ("get_parent_context(3)");
+            end if;
+            return (Base => Ctxt.Base + Blk.Loc,
+                    Block => Blk.Parent);
+         when Ghdl_Rtik_For_Generate
+           | Ghdl_Rtik_If_Generate =>
+            declare
+               Nbase : Address;
+               Parent : Ghdl_Rti_Access;
+               Blk1 : Ghdl_Rtin_Block_Acc;
+            begin
+               --  Read the pointer to the parent.
+               --  This is the first field.
+               Nbase := To_Addr_Acc (Ctxt.Base).all;
+               --  Since the parent may be a grant-parent, adjust
+               --  the base.
+               Parent := Blk.Parent;
+               loop
+                  case Parent.Kind is
+                     when Ghdl_Rtik_Architecture
+                       | Ghdl_Rtik_For_Generate
+                       | Ghdl_Rtik_If_Generate =>
+                        exit;
+                     when Ghdl_Rtik_Block =>
+                        Blk1 := To_Ghdl_Rtin_Block_Acc (Parent);
+                        Nbase := Nbase + Blk1.Loc;
+                        Parent := Blk1.Parent;
+                     when others =>
+                        Internal_Error ("get_parent_context(2)");
+                  end case;
+               end loop;
+               return (Base => Nbase,
+                       Block => Blk.Parent);
+            end;
+         when others =>
+            Internal_Error ("get_parent_context(1)");
+      end case;
+   end Get_Parent_Context;
+
+   procedure Get_Instance_Link (Link : Ghdl_Entity_Link_Acc;
+                                Ctxt : out Rti_Context;
+                                Stmt : out Ghdl_Rti_Access)
+   is
+      Obj : Ghdl_Rtin_Instance_Acc;
+   begin
+      if Link.Parent = null then
+         --  Top entity.
+         Stmt := null;
+         Ctxt := (Base => Null_Address, Block => null);
+      else
+         Stmt := Link.Parent.Stmt;
+         Obj := To_Ghdl_Rtin_Instance_Acc (Stmt);
+         Ctxt := (Base => Link.Parent.all'Address - Obj.Loc,
+                  Block => Obj.Parent);
+      end if;
+   end Get_Instance_Link;
+
+   function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
+                         Loc : Ghdl_Rti_Loc;
+                         Ctxt : Rti_Context)
+                        return Address
+   is
+      Cur_Ctxt : Rti_Context;
+      Nctxt : Rti_Context;
+   begin
+      if Depth = 0 then
+         return To_Address (Loc);
+      elsif Ctxt.Block.Depth = Depth then
+         --Addr := Base + Storage_Offset (Obj.Loc.Off);
+         return Ctxt.Base + Loc;
+      else
+         if Ctxt.Block.Depth < Depth then
+            Internal_Error ("loc_to_addr");
+         end if;
+         Cur_Ctxt := Ctxt;
+         loop
+            Nctxt := Get_Parent_Context (Cur_Ctxt);
+            if Nctxt.Block.Depth = Depth then
+               return Nctxt.Base + Loc;
+            end if;
+            Cur_Ctxt := Nctxt;
+         end loop;
+      end if;
+   end Loc_To_Addr;
+
+   function Range_To_Length (Rng : Ghdl_Range_Ptr; Base_Type : Ghdl_Rti_Access)
+                            return Ghdl_Index_Type
+   is
+   begin
+      case Base_Type.Kind is
+         when Ghdl_Rtik_Type_B1 =>
+            return Rng.B1.Len;
+         when Ghdl_Rtik_Type_E8 =>
+            return Rng.E8.Len;
+         when Ghdl_Rtik_Type_E32 =>
+            return Rng.E32.Len;
+         when Ghdl_Rtik_Type_I32 =>
+            return Rng.I32.Len;
+         when others =>
+            Internal_Error ("range_to_length");
+      end case;
+   end Range_To_Length;
+
+   function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+                                     Ctxt : Rti_Context)
+                                    return Ghdl_Index_Type
+   is
+      Iter_Type : Ghdl_Rtin_Subtype_Scalar_Acc;
+      Rng : Ghdl_Range_Ptr;
+   begin
+      Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
+        (To_Ghdl_Rtin_Object_Acc (Blk.Children (0)).Obj_Type);
+      if Iter_Type.Common.Kind /= Ghdl_Rtik_Subtype_Scalar then
+         Internal_Error ("get_for_generate_length(1)");
+      end if;
+      Rng := To_Ghdl_Range_Ptr
+        (Loc_To_Addr (Iter_Type.Common.Depth, Iter_Type.Range_Loc, Ctxt));
+      return Range_To_Length (Rng, Iter_Type.Basetype);
+   end Get_For_Generate_Length;
+
+   procedure Get_Instance_Context (Inst : Ghdl_Rtin_Instance_Acc;
+                                   Ctxt : Rti_Context;
+                                   Sub_Ctxt : out Rti_Context)
+   is
+      Inst_Addr : Address;
+      Inst_Base : Address;
+   begin
+      --  Address of the field containing the address of the instance.
+      Inst_Addr := Ctxt.Base + Inst.Loc;
+      --  Read sub instance address.
+      Inst_Base := To_Addr_Acc (Inst_Addr).all;
+      --  Read instance RTI.
+      if Inst_Base = Null_Address then
+         Sub_Ctxt := (Base => Null_Address, Block => null);
+      else
+         Sub_Ctxt := (Base => Inst_Base,
+                      Block => To_Ghdl_Rti_Acc_Acc (Inst_Base).all);
+      end if;
+   end Get_Instance_Context;
+
+   procedure Bound_To_Range (Bounds_Addr : Address;
+                             Def : Ghdl_Rtin_Type_Array_Acc;
+                             Res : out Ghdl_Range_Array)
+   is
+      Bounds : Address;
+
+      procedure Align (A : Ghdl_Index_Type) is
+      begin
+         Bounds := Align (Bounds, Ghdl_Rti_Loc (A));
+      end Align;
+
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Bounds := Bounds + (S / Storage_Unit);
+      end Update;
+
+      Idx_Def : Ghdl_Rti_Access;
+   begin
+      if Res'Length /= Def.Nbr_Dim or else Res'First /= 0 then
+         Internal_Error ("disp_rti.bound_to_range");
+      end if;
+
+      Bounds := Bounds_Addr;
+
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         Idx_Def := Def.Indexes (I);
+
+         if Bounds = Null_Address then
+            Res (I) := null;
+         else
+            Idx_Def := Get_Base_Type (Idx_Def);
+            case Idx_Def.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Align (Ghdl_Range_I32'Alignment);
+                  Res (I) := To_Ghdl_Range_Ptr (Bounds);
+                  Update (Ghdl_Range_I32'Size);
+               when Ghdl_Rtik_Type_E8 =>
+                  Align (Ghdl_Range_E8'Alignment);
+                  Res (I) := To_Ghdl_Range_Ptr (Bounds);
+                  Update (Ghdl_Range_E8'Size);
+               when Ghdl_Rtik_Type_E32 =>
+                  Align (Ghdl_Range_E32'Alignment);
+                  Res (I) := To_Ghdl_Range_Ptr (Bounds);
+                  Update (Ghdl_Range_E32'Size);
+               when others =>
+                  --  Bounds are not known anymore.
+                  Bounds := Null_Address;
+            end case;
+         end if;
+      end loop;
+   end Bound_To_Range;
+
+   function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access
+   is
+   begin
+      case Atype.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            return To_Ghdl_Rtin_Subtype_Scalar_Acc (Atype).Basetype;
+         when Ghdl_Rtik_Subtype_Array =>
+            return To_Ghdl_Rti_Access
+              (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype);
+         when Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32
+           | Ghdl_Rtik_Type_B1 =>
+            return Atype;
+         when others =>
+            Internal_Error ("rtis_addr.get_base_type");
+      end case;
+   end Get_Base_Type;
+
+   function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean
+   is
+   begin
+      return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask)
+        = Ghdl_Rti_Type_Complex;
+   end Rti_Complex_Type;
+
+   function Rti_Anonymous_Type (Atype : Ghdl_Rti_Access) return Boolean
+   is
+   begin
+      return (Atype.Mode and Ghdl_Rti_Type_Anonymous_Mask)
+        = Ghdl_Rti_Type_Anonymous;
+   end Rti_Anonymous_Type;
+
+   function Get_Top_Context return Rti_Context
+   is
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := (Base => Ghdl_Rti_Top_Instance,
+               Block => Ghdl_Rti_Top.Parent);
+      return Ctxt;
+   end Get_Top_Context;
+
+end Grt.Rtis_Addr;
diff --git a/src/translate/grt/grt-rtis_addr.ads b/src/translate/grt/grt-rtis_addr.ads
new file mode 100644
index 000000000..3fa2792af
--- /dev/null
+++ b/src/translate/grt/grt-rtis_addr.ads
@@ -0,0 +1,110 @@
+--  GHDL Run Time (GRT) -  RTI address handling.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+--  Addresses handling.
+package Grt.Rtis_Addr is
+   function "+" (L : Address; R : Ghdl_Rti_Loc) return Address;
+   function "+" (L : Address; R : Ghdl_Index_Type) return Address;
+
+   function "-" (L : Address; R : Ghdl_Rti_Loc) return Address;
+
+   function Align (L : Address; R : Ghdl_Rti_Loc) return Address;
+
+   --  An RTI context contains a pointer (BASE) to or into an instance.
+   --  BLOCK describes data being pointed.  If a reference is made to a field
+   --  described by a parent of BLOCK, BASE must be modified.
+   type Rti_Context is record
+      Base : Address;
+      Block : Ghdl_Rti_Access;
+   end record;
+
+   Null_Context : constant Rti_Context;
+
+   --  Access to an address.
+   type Addr_Acc is access Address;
+   function To_Addr_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Addr_Acc);
+
+   type Ghdl_Index_Acc is access Ghdl_Index_Type;
+   function To_Ghdl_Index_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Index_Acc);
+
+   --  Get the parent context of CTXT.
+   --  The parent of an architecture is its entity.
+   function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context;
+
+   --  From an entity link, extract context and instantiation statement.
+   procedure Get_Instance_Link (Link : Ghdl_Entity_Link_Acc;
+                                Ctxt : out Rti_Context;
+                                Stmt : out Ghdl_Rti_Access);
+
+   --  Convert a location to an address.
+   function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
+                         Loc : Ghdl_Rti_Loc;
+                         Ctxt : Rti_Context)
+                        return Address;
+
+   --  Get the length of for_generate BLK.
+   function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+                                     Ctxt : Rti_Context)
+                                    return Ghdl_Index_Type;
+
+   --  Get the context of instance INST.
+   procedure Get_Instance_Context (Inst : Ghdl_Rtin_Instance_Acc;
+                                   Ctxt : Rti_Context;
+                                   Sub_Ctxt : out Rti_Context);
+
+   --  Extract range of every dimension from bounds.
+   procedure Bound_To_Range (Bounds_Addr : Address;
+                             Def : Ghdl_Rtin_Type_Array_Acc;
+                             Res : out Ghdl_Range_Array);
+
+   function Range_To_Length (Rng : Ghdl_Range_Ptr; Base_Type : Ghdl_Rti_Access)
+                            return Ghdl_Index_Type;
+
+   --  Get the base type of ATYPE.
+   function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access;
+
+   --  Return true iff ATYPE is anonymous.
+   --  Valid only on type and subtype definitions.
+   function Rti_Anonymous_Type (Atype : Ghdl_Rti_Access) return Boolean;
+   pragma Inline (Rti_Anonymous_Type);
+
+   --  Return true iff ATYPE is complex.
+   --  Valid only on type and subtype definitions.
+   function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean;
+   pragma Inline (Rti_Complex_Type);
+
+   --  Get the top context.
+   function Get_Top_Context return Rti_Context;
+
+private
+   Null_Context : constant Rti_Context := (Base => Null_Address,
+                                           Block => null);
+end Grt.Rtis_Addr;
diff --git a/src/translate/grt/grt-rtis_binding.ads b/src/translate/grt/grt-rtis_binding.ads
new file mode 100644
index 000000000..7e90eeafc
--- /dev/null
+++ b/src/translate/grt/grt-rtis_binding.ads
@@ -0,0 +1,67 @@
+--  GHDL Run Time (GRT) -  Well known RTIs.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Rtis; use Grt.Rtis;
+
+--  Set RTI_ptr defined in grt.rtis_types.
+
+package Grt.Rtis_Binding is
+   pragma Preelaborate (Grt.Rtis_Binding);
+
+   --  Define and set bit and boolean RTIs.
+   Std_Standard_Bit_RTI : aliased Ghdl_Rti_Common;
+
+   Std_Standard_Boolean_RTI : aliased Ghdl_Rti_Common;
+
+   pragma Import (C, Std_Standard_Bit_RTI,
+                  "std__standard__bit__RTI");
+
+   pragma Import (C, Std_Standard_Boolean_RTI,
+                  "std__standard__boolean__RTI");
+
+   Std_Standard_Bit_RTI_Ptr : Ghdl_Rti_Access
+     := Std_Standard_Bit_RTI'Access;
+
+   Std_Standard_Boolean_RTI_Ptr : Ghdl_Rti_Access
+     := Std_Standard_Boolean_RTI'Access;
+
+   pragma Export (C, Std_Standard_Bit_RTI_Ptr,
+                  "std__standard__bit__RTI_ptr");
+
+   pragma Export (C, Std_Standard_Boolean_RTI_Ptr,
+                  "std__standard__boolean__RTI_ptr");
+
+
+   --  Define and set Resolved_Resolv_Ptr.
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV;
+   pragma Import (C, Ieee_Std_Logic_1164_Resolved_RESOLV,
+                  "ieee__std_logic_1164__resolved_RESOLV");
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address :=
+     Ieee_Std_Logic_1164_Resolved_RESOLV'Address;
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+end Grt.Rtis_Binding;
diff --git a/src/translate/grt/grt-rtis_types.adb b/src/translate/grt/grt-rtis_types.adb
new file mode 100644
index 000000000..f22a309bc
--- /dev/null
+++ b/src/translate/grt/grt-rtis_types.adb
@@ -0,0 +1,118 @@
+--  GHDL Run Time (GRT) -  Well known RTI types.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Astdio;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package body Grt.Rtis_Types is
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      use Grt.Astdio;
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("grt.rtis_utils.Avhpi_Error!");
+   end Avhpi_Error;
+
+   --  Extract std_ulogic type.
+   procedure Search_Types (Pack : VhpiHandleT)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+      Rti : Ghdl_Rti_Access;
+   begin
+      Vhpi_Get_Str (VhpiLibLogicalNameP, Pack, Name, Name_Len);
+      if not (Name_Len = 4 and then Name (1 .. 4)= "ieee") then
+         return;
+      end if;
+
+      Vhpi_Iterator (VhpiDecls, Pack, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         if Vhpi_Get_Kind (Decl) = VhpiEnumTypeDeclK then
+            Vhpi_Get_Str (VhpiNameP, Decl, Name, Name_Len);
+            Rti := Avhpi_Get_Rti (Decl);
+            if Name_Len = 10 and then Name (1 .. 10) = "std_ulogic" then
+               Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr := Rti;
+            end if;
+         end if;
+      end loop;
+   end Search_Types;
+
+   procedure Search_Packages
+   is
+      Pack : VhpiHandleT;
+      Pack_It : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+   begin
+      Get_Package_Inst (Pack_It);
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Pack_It, Pack, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Vhpi_Get_Str (VhpiNameP, Pack, Name, Name_Len);
+         if Name_Len = 14 and then Name (1 .. 14) = "std_logic_1164" then
+            Search_Types (Pack);
+         end if;
+      end loop;
+   end Search_Packages;
+
+   Search_Types_RTI_Done : Boolean := False;
+
+   procedure Search_Types_RTI is
+   begin
+      if Search_Types_RTI_Done then
+         return;
+      else
+         Search_Types_RTI_Done := True;
+      end if;
+
+      Search_Packages;
+   end Search_Types_RTI;
+end Grt.Rtis_Types;
diff --git a/src/translate/grt/grt-rtis_types.ads b/src/translate/grt/grt-rtis_types.ads
new file mode 100644
index 000000000..f64b17324
--- /dev/null
+++ b/src/translate/grt/grt-rtis_types.ads
@@ -0,0 +1,55 @@
+--  GHDL Run Time (GRT) -  Well known RTI types.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Rtis; use Grt.Rtis;
+
+--  This package allow access to RTIs of some types.
+--  This is used to recognize some VHDL logic types.
+--  This is also used by grt.signals to set types of some implicit signals
+--   (such as 'stable or 'transation).
+
+package Grt.Rtis_Types is
+   --  RTIs for some logic types.
+   Std_Standard_Bit_RTI_Ptr : Ghdl_Rti_Access;
+
+   Std_Standard_Boolean_RTI_Ptr : Ghdl_Rti_Access;
+
+   --  std_ulogic.
+   --  A VHDL may not contain ieee.std_logic_1164 package.  So, this RTI
+   --  must be dynamicaly searched.
+   Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr : Ghdl_Rti_Access := null;
+
+   --  Search RTI for types.
+   --  If a type is not found, its RTI is set to null.
+   --  If this procedure has already been called, then this is a noop.
+   procedure Search_Types_RTI;
+private
+   --  These are set either by grt.rtis_binding or by ghdlrun.
+   --  This is not very clean...
+   pragma Import (C, Std_Standard_Bit_RTI_Ptr,
+                  "std__standard__bit__RTI_ptr");
+
+   pragma Import (C, Std_Standard_Boolean_RTI_Ptr,
+                  "std__standard__boolean__RTI_ptr");
+end Grt.Rtis_Types;
diff --git a/src/translate/grt/grt-rtis_utils.adb b/src/translate/grt/grt-rtis_utils.adb
new file mode 100644
index 000000000..0d4328e7e
--- /dev/null
+++ b/src/translate/grt/grt-rtis_utils.adb
@@ -0,0 +1,660 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+--with Grt.Disp; use Grt.Disp;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Utils is
+
+   function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result
+   is
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result;
+
+      function Traverse_Blocks_1 (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+         Index : Ghdl_Index_Type;
+         Child : Ghdl_Rti_Access;
+      begin
+         Res := Process (Ctxt, Ctxt.Block);
+         if Res /= Traverse_Ok then
+            return Res;
+         end if;
+
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         Index := 0;
+         while Index < Blk.Nbr_Child loop
+            Child := Blk.Children (Index);
+            Index := Index + 1;
+            case Child.Kind is
+               when Ghdl_Rtik_Process
+                 | Ghdl_Rtik_Block =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt := (Base => Ctxt.Base + Nblk.Loc,
+                               Block => Child);
+                     Res := Traverse_Blocks_1 (Nctxt);
+                  end;
+               when Ghdl_Rtik_For_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                     Length : Ghdl_Index_Type;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
+                        Block => Child);
+                     Length := Get_For_Generate_Length (Nblk, Ctxt);
+                     for I in 1 .. Length loop
+                        Res := Traverse_Blocks_1 (Nctxt);
+                        exit when Res = Traverse_Stop;
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                     end loop;
+                  end;
+               when Ghdl_Rtik_If_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
+                        Block => Child);
+                     if Nctxt.Base /= Null_Address then
+                        Res := Traverse_Blocks_1 (Nctxt);
+                     end if;
+                  end;
+               when Ghdl_Rtik_Instance =>
+                  Res := Process (Ctxt, Child);
+                  if Res = Traverse_Ok then
+                     declare
+                        Obj : Ghdl_Rtin_Instance_Acc;
+                     begin
+                        Obj := To_Ghdl_Rtin_Instance_Acc (Child);
+
+                        Get_Instance_Context (Obj, Ctxt, Nctxt);
+                        if Nctxt /= Null_Context then
+                           Res := Traverse_Instance (Nctxt);
+                        end if;
+                     end;
+                  end if;
+               when Ghdl_Rtik_Package
+                 | Ghdl_Rtik_Entity
+                 | Ghdl_Rtik_Architecture =>
+                  Internal_Error ("traverse_blocks");
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Guard
+                 | Ghdl_Rtik_Attribute_Quiet
+                 | Ghdl_Rtik_Attribute_Stable
+                 | Ghdl_Rtik_Attribute_Transaction =>
+                  Res := Process (Ctxt, Child);
+               when others =>
+                  null;
+            end case;
+            exit when Res = Traverse_Stop;
+         end loop;
+
+         return Res;
+      end Traverse_Blocks_1;
+
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+
+      begin
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               --  The entity.
+               Res := Traverse_Blocks_1 (Nctxt);
+               if Res /= Traverse_Stop then
+                  --  The architecture.
+                  Res := Traverse_Blocks_1 (Ctxt);
+               end if;
+            when Ghdl_Rtik_Package_Body =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Res := Traverse_Blocks_1 (Nctxt);
+            when others =>
+               Internal_Error ("traverse_blocks");
+         end case;
+         return Res;
+      end Traverse_Instance;
+   begin
+      return Traverse_Instance (Ctxt);
+   end Traverse_Blocks;
+
+   --  Disp value stored at ADDR and whose type is described by RTI.
+   procedure Get_Enum_Value
+     (Vstr : in out Vstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Append (Vstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean;
+                             Param : Param_Type)
+   is
+      --  Current address.
+      Addr : Address;
+
+      Name : Vstring;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access);
+
+      procedure Handle_Scalar (Rti : Ghdl_Rti_Access)
+      is
+         procedure Update (S : Ghdl_Index_Type) is
+         begin
+            Addr := Addr + (S / Storage_Unit);
+         end Update;
+      begin
+         Process (Addr, Name, Rti, Param);
+
+         if Is_Sig then
+            Update (Address'Size);
+         else
+            case Rti.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Update (32);
+               when Ghdl_Rtik_Type_E8 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_E32 =>
+                  Update (32);
+               when Ghdl_Rtik_Type_B1 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_F64 =>
+                  Update (64);
+               when Ghdl_Rtik_Type_P64 =>
+                  Update (64);
+               when others =>
+                  Internal_Error ("handle_scalar");
+            end case;
+         end if;
+      end Handle_Scalar;
+
+      procedure Range_Pos_To_Val (Rti : Ghdl_Rti_Access;
+                                  Rng : Ghdl_Range_Ptr;
+                                  Pos : Ghdl_Index_Type;
+                                  Val : out Value_Union)
+      is
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               case Rng.I32.Dir is
+                  when Dir_To =>
+                     Val.I32 := Rng.I32.Left + Ghdl_I32 (Pos);
+                  when Dir_Downto =>
+                     Val.I32 := Rng.I32.Left - Ghdl_I32 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_E8 =>
+               case Rng.E8.Dir is
+                  when Dir_To =>
+                     Val.E8 := Rng.E8.Left + Ghdl_E8 (Pos);
+                  when Dir_Downto =>
+                     Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_E32 =>
+               case Rng.E32.Dir is
+                  when Dir_To =>
+                     Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos);
+                  when Dir_Downto =>
+                     Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_B1 =>
+               case Pos is
+                  when 0 =>
+                     Val.B1 := Rng.B1.Left;
+                  when 1 =>
+                     Val.B1 := Rng.B1.Right;
+                  when others =>
+                     Val.B1 := False;
+               end case;
+            when others =>
+               Internal_Error ("grt.rtis_utils.range_pos_to_val");
+         end case;
+      end Range_Pos_To_Val;
+
+      procedure Pos_To_Vstring
+        (Vstr : in out Vstring;
+         Rti : Ghdl_Rti_Access;
+         Rng : Ghdl_Range_Ptr;
+         Pos : Ghdl_Index_Type)
+      is
+         V : Value_Union;
+      begin
+         Range_Pos_To_Val (Rti, Rng, Pos, V);
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               declare
+                  S : String (1 .. 12);
+                  F : Natural;
+               begin
+                  To_String (S, F, V.I32);
+                  Append (Vstr, S (F .. S'Last));
+               end;
+            when Ghdl_Rtik_Type_E8 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8));
+            when Ghdl_Rtik_Type_E32 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32));
+            when Ghdl_Rtik_Type_B1 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_B1'Pos (V.B1));
+            when others =>
+               Append (Vstr, '?');
+         end case;
+      end Pos_To_Vstring;
+
+      procedure Handle_Array_1 (El_Rti : Ghdl_Rti_Access;
+                                Rngs : Ghdl_Range_Array;
+                                Rtis : Ghdl_Rti_Arr_Acc;
+                                Index : Ghdl_Index_Type)
+      is
+         Len : Ghdl_Index_Type;
+         P : Natural;
+         Base_Type : Ghdl_Rti_Access;
+      begin
+         P := Length (Name);
+         if Index = 0 then
+            Append (Name, '(');
+         else
+            Append (Name, ',');
+         end if;
+
+         Base_Type := Get_Base_Type (Rtis (Index));
+         Len := Range_To_Length (Rngs (Index),  Base_Type);
+
+         for I in 1 .. Len loop
+            Pos_To_Vstring (Name, Base_Type, Rngs (Index), I - 1);
+            if Index = Rngs'Last then
+               Append (Name, ')');
+               Handle_Any (El_Rti);
+            else
+               Handle_Array_1 (El_Rti, Rngs, Rtis, Index + 1);
+            end if;
+            Truncate (Name, P + 1);
+         end loop;
+         Truncate (Name, P);
+      end Handle_Array_1;
+
+      procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc;
+                              Vals : Ghdl_Uc_Array_Acc)
+      is
+         Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim;
+         Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
+      begin
+         Bound_To_Range (Vals.Bounds, Rti, Rngs);
+         Addr := Vals.Base;
+         Handle_Array_1 (Rti.Element, Rngs, Rti.Indexes, 0);
+      end Handle_Array;
+
+      procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc)
+      is
+         El : Ghdl_Rtin_Element_Acc;
+         Obj_Addr : Address;
+         Last_Addr : Address;
+         P : Natural;
+      begin
+         P := Length (Name);
+         Obj_Addr := Addr;
+         Last_Addr := Addr;
+         for I in 1 .. Rti.Nbrel loop
+            El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
+            if Is_Sig then
+               Addr := Obj_Addr + El.Sig_Off;
+            else
+               Addr := Obj_Addr + El.Val_Off;
+            end if;
+            if Rti_Complex_Type (El.Eltype) then
+               Addr := Obj_Addr + To_Ghdl_Index_Acc (Addr).all;
+            end if;
+            Append (Name, '.');
+            Append (Name, El.Name);
+            Handle_Any (El.Eltype);
+            if Addr > Last_Addr then
+               Last_Addr := Addr;
+            end if;
+            Truncate (Name, P);
+         end loop;
+         Addr := Last_Addr;
+      end Handle_Record;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access) is
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Subtype_Scalar =>
+               Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
+            when Ghdl_Rtik_Type_I32
+              | Ghdl_Rtik_Type_E8
+              | Ghdl_Rtik_Type_E32
+              | Ghdl_Rtik_Type_B1 =>
+               Handle_Scalar (Rti);
+            when Ghdl_Rtik_Type_Array =>
+               Handle_Array (To_Ghdl_Rtin_Type_Array_Acc (Rti),
+                             To_Ghdl_Uc_Array_Acc (Addr));
+            when Ghdl_Rtik_Subtype_Array =>
+               declare
+                  St : constant Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                  Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range
+                    (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+               end;
+--          when Ghdl_Rtik_Type_File =>
+--             declare
+--                Vptr : Ghdl_Value_Ptr;
+--             begin
+--                Vptr := To_Ghdl_Value_Ptr (Obj);
+--                Put (Stream, "File#");
+--                Put_I32 (Stream, Vptr.I32);
+--                --  FIXME: update OBJ (not very useful since never in a
+--                --   composite type).
+--             end;
+            when Ghdl_Rtik_Type_Record =>
+               Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+            when others =>
+               Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
+         end case;
+      end Handle_Any;
+   begin
+      if Rti_Complex_Type (Obj_Type) then
+         Addr := To_Addr_Acc (Obj_Addr).all;
+      else
+         Addr := Obj_Addr;
+      end if;
+      Handle_Any (Obj_Type);
+      Free (Name);
+   end Foreach_Scalar;
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_E32 =>
+            Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32));
+         when Ghdl_Rtik_Type_B1 =>
+            Get_Enum_Value
+              (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1)));
+         when Ghdl_Rtik_Type_F64 =>
+            declare
+               S : String (1 .. 32);
+               L : Integer;
+
+               function Snprintf_G (Cstr : Address;
+                                    Size : Natural;
+                                    Arg : Ghdl_F64)
+                 return Integer;
+               pragma Import (C, Snprintf_G, "__ghdl_snprintf_g");
+
+            begin
+               L := Snprintf_G (S'Address, S'Length, Value.F64);
+               if L < 0 then
+                  --  FIXME.
+                  Append (Str, "?");
+               else
+                  Append (Str, S (1 .. L));
+               end if;
+            end;
+         when Ghdl_Rtik_Type_P32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+               Append
+                 (Str, Get_Physical_Unit_Name
+                    (To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0)));
+            end;
+         when Ghdl_Rtik_Type_P64 =>
+            declare
+               S : String (1 .. 21);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I64);
+               Append (Str, S (F .. S'Last));
+               Append
+                 (Str, Get_Physical_Unit_Name
+                    (To_Ghdl_Rtin_Type_Physical_Acc (Type_Rti).Units (0)));
+            end;
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value");
+      end case;
+   end Get_Value;
+
+   procedure Disp_Value (Stream : FILEs;
+                         Value : Value_Union;
+                         Type_Rti : Ghdl_Rti_Access)
+   is
+      Name : Vstring;
+   begin
+      Rtis_Utils.Get_Value (Name, Value, Type_Rti);
+      Put (Stream, Name);
+      Free (Name);
+   end Disp_Value;
+
+   function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access)
+                                   return Ghdl_C_String
+   is
+   begin
+      case Unit.Kind is
+         when Ghdl_Rtik_Unit64 =>
+            return To_Ghdl_Rtin_Unit64_Acc (Unit).Name;
+         when Ghdl_Rtik_Unitptr =>
+            return To_Ghdl_Rtin_Unitptr_Acc (Unit).Name;
+         when others =>
+            Internal_Error ("rtis_utils.physical_unit_name");
+      end case;
+   end Get_Physical_Unit_Name;
+
+   function Get_Physical_Unit_Value (Unit : Ghdl_Rti_Access;
+                                     Type_Rti : Ghdl_Rti_Access)
+                                    return Ghdl_I64 is
+   begin
+      case Unit.Kind is
+         when Ghdl_Rtik_Unit64 =>
+            return To_Ghdl_Rtin_Unit64_Acc (Unit).Value;
+         when Ghdl_Rtik_Unitptr =>
+            case Type_Rti.Kind is
+               when Ghdl_Rtik_Type_P64 =>
+                  return To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I64;
+               when Ghdl_Rtik_Type_P32 =>
+                  return Ghdl_I64
+                    (To_Ghdl_Rtin_Unitptr_Acc (Unit).Addr.I32);
+               when others =>
+                  Internal_Error ("get_physical_unit_value(1)");
+            end case;
+         when others =>
+            Internal_Error ("get_physical_unit_value(2)");
+      end case;
+   end Get_Physical_Unit_Value;
+
+   procedure Get_Enum_Value
+     (Rstr : in out Rstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Prepend (Rstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Get_Value (Rstr : in out Rstring;
+                        Addr : Address;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+      Value : constant Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr);
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Prepend (Rstr, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_E32 =>
+            Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32));
+         when Ghdl_Rtik_Type_B1 =>
+            Get_Enum_Value
+              (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1)));
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value(rstr)");
+      end case;
+   end Get_Value;
+
+   procedure Get_Path_Name (Rstr : in out Rstring;
+                            Last_Ctxt : Rti_Context;
+                            Sep : Character;
+                            Is_Instance : Boolean := True)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := Last_Ctxt;
+      loop
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Ctxt.Block.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_If_Generate =>
+               Prepend (Rstr, Blk.Name);
+               Prepend (Rstr, Sep);
+               Ctxt := Get_Parent_Context (Ctxt);
+            when Ghdl_Rtik_Entity =>
+               declare
+                  Link : Ghdl_Entity_Link_Acc;
+               begin
+                  Link := To_Ghdl_Entity_Link_Acc (Ctxt.Base);
+                  Ctxt := (Base => Ctxt.Base,
+                           Block => Link.Rti);
+                  if Ctxt.Block = null then
+                     --  Process in an entity.
+                     --  FIXME: check.
+                     Prepend (Rstr, Blk.Name);
+                     return;
+                  end if;
+               end;
+            when Ghdl_Rtik_Architecture =>
+               declare
+                  Entity_Ctxt: Rti_Context;
+                  Link : Ghdl_Entity_Link_Acc;
+                  Parent_Inst : Ghdl_Rti_Access;
+               begin
+                  --  Architecture name.
+                  if Is_Instance then
+                     Prepend (Rstr, ')');
+                     Prepend (Rstr, Blk.Name);
+                     Prepend (Rstr, '(');
+                  end if;
+
+                  Entity_Ctxt := Get_Parent_Context (Ctxt);
+
+                  --  Instance parent.
+                  Link := To_Ghdl_Entity_Link_Acc (Entity_Ctxt.Base);
+                  Get_Instance_Link (Link, Ctxt, Parent_Inst);
+
+                  --  Add entity name.
+                  if Is_Instance or Parent_Inst = null then
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Block_Acc (Entity_Ctxt.Block).Name);
+                  end if;
+
+                  if Parent_Inst = null then
+                     --  Top reached.
+                     Prepend (Rstr, Sep);
+                     return;
+                  else
+                     --  Instantiation statement label.
+                     if Is_Instance then
+                        Prepend (Rstr, '@');
+                     end if;
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Object_Acc (Parent_Inst).Name);
+                     Prepend (Rstr, Sep);
+                  end if;
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Iter : Ghdl_Rtin_Object_Acc;
+                  Addr : Address;
+               begin
+                  Prepend (Rstr, ')');
+                  Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                  Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+                  Get_Value (Rstr, Addr, Get_Base_Type (Iter.Obj_Type));
+                  Prepend (Rstr, '(');
+                  Prepend (Rstr, Blk.Name);
+                  Prepend (Rstr, Sep);
+                  Ctxt := Get_Parent_Context (Ctxt);
+               end;
+            when others =>
+               Internal_Error ("grt.rtis_utils.get_path_name");
+         end case;
+      end loop;
+   end Get_Path_Name;
+
+   procedure Put (Stream : FILEs; Ctxt : Rti_Context)
+   is
+      Rstr : Rstring;
+   begin
+      Get_Path_Name (Rstr, Ctxt, '.');
+      Put (Stream, Rstr);
+      Free (Rstr);
+   end Put;
+
+end Grt.Rtis_Utils;
diff --git a/src/translate/grt/grt-rtis_utils.ads b/src/translate/grt/grt-rtis_utils.ads
new file mode 100644
index 000000000..10c1a0f28
--- /dev/null
+++ b/src/translate/grt/grt-rtis_utils.ads
@@ -0,0 +1,92 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Rtis_Utils is
+   --  Action to perform after a node was handled by the user function:
+   --  Traverse_Ok: continue to process.
+   --  Traverse_Skip: do not traverse children.
+   --  Traverse_Stop: end of walk.
+   type Traverse_Result is (Traverse_Ok, Traverse_Skip, Traverse_Stop);
+
+   --  An RTI object is a context and an RTI declaration.
+   type Rti_Object is record
+      Obj : Ghdl_Rti_Access;
+      Ctxt : Rti_Context;
+   end record;
+
+   --  Traverse all blocks (package, entities, architectures, block, generate,
+   --  processes).
+   generic
+      with function Process (Ctxt : Rti_Context;
+                             Obj : Ghdl_Rti_Access)
+                            return Traverse_Result;
+   function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result;
+
+   generic
+      type Param_Type is private;
+      with procedure Process (Val_Addr : Address;
+                              Val_Name : Vstring;
+                              Val_Type : Ghdl_Rti_Access;
+                              Param : Param_Type);
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean;
+                             Param : Param_Type);
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access);
+
+   --  Get the name of a physical unit.
+   function Get_Physical_Unit_Name (Unit : Ghdl_Rti_Access)
+                                   return Ghdl_C_String;
+
+   --  Get the value of a physical unit.
+   function Get_Physical_Unit_Value (Unit : Ghdl_Rti_Access;
+                                     Type_Rti : Ghdl_Rti_Access)
+                                    return Ghdl_I64;
+
+   --  Disp a value.
+   procedure Disp_Value (Stream : FILEs;
+                         Value : Value_Union;
+                         Type_Rti : Ghdl_Rti_Access);
+
+   --  Get context as a path name.
+   --  If IS_INSTANCE is true, the architecture name of entities is added.
+   procedure Get_Path_Name (Rstr : in out Rstring;
+                            Last_Ctxt : Rti_Context;
+                            Sep : Character;
+                            Is_Instance : Boolean := True);
+
+   --  Disp a context as a path.
+   procedure Put (Stream : FILEs; Ctxt : Rti_Context);
+end Grt.Rtis_Utils;
diff --git a/src/translate/grt/grt-sdf.adb b/src/translate/grt/grt-sdf.adb
new file mode 100644
index 000000000..73534e3eb
--- /dev/null
+++ b/src/translate/grt/grt-sdf.adb
@@ -0,0 +1,1389 @@
+--  GHDL Run Time (GRT) - SDF parser.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
+with Grt.Errors; use Grt.Errors;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Deallocation;
+with Grt.Vital_Annotate;
+
+package body Grt.Sdf is
+   EOT : constant Character := Character'Val (4);
+
+   type Sdf_Token_Type is
+     (
+      Tok_Oparen, -- (
+      Tok_Cparen, -- )
+      Tok_Qstring,
+      Tok_Identifier,
+      Tok_Rnumber,
+      Tok_Dnumber,
+      Tok_Div, -- /
+      Tok_Dot, -- .
+      Tok_Cln, -- :
+
+      Tok_Error,
+      Tok_Eof
+     );
+
+   type Sdf_Context_Acc is access Sdf_Context_Type;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => Sdf_Context_Acc, Object => Sdf_Context_Type);
+
+   Sdf_Context : Sdf_Context_Acc;
+
+   --  Current data read from the file.
+   Buf : String_Access (1 .. Buf_Size) := null;
+
+   --  Length of the buffer, including the EOT.
+   Buf_Len : Natural;
+   Pos : Natural;
+   Line_Start : Integer;
+
+   Sdf_Stream : FILEs := NULL_Stream;
+   Sdf_Filename : String_Access := null;
+   Sdf_Line : Natural;
+
+   function Open_Sdf (Filename : String) return Boolean
+   is
+      N_Filename : String (1 .. Filename'Length + 1);
+      Mode : constant String := "rt" & NUL;
+   begin
+      N_Filename (1 .. Filename'Length) := Filename;
+      N_Filename (N_Filename'Last) := NUL;
+      Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
+      if Sdf_Stream = NULL_Stream then
+         Error_C ("cannot open SDF file '");
+         Error_C (Filename);
+         Error_E ("'");
+         return False;
+      end if;
+      Sdf_Context := new Sdf_Context_Type;
+
+      Sdf_Context.Version := Sdf_Version_Unknown;
+
+      --  Set the timescale to 1 ns.
+      Sdf_Context.Timescale := 1000;
+
+      Buf := new String (1 .. Buf_Size);
+      Buf_Len := 1;
+      Buf (1) := EOT;
+      Sdf_Line := 1;
+      Sdf_Filename := new String'(Filename);
+      Pos := 1;
+      Line_Start := 1;
+      return True;
+   end Open_Sdf;
+
+   procedure Close_Sdf
+   is
+   begin
+      fclose (Sdf_Stream);
+      Sdf_Stream := NULL_Stream;
+      Unchecked_Deallocation (Sdf_Context);
+      Unchecked_Deallocation (Buf);
+   end Close_Sdf;
+
+   procedure Read_Sdf
+   is
+      Res : size_t;
+   begin
+      Res := fread (Buf (Pos)'Address, 1, size_t (Read_Size), Sdf_Stream);
+      Line_Start := Line_Start - Buf_Len + Pos;
+      Buf_Len := Pos + Natural (Res);
+      Buf (Buf_Len) := EOT;
+   end Read_Sdf;
+
+
+   Ident_Start : Natural;
+   Ident_End : Natural;
+
+   procedure Read_Append
+   is
+      Len : Natural;
+   begin
+      Len := Pos - Ident_Start;
+      if Ident_Start = 1 or Len >= 1024 then
+         Error_C ("SDF line ");
+         Error_C (Sdf_Line);
+         Error_E (" is too long");
+         return;
+      end if;
+      Buf (1 .. Len) := Buf (Ident_Start .. Ident_Start + Len - 1);
+      Pos := Len + 1;
+      Ident_Start := 1;
+      Read_Sdf;
+   end Read_Append;
+
+   procedure Error_Sdf_C is
+   begin
+      Error_C (Sdf_Filename.all);
+      Error_C (":");
+      Error_C (Sdf_Line);
+      Error_C (":");
+      Error_C (Pos - Line_Start);
+      Error_C (": ");
+   end Error_Sdf_C;
+
+   procedure Error_Sdf (Msg : String) is
+   begin
+      Error_Sdf_C;
+      Error_E (Msg);
+   end Error_Sdf;
+
+   procedure Error_Bad_Character is
+   begin
+      Error_Sdf ("bad character in SDF file");
+   end Error_Bad_Character;
+
+   procedure Scan_Identifier
+   is
+   begin
+      Ident_Start := Pos;
+      loop
+         Pos := Pos + 1;
+         case Buf (Pos) is
+            when 'a' .. 'z'
+              | 'A' .. 'Z'
+              | '0' .. '9'
+              | '_' =>
+               null;
+            when '\' =>
+               Error_Sdf ("escape character not handled");
+               Ident_End := Pos - 1;
+               return;
+            when EOT =>
+               Read_Append;
+               Pos := Pos - 1;
+            when others =>
+               Ident_End := Pos - 1;
+               return;
+         end case;
+      end loop;
+   end Scan_Identifier;
+
+   function Ident_Length return Natural is
+   begin
+      return Ident_End - Ident_Start + 1;
+   end Ident_Length;
+
+   function Is_Ident (Str : String) return Boolean
+   is
+   begin
+      if Ident_Length /= Str'Length then
+         return False;
+      end if;
+      return Buf (Ident_Start .. Ident_End) = Str;
+   end Is_Ident;
+
+   procedure Scan_Qstring
+   is
+   begin
+      Ident_Start := Pos + 1;
+      loop
+         Pos := Pos + 1;
+         case Buf (Pos) is
+            when EOT =>
+               Read_Append;
+            when NUL .. Character'Val (3)
+              | Character'Val (5) .. Character'Val (31)
+              | Character'Val (127) .. Character'Val (255) =>
+               Error_Bad_Character;
+            when ' '
+              | '!'
+              | '#' .. '~' =>
+               null;
+            when '"' => -- "
+               Ident_End := Pos - 1;
+               Pos := Pos + 1;
+               exit;
+         end case;
+      end loop;
+   end Scan_Qstring;
+
+   Scan_Int : Integer;
+   Scan_Exp : Integer;
+
+   function Scan_Number return Sdf_Token_Type
+   is
+      Has_Dot : Boolean;
+   begin
+      Has_Dot := False;
+      Scan_Int := 0;
+      Scan_Exp := 0;
+      loop
+         case Buf (Pos) is
+            when '0' .. '9' =>
+               Scan_Int := Scan_Int * 10
+                 + Character'Pos (Buf (Pos)) - Character'Pos ('0');
+               if Has_Dot then
+                  Scan_Exp := Scan_Exp - 1;
+               end if;
+               Pos := Pos + 1;
+            when '.' =>
+               if Has_Dot then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               else
+                  Has_Dot := True;
+               end if;
+               Pos := Pos + 1;
+            when EOT =>
+               if Pos /= Buf_Len then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               exit when Buf_Len = 1;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      if Has_Dot then
+         return Tok_Rnumber;
+      else
+         return Tok_Dnumber;
+      end if;
+   end Scan_Number;
+
+   procedure Refill_Buf is
+   begin
+      Buf (1 .. Buf_Len - Pos) := Buf (Pos .. Buf_Len - 1);
+      Pos := Buf_Len - Pos + 1;
+      Read_Sdf;
+      Pos := 1;
+   end Refill_Buf;
+
+   procedure Skip_Spaces
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      --  Fast blanks skipping.
+      while Buf (Pos) = ' ' loop
+         Pos := Pos + 1;
+      end loop;
+
+      loop
+         --  Be sure there is at least 1 character.
+         if Pos + 1 >= Buf_Len then
+            Refill_Buf;
+         end if;
+
+         case Buf (Pos) is
+            when EOT =>
+               if Pos /= Buf_Len then
+                  return;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               if Buf_Len = 1 then
+                  return;
+               end if;
+            when LF =>
+               Pos := Pos + 1;
+               if Buf (Pos) = CR then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when CR =>
+               Pos := Pos + 1;
+               if Buf (Pos) = LF then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when ' '
+              | HT =>
+               Pos := Pos + 1;
+            when '/' =>
+               if Buf (Pos + 1) = '/' then
+                  Pos := Pos + 2;
+                  --  Skip line comment.
+                  loop
+                     exit when Buf (Pos) = CR;
+                     exit when Buf (Pos) = LF;
+                     exit when Buf (Pos) = EOT;
+                     Pos := Pos + 1;
+                     if Pos >= Buf_Len then
+                        Refill_Buf;
+                     end if;
+                  end loop;
+               else
+                  return;
+               end if;
+            when others =>
+               return;
+         end case;
+      end loop;
+   end Skip_Spaces;
+
+   function Get_Token return Sdf_Token_Type
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      Skip_Spaces;
+
+      --  Be sure there is at least 4 characters.
+      if Pos + 4 >= Buf_Len then
+         Refill_Buf;
+      end if;
+
+      case Buf (Pos) is
+         when EOT =>
+            if Buf_Len = 1 then
+               return Tok_Eof;
+            else
+               Error_Bad_Character;
+               return Tok_Error;
+            end if;
+         when '"' => -- "
+            Scan_Qstring;
+            return Tok_Qstring;
+         when '/' =>
+            --  Skip_Spaces has already handled line comments.
+            Pos := Pos + 1;
+            return Tok_Div;
+         when '.' =>
+            Pos := Pos + 1;
+            return Tok_Dot;
+         when ':' =>
+            Pos := Pos + 1;
+            return Tok_Cln;
+         when '(' =>
+            Pos := Pos + 1;
+            return Tok_Oparen;
+         when ')' =>
+            Pos := Pos + 1;
+            return Tok_Cparen;
+         when 'a' .. 'z'
+           | 'A' .. 'Z' =>
+            Scan_Identifier;
+            return Tok_Identifier;
+         when '0' .. '9' =>
+            return Scan_Number;
+         when others =>
+            Error_Bad_Character;
+            return Tok_Error;
+      end case;
+   end Get_Token;
+
+   function Is_White_Space (C : Character) return Boolean
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      case C is
+         when ' '
+           | HT
+           | CR
+           | LF =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_White_Space;
+
+   function Get_Edge_Token return Edge_Type
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      Skip_Spaces;
+
+      --  Be sure there is at least 4 characters.
+      if Pos + 4 >= Buf_Len then
+         Refill_Buf;
+      end if;
+
+      case Buf (Pos) is
+         when '0' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = 'z' then
+                  Pos := Pos + 2;
+                  return Edge_0z;
+               elsif Buf (Pos + 1) = '1' then
+                  Pos := Pos + 2;
+                  return Edge_01;
+               end if;
+            end if;
+         when '1' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = 'z' then
+                  Pos := Pos + 2;
+                  return Edge_1z;
+               elsif Buf (Pos + 1) = '0' then
+                  Pos := Pos + 2;
+                  return Edge_10;
+               end if;
+            end if;
+         when 'z' =>
+            if Is_White_Space (Buf (Pos + 2)) then
+               if Buf (Pos + 1) = '0' then
+                  Pos := Pos + 2;
+                  return Edge_Z0;
+               elsif Buf (Pos + 1) = '1' then
+                  Pos := Pos + 2;
+                  return Edge_Z1;
+               end if;
+            end if;
+         when 'p' =>
+            Scan_Identifier;
+            if Is_Ident ("posedge") then
+               return Edge_Posedge;
+            end if;
+         when 'n' =>
+            Scan_Identifier;
+            if Is_Ident ("negedge") then
+               return Edge_Negedge;
+            end if;
+         when others =>
+            null;
+      end case;
+      Error_Sdf ("edge_identifier expected");
+      return Edge_Error;
+   end Get_Edge_Token;
+
+   procedure Error_Sdf (Tok : Sdf_Token_Type)
+   is
+   begin
+      case Tok is
+         when Tok_Qstring =>
+            Error_Sdf ("qstring expected");
+         when Tok_Oparen =>
+            Error_Sdf ("'(' expected");
+         when Tok_Identifier =>
+            Error_Sdf ("identifier expected");
+         when Tok_Cln =>
+            Error_Sdf ("':' (colon) expected");
+         when others =>
+            Error_Sdf ("parse error");
+      end case;
+   end Error_Sdf;
+
+   function Expect (Tok : Sdf_Token_Type) return Boolean
+   is
+   begin
+      if Get_Token = Tok then
+         return True;
+      end if;
+      Error_Sdf (Tok);
+      return False;
+   end Expect;
+
+   function Expect_Cp_Op_Ident (Tok : Sdf_Token_Type) return Boolean
+   is
+   begin
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return False;
+      end if;
+      if not Expect (Tok_Oparen)
+        or else not Expect (Tok_Identifier)
+      then
+         return False;
+      end if;
+      return True;
+   end Expect_Cp_Op_Ident;
+
+   function Expect_Qstr_Cp_Op_Ident (Str : String) return Boolean
+   is
+      Tok : Sdf_Token_Type;
+   begin
+      if not Is_Ident (Str) then
+         return True;
+      end if;
+
+      Tok := Get_Token;
+      if Tok = Tok_Qstring then
+         Tok := Get_Token;
+      end if;
+
+      return Expect_Cp_Op_Ident (Tok);
+   end Expect_Qstr_Cp_Op_Ident;
+
+   procedure Start_Generic_Name (Kind : Timing_Generic_Kind) is
+   begin
+      Sdf_Context.Kind := Kind;
+      Sdf_Context.Port_Num := 0;
+      Sdf_Context.Ports (1).L := Invalid_Dnumber;
+      Sdf_Context.Ports (2).L := Invalid_Dnumber;
+      Sdf_Context.Ports (1).Edge := Edge_None;
+      Sdf_Context.Ports (2).Edge := Edge_None;
+   end Start_Generic_Name;
+
+   --  Status of a parsing.
+   --  ERROR: parse error (syntax is not correct)
+   --  ALTERN: alternate construct parsed (ie simple RNUMBER for tc_rvalue).
+   --  OPTIONAL: the construct is absent.
+   --  FOUND: the construct is present.
+   --  SET: the construct is present and a value was extracted from.
+   type Parse_Status_Type is
+     (
+      Status_Error,
+      Status_Altern,
+      Status_Optional,
+      Status_Found,
+      Status_Set
+     );
+
+   function Num_To_Time return Ghdl_I64
+   is
+      Res : Ghdl_I64;
+   begin
+      Res := Ghdl_I64 (Scan_Int) * Ghdl_I64 (Sdf_Context.Timescale);
+      while Scan_Exp < 0 loop
+         Res := Res / 10;
+         Scan_Exp := Scan_Exp + 1;
+      end loop;
+      return Res;
+   end Num_To_Time;
+
+   --  Parse: REXPRESSION? ')'
+   procedure Parse_Rexpression
+     (Status : out Parse_Status_Type; Val : out Ghdl_I64)
+   is
+      Tok : Sdf_Token_Type;
+
+      procedure Pr_Rnumber (Mtm : Mtm_Type)
+      is
+      begin
+         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+            if Mtm = Sdf_Mtm then
+               Val := Num_To_Time;
+               Status := Status_Set;
+            elsif Status /= Status_Set then
+               Status := Status_Found;
+            end if;
+            Tok := Get_Token;
+         end if;
+      end Pr_Rnumber;
+
+      function Pr_Colon return Boolean
+      is
+      begin
+         if Tok /= Tok_Cln then
+            Error_Sdf (Tok_Cln);
+            Status := Status_Error;
+            return False;
+         else
+            Tok := Get_Token;
+            return True;
+         end if;
+      end Pr_Colon;
+
+   begin
+      Val := 0;
+      Tok := Get_Token;
+      Status := Status_Error;
+      if Tok = Tok_Cparen then
+         Status := Status_Optional;
+         return;
+      end if;
+
+      Pr_Rnumber (Minimum);
+
+      if not Pr_Colon then
+         return;
+      end if;
+
+      Pr_Rnumber (Typical);
+
+      if not Pr_Colon then
+         return;
+      end if;
+
+      Pr_Rnumber (Maximum);
+
+      if Status = Status_Error then
+         Error_Sdf ("at least one number required in an rexpression");
+         return;
+      end if;
+
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         Status := Status_Error;
+      end if;
+   end Parse_Rexpression;
+
+   function Expect_Rexpr_Cp_Op_Ident return Boolean
+   is
+      Status : Parse_Status_Type;
+      Val : Ghdl_I64;
+   begin
+      Parse_Rexpression (Status, Val);
+      if Status = Status_Error then
+         return False;
+      end if;
+      if not Expect (Tok_Oparen)
+        or else not Expect (Tok_Identifier)
+      then
+         Error_Sdf (Tok_Identifier);
+         return False;
+      end if;
+      return True;
+   end Expect_Rexpr_Cp_Op_Ident;
+
+   function To_Lower (C : Character) return Character is
+   begin
+      if C >= 'A' and C <= 'Z' then
+         return Character'Val (Character'Pos (C)
+                               - Character'Pos ('A') + Character'Pos ('a'));
+      else
+         return C;
+      end if;
+   end To_Lower;
+
+   function Parse_Port_Path1 (Tok : Sdf_Token_Type) return Boolean
+   is
+      Port_Spec : Port_Spec_Type
+         renames Sdf_Context.Ports (Sdf_Context.Port_Num);
+      Len : Natural;
+   begin
+      if Tok /= Tok_Identifier then
+         Error_Sdf ("port path expected");
+         return False;
+      end if;
+      Len := 0;
+      for I in Ident_Start .. Ident_End loop
+         Len := Len + 1;
+         Port_Spec.Name (Len) := To_Lower (Buf (I));
+      end loop;
+      Port_Spec.Name_Len := Len;
+
+      --  Parse   [ DNUMBER ]
+      --        | [ DNUMBER : DNUMBER ]
+      Skip_Spaces;
+      if Buf (Pos) = '[' then
+         Port_Spec.R := Invalid_Dnumber;
+         Pos := Pos + 1;
+         if Get_Token /= Tok_Dnumber then
+            Error_Sdf (Tok);
+         else
+            Port_Spec.L := Ghdl_I32 (Scan_Int);
+         end if;
+         Skip_Spaces;
+         if Buf (Pos) = ':' then
+            Pos := Pos + 1;
+            if Get_Token /= Tok_Dnumber then
+               Error_Sdf (Tok);
+            else
+               Port_Spec.R := Ghdl_I32 (Scan_Int);
+            end if;
+            Skip_Spaces;
+         end if;
+         if Buf (Pos) /= ']' then
+            Error_Sdf ("']' expected");
+         else
+            Pos := Pos + 1;
+         end if;
+      end if;
+
+      return True;
+   end Parse_Port_Path1;
+
+   function Parse_Port_Path return Boolean
+   is
+   begin
+      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
+      return Parse_Port_Path1 (Get_Token);
+   end Parse_Port_Path;
+
+   function Parse_Port_Spec return Boolean
+   is
+      Tok : Sdf_Token_Type;
+      Edge : Edge_Type;
+   begin
+      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
+      Tok := Get_Token;
+      if Tok = Tok_Identifier then
+         return Parse_Port_Path1 (Tok);
+      elsif Tok /= Tok_Oparen then
+         Error_Sdf ("port spec expected");
+         return False;
+      end if;
+      Edge := Get_Edge_Token;
+      if Edge = Edge_Error then
+         return False;
+      end if;
+      Sdf_Context.Ports (Sdf_Context.Port_Num).Edge := Edge;
+      if not Parse_Port_Path1 (Get_Token) then
+         return False;
+      end if;
+      if Get_Token /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return False;
+      end if;
+      return True;
+   end Parse_Port_Spec;
+
+   function Parse_Port_Tchk return Boolean renames Parse_Port_Spec;
+
+   --  tc_rvalue ::= ( RNUMBER )
+   --            ||= ( rexpression )
+   --  Return status_optional for ( )
+   function Parse_Tc_Rvalue return Parse_Status_Type
+   is
+      Tok : Sdf_Token_Type;
+      Res : Parse_Status_Type;
+   begin
+      --  '('
+      if Get_Token /= Tok_Oparen then
+         Error_Sdf (Tok_Oparen);
+         return Status_Error;
+      end if;
+      Res := Status_Found;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         Sdf_Context.Timing (1) := Num_To_Time;
+         Tok := Get_Token;
+         if Tok = Tok_Cparen then
+            --  This is a simple RNUMBER.
+            return Status_Altern;
+         end if;
+         if Sdf_Mtm = Minimum then
+            Res := Status_Set;
+         end if;
+      end if;
+      if Tok = Tok_Cparen then
+         return Status_Optional;
+      end if;
+      if Tok /= Tok_Cln then
+         Error_Sdf (Tok_Cln);
+         return Status_Error;
+      end if;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         if Sdf_Mtm = Typical then
+            Sdf_Context.Timing (1) := Num_To_Time;
+            Res := Status_Set;
+         end if;
+         Tok := Get_Token;
+      end if;
+      if Tok /= Tok_Cln then
+         Error_Sdf (Tok_Cln);
+         return Status_Error;
+      end if;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         if Sdf_Mtm = Maximum then
+            Sdf_Context.Timing (1) := Num_To_Time;
+            Res := Status_Set;
+         end if;
+         Tok := Get_Token;
+      end if;
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return Status_Error;
+      end if;
+      return Res;
+   end Parse_Tc_Rvalue;
+
+   function Parse_Simple_Tc_Rvalue return Boolean is
+   begin
+      Sdf_Context.Timing_Nbr := 0;
+
+      case Parse_Tc_Rvalue is
+         when Status_Error
+           | Status_Optional =>
+            return False;
+         when Status_Altern =>
+            null;
+         when Status_Found =>
+            Sdf_Context.Timing_Set (1) := False;
+         when Status_Set =>
+            Sdf_Context.Timing_Set (1) := True;
+      end case;
+      return True;
+   end Parse_Simple_Tc_Rvalue;
+
+   --  rvalue ::= ( RNUMBER )
+   --         ||= rexp_list
+   --  Parse: rvalue )
+   function Parse_Rvalue return Boolean
+   is
+      Tok : Sdf_Token_Type;
+   begin
+      Sdf_Context.Timing_Nbr := 0;
+      Sdf_Context.Timing_Set := (others => False);
+
+      case Parse_Tc_Rvalue is
+         when Status_Error =>
+            return False;
+         when Status_Altern =>
+            Sdf_Context.Timing_Nbr := 1;
+            if Get_Token /= Tok_Cparen then
+               Error_Sdf (Tok_Cparen);
+            end if;
+            return True;
+         when Status_Found
+           | Status_Optional =>
+            null;
+         when Status_Set =>
+            Sdf_Context.Timing_Set (1) := True;
+      end case;
+
+      Sdf_Context.Timing_Nbr := 1;
+      loop
+         Tok := Get_Token;
+         exit when Tok = Tok_Cparen;
+         if Tok /= Tok_Oparen then
+            Error_Sdf (Tok_Oparen);
+            return False;
+         end if;
+
+         Sdf_Context.Timing_Nbr := Sdf_Context.Timing_Nbr + 1;
+         declare
+            Status : Parse_Status_Type;
+            Val : Ghdl_I64;
+         begin
+            Parse_Rexpression (Status, Val);
+            case Status is
+               when Status_Error
+                 | Status_Altern =>
+                  return False;
+               when Status_Optional
+                 | Status_Found =>
+                  null;
+               when Status_Set =>
+                  Sdf_Context.Timing_Set (Sdf_Context.Timing_Nbr) := True;
+                  Sdf_Context.Timing (Sdf_Context.Timing_Nbr) := Val;
+            end case;
+         end;
+      end loop;
+      if Boolean'(False) then
+         --  Do not expand here, since the most used is 01.
+         case Sdf_Context.Timing_Nbr is
+            when 1 =>
+               for I in 2 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
+               end loop;
+            when 2 =>
+               for I in 3 .. 4 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
+               end loop;
+               for I in 5 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (2);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (2);
+               end loop;
+            when 3 =>
+               for I in 4 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (I - 3);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (I - 3);
+               end loop;
+            when 6
+              | 12 =>
+               null;
+            when others =>
+               Error_Sdf ("bad number of rvalue");
+               return False;
+         end case;
+      end if;
+      return True;
+   end Parse_Rvalue;
+
+   function Handle_Generic return Boolean
+   is
+      Name : String (1 .. 1024);
+      Len : Natural;
+
+      procedure Start (Str : String) is
+      begin
+         Name (1 .. Str'Length) := Str;
+         Len := Str'Length;
+      end Start;
+
+      procedure Add (Str : String)
+      is
+         Nlen : Natural;
+      begin
+         Len := Len + 1;
+         Name (Len) := '_';
+         Nlen := Len + Str'Length;
+         Name (Len + 1 .. Nlen) := Str;
+         Len := Nlen;
+      end Add;
+
+      procedure Add_Edge (Edge : Edge_Type; Force : Boolean) is
+      begin
+         case Edge is
+            when Edge_Posedge =>
+               Add ("posedge");
+            when Edge_Negedge =>
+               Add ("negedge");
+            when Edge_01 =>
+               Add ("01");
+            when Edge_10 =>
+               Add ("10");
+            when Edge_0z =>
+               Add ("0z");
+            when Edge_Z1 =>
+               Add ("Z1");
+            when Edge_1z =>
+               Add ("1z");
+            when Edge_Z0 =>
+               Add ("ZO");
+            when Edge_None =>
+               if Force then
+                  Add ("noedge");
+               end if;
+            when Edge_Error =>
+               Add ("?");
+         end case;
+      end Add_Edge;
+
+      Ok : Boolean;
+   begin
+      case Sdf_Context.Kind is
+         when Delay_Iopath =>
+            Start ("tpd");
+         when Delay_Port =>
+            Start ("tipd");
+         when Timingcheck_Setup =>
+            Start ("tsetup");
+         when Timingcheck_Hold =>
+            Start ("thold");
+         when Timingcheck_Setuphold =>
+            Start ("tsetup");
+         when Timingcheck_Recovery =>
+            Start ("trecovery");
+         when Timingcheck_Skew =>
+            Start ("tskew");
+         when Timingcheck_Width =>
+            Start ("tpw");
+         when Timingcheck_Period =>
+            Start ("tperiod");
+         when Timingcheck_Nochange =>
+            Start ("tncsetup");
+      end case;
+      for I in 1 .. Sdf_Context.Port_Num loop
+         Add (Sdf_Context.Ports (I).Name
+              (1 .. Sdf_Context.Ports (I).Name_Len));
+      end loop;
+      if Sdf_Context.Kind in Timing_Generic_Full_Condition then
+         Add_Edge (Sdf_Context.Ports (1).Edge, True);
+         Add_Edge (Sdf_Context.Ports (2).Edge, False);
+      elsif Sdf_Context.Kind in Timing_Generic_Simple_Condition then
+         Add_Edge (Sdf_Context.Ports (1).Edge, False);
+      end if;
+      Vital_Annotate.Sdf_Generic (Sdf_Context.all, Name (1 .. Len), Ok);
+      if not Ok then
+         Error_Sdf_C;
+         Error_C ("could not annotate generic ");
+         Error_E (Name (1 .. Len));
+         return False;
+      end if;
+      return True;
+   end Handle_Generic;
+
+   function Parse_Sdf return Boolean
+   is
+      Tok : Sdf_Token_Type;
+      Ok : Boolean;
+   begin
+      if Get_Token /= Tok_Oparen
+        or else Get_Token /= Tok_Identifier
+        or else not Is_Ident ("DELAYFILE")
+        or else Get_Token /= Tok_Oparen
+        or else Get_Token /= Tok_Identifier
+      then
+         Error_Sdf ("not an SDF file");
+         return False;
+      end if;
+
+      if Is_Ident ("SDFVERSION") then
+         Tok := Get_Token;
+         if Tok = Tok_Qstring then
+            Sdf_Context.Version := Sdf_Version_Bad;
+            if Ident_Length = 3 and then Buf (Ident_Start + 1) = '.' then
+               --  Version has the format '"X.Y"' (without simple quote).
+               if Buf (Ident_Start) = '2'
+                 and then Buf (Ident_Start + 2) = '1'
+               then
+                  Sdf_Context.Version := Sdf_2_1;
+               end if;
+            end if;
+            Tok := Get_Token;
+         end if;
+
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("DESIGN") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("DATE") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("VENDOR") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("PROGRAM") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("VERSION") then
+         return False;
+      end if;
+
+      if Is_Ident ("DIVIDER") then
+         Tok := Get_Token;
+         if Tok = Tok_Div or Tok = Tok_Dot then
+            Tok := Get_Token;
+         end if;
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      if Is_Ident ("VOLTAGE") then
+         if not Expect_Rexpr_Cp_Op_Ident then
+            return False;
+         end if;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("PROCESS") then
+         return False;
+      end if;
+
+      if Is_Ident ("TEMPERATURE") then
+         if not Expect_Rexpr_Cp_Op_Ident then
+            return False;
+         end if;
+      end if;
+
+      if Is_Ident ("TIMESCALE") then
+         Tok := Get_Token;
+         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+            if Scan_Exp = 0 and (Scan_Int = 1
+                                 or Scan_Int = 10
+                                 or Scan_Int = 100)
+            then
+               Sdf_Context.Timescale := Scan_Int;
+            else
+               Error_Sdf ("bad timescale value");
+               return False;
+            end if;
+            Tok := Get_Token;
+            if Tok /= Tok_Identifier then
+               Error_Sdf (Tok_Identifier);
+            end if;
+            if Is_Ident ("ps") then
+               null;
+            elsif Is_Ident ("ns") then
+               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000;
+            elsif Is_Ident ("us") then
+               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000_000;
+            else
+               Error_Sdf ("bad timescale unit");
+               return False;
+            end if;
+            Tok := Get_Token;
+         end if;
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      Vital_Annotate.Sdf_Header (Sdf_Context.all);
+
+      --  Parse cell+
+      loop
+         if not Is_Ident ("CELL") then
+            Error_Sdf ("CELL expected");
+            return False;
+         end if;
+         --  Parse celltype
+         if Get_Token /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+           or else not Is_Ident ("CELLTYPE")
+           or else Get_Token /= Tok_Qstring
+         then
+            Error_Sdf ("CELLTYPE expected");
+            return False;
+         end if;
+         Sdf_Context.Celltype_Len := Ident_Length;
+         if Sdf_Context.Celltype_Len > Sdf_Context.Celltype'Length then
+            Error_Sdf ("CELLTYPE qstring is too long");
+            return False;
+         end if;
+         for I in Ident_Start .. Ident_End loop
+            Sdf_Context.Celltype (I - Ident_Start + 1) := To_Lower (Buf (I));
+         end loop;
+         Vital_Annotate.Sdf_Celltype (Sdf_Context.all);
+         if Get_Token /= Tok_Cparen
+           or else Get_Token /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+           or else not Is_Ident ("INSTANCE")
+         then
+            Error_Sdf ("INSTANCE expected");
+            return False;
+         end if;
+         --  Parse instance+
+         loop
+            exit when not Is_Ident ("INSTANCE");
+            Tok := Get_Token;
+            if Tok /= Tok_Cparen then
+               loop
+                  if Tok /= Tok_Identifier then
+                     Error_Sdf ("instance identifier expected");
+                     return False;
+                  end if;
+                  for I in Ident_Start .. Ident_End loop
+                     Buf (I) := To_Lower (Buf (I));
+                  end loop;
+                  Vital_Annotate.Sdf_Instance
+                    (Sdf_Context.all, Buf (Ident_Start .. Ident_End), Ok);
+                  if not Ok then
+                     Error_Sdf ("cannot find instance");
+                     return False;
+                  end if;
+                  Tok := Get_Token;
+                  exit when Tok /= Tok_Dot;
+                  Tok := Get_Token;
+               end loop;
+            end if;
+            if Tok /= Tok_Cparen
+              or else Get_Token /= Tok_Oparen
+              or else Get_Token /= Tok_Identifier
+            then
+               Error_Sdf ("instance or timing_spec expected");
+               return False;
+            end if;
+         end loop;
+         Vital_Annotate.Sdf_Instance_End (Sdf_Context.all, Ok);
+         if not Ok then
+            Error_Sdf ("bad instance or celltype mistmatch");
+            return False;
+         end if;
+
+         --  Parse timing_spec+
+         loop
+            if Is_Ident ("DELAY") then
+               --  Parse deltype+
+               Tok := Get_Token;
+               loop
+                  if Tok /= Tok_Oparen
+                    or else Get_Token /= Tok_Identifier
+                  then
+                     Error_Sdf ("deltype expected");
+                     return False;
+                  end if;
+                  if Is_Ident ("PATHPULSE")
+                    or else Is_Ident ("GLOBALPATHPULSE")
+                  then
+                     Error_Sdf ("PATHPULSE and GLOBALPATHPULSE not allowed");
+                     return False;
+                  end if;
+                  if Is_Ident ("ABSOLUTE") then
+                     null;
+                  elsif Is_Ident ("INCREMENT") then
+                     null;
+                  else
+                     Error_Sdf ("ABSOLUTE or INCREMENT expected");
+                     return False;
+                  end if;
+                  --  Parse absvals+ or incvals+
+                  Tok := Get_Token;
+                  loop
+                     if Tok /= Tok_Oparen
+                       or else Get_Token /= Tok_Identifier
+                     then
+                        Error_Sdf ("absvals or incvals expected");
+                        return False;
+                     end if;
+                     if Is_Ident ("IOPATH") then
+                        Start_Generic_Name (Delay_Iopath);
+                        if not Parse_Port_Spec
+                          or else not Parse_Port_Path
+                          or else not Parse_Rvalue
+                        then
+                           return False;
+                        end if;
+                     elsif Is_Ident ("PORT") then
+                        Start_Generic_Name (Delay_Port);
+                        if not Parse_Port_Path
+                          or else not Parse_Rvalue
+                        then
+                           return False;
+                        end if;
+                     elsif Is_Ident ("COND")
+                       or else Is_Ident ("INTERCONNECT")
+                       or else Is_Ident ("DEVICE")
+                     then
+                        Error_Sdf
+                          ("COND, INTERCONNECT, or DEVICE not handled");
+                        return False;
+                     elsif Is_Ident ("NETDELAY") then
+                        Error_Sdf ("NETDELAY not allowed in VITAL SDF");
+                        return False;
+                     else
+                        Error_Sdf ("absvals or incvals expected");
+                        return False;
+                     end if;
+
+                     if not Handle_Generic then
+                        return False;
+                     end if;
+
+                     Tok := Get_Token;
+                     exit when Tok = Tok_Cparen;
+                  end loop;
+                  Tok := Get_Token;
+                  exit when Tok = Tok_Cparen;
+               end loop;
+            elsif Is_Ident ("TIMINGCHECK") then
+               --  parse tc_def+
+               Tok := Get_Token;
+               loop
+                  if Tok /= Tok_Oparen
+                    or else Get_Token /= Tok_Identifier
+                  then
+                     Error_Sdf ("tc_def expected");
+                     return False;
+                  end if;
+                  if Is_Ident ("SETUP") then
+                     Start_Generic_Name (Timingcheck_Setup);
+                  elsif Is_Ident ("HOLD") then
+                     Start_Generic_Name (Timingcheck_Hold);
+                  elsif Is_Ident ("SETUPHOLD") then
+                     Start_Generic_Name (Timingcheck_Setuphold);
+                  elsif Is_Ident ("RECOVERY") then
+                     Start_Generic_Name (Timingcheck_Recovery);
+                  elsif Is_Ident ("SKEW") then
+                     Start_Generic_Name (Timingcheck_Skew);
+                  elsif Is_Ident ("WIDTH") then
+                     Start_Generic_Name (Timingcheck_Width);
+                  elsif Is_Ident ("PERIOD") then
+                     Start_Generic_Name (Timingcheck_Period);
+                  elsif Is_Ident ("NOCHANGE") then
+                     Start_Generic_Name (Timingcheck_Nochange);
+                  elsif Is_Ident ("PATHCONSTRAINT")
+                    or else Is_Ident ("SUM")
+                    or else Is_Ident ("DIFF")
+                    or else Is_Ident ("SKEWCONSTRAINT")
+                  then
+                     Error_Sdf ("non-VITAL tc_def");
+                     return False;
+                  else
+                     Error_Sdf ("bad tc_def");
+                     return False;
+                  end if;
+
+                  case Sdf_Context.Kind is
+                     when Timingcheck_Setup
+                       | Timingcheck_Hold
+                       | Timingcheck_Recovery
+                       | Timingcheck_Skew
+                       | Timingcheck_Setuphold
+                       | Timingcheck_Nochange =>
+                        if not Parse_Port_Tchk
+                          or else not Parse_Port_Tchk
+                          or else not Parse_Simple_Tc_Rvalue
+                        then
+                           return False;
+                        end if;
+                     when Timingcheck_Width
+                       | Timingcheck_Period =>
+                        if not Parse_Port_Tchk
+                          or else not Parse_Simple_Tc_Rvalue
+                        then
+                           return False;
+                        end if;
+                     when others =>
+                        Internal_Error ("sdf_parse");
+                  end case;
+
+                  if not Handle_Generic then
+                     return False;
+                  end if;
+
+                  case Sdf_Context.Kind is
+                     when Timingcheck_Setuphold
+                       | Timingcheck_Nochange =>
+                        if not Parse_Simple_Tc_Rvalue then
+                           return False;
+                        end if;
+                        Error_Sdf ("setuphold and nochange not yet handled");
+                        return False;
+                     when others =>
+                        null;
+                  end case;
+
+                  if Get_Token /= Tok_Cparen then
+                     Error_Sdf (Tok_Cparen);
+                     return False;
+                  end if;
+                  Tok := Get_Token;
+                  exit when Tok = Tok_Cparen;
+               end loop;
+            end if;
+            Tok := Get_Token;
+            exit when Tok = Tok_Cparen;
+            if Tok /= Tok_Oparen then
+               Error_Sdf (Tok_Oparen);
+               return False;
+            end if;
+            if Get_Token /= Tok_Identifier then
+               Error_Sdf (Tok_Identifier);
+               return False;
+            end if;
+         end loop;
+         Tok := Get_Token;
+         exit when Tok = Tok_Cparen;
+         if Tok /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+         then
+            Error_Sdf (Tok_Identifier);
+         end if;
+      end loop;
+      if Get_Token /= Tok_Eof then
+         Error_Sdf ("EOF expected");
+         return False;
+      end if;
+      return True;
+   end Parse_Sdf;
+
+   function Parse_Sdf_File (Filename : String) return Boolean
+   is
+      Res : Boolean;
+   begin
+      if not Open_Sdf (Filename) then
+         return False;
+      end if;
+      Res := Parse_Sdf;
+      Close_Sdf;
+      return Res;
+   end Parse_Sdf_File;
+
+end Grt.Sdf;
diff --git a/src/translate/grt/grt-sdf.ads b/src/translate/grt/grt-sdf.ads
new file mode 100644
index 000000000..fd05b9e20
--- /dev/null
+++ b/src/translate/grt/grt-sdf.ads
@@ -0,0 +1,131 @@
+--  GHDL Run Time (GRT) - SDF parser.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+
+package Grt.Sdf is
+   type Edge_Type is
+     (
+      Edge_Error,
+      Edge_None,
+      Edge_Posedge,
+      Edge_Negedge,
+      Edge_01,
+      Edge_10,
+      Edge_0z,
+      Edge_Z1,
+      Edge_1z,
+      Edge_Z0
+     );
+
+   type Timing_Generic_Kind is
+     (
+      Delay_Port,
+      --Delay_Interconnect,
+      --Delay_Device,
+
+      --  Simple condition
+      Delay_Iopath,
+      Timingcheck_Width,
+      Timingcheck_Period,
+
+      --  Full condition
+      Timingcheck_Setup,
+      Timingcheck_Hold,
+      Timingcheck_Recovery,
+      Timingcheck_Skew,
+      Timingcheck_Nochange,
+      Timingcheck_Setuphold
+     );
+
+   subtype Timing_Generic_Simple_Condition is Timing_Generic_Kind
+     range Delay_Iopath .. Timingcheck_Period;
+
+   subtype Timing_Generic_Full_Condition is Timing_Generic_Kind
+     range Timingcheck_Setup .. Timingcheck_Setuphold;
+
+   type Sdf_Version_Type is
+     (
+      Sdf_2_1,
+      Sdf_Version_Unknown,
+      Sdf_Version_Bad
+     );
+
+   Read_Size : constant Natural := 4096;
+   Buf_Size : constant Natural := Read_Size + 1024 + 1;
+
+   Invalid_Dnumber : constant Ghdl_I32 := -1;
+
+   type Port_Spec_Type is record
+      --  Port identifier.
+      Name : String (1 .. 128);
+      Name_Len : Natural;
+
+      --  Left and Right range.
+      --  If L = R = Invalid_Dnumber, this is a simple scalar port.
+      --  If R = Invalid_Dnumber, this is a scalar port (from a vector)
+      --  Otherwise, this is a bus port.
+      L, R : Ghdl_I32;
+
+   -- Cond : String (1 .. 1024);
+   -- Cond_Len : Natural;
+
+      Edge : Edge_Type;
+   end record;
+
+   type Port_Spec_Array_Type is array (Natural range <>) of Port_Spec_Type;
+
+   type Ghdl_I64_Array is array (1 .. 12) of Ghdl_I64;
+   type Boolean_Array is array (1 .. 12) of Boolean;
+
+   type Sdf_Context_Type is record
+      --  Version of the SDF file.
+      Version : Sdf_Version_Type;
+
+      --  Timescale; 1 corresponds to 1 ps.
+      --  Default is 1000 (1 ns).
+      Timescale : Natural;
+
+      Kind : Timing_Generic_Kind;
+
+      --  Cell type.
+      Celltype : String (1 .. 128);
+      Celltype_Len : Natural;
+
+      --  Current port.
+      Port_Num : Natural;
+      Ports : Port_Spec_Array_Type (1 .. 2);
+
+      --  timing spec.
+      Timing : Ghdl_I64_Array;
+      Timing_Set : Boolean_Array;
+      Timing_Nbr : Natural;
+   end record;
+
+   --  Which value is extracted.
+   type Mtm_Type is (Minimum, Typical, Maximum);
+   Sdf_Mtm : Mtm_Type := Typical;
+
+   function Parse_Sdf_File (Filename : String) return Boolean;
+end Grt.Sdf;
diff --git a/src/translate/grt/grt-shadow_ieee.adb b/src/translate/grt/grt-shadow_ieee.adb
new file mode 100644
index 000000000..32af4be5d
--- /dev/null
+++ b/src/translate/grt/grt-shadow_ieee.adb
@@ -0,0 +1,32 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Shadow_Ieee is
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV is
+   begin
+      Internal_Error ("resolved_RESOLV from shadow ieee called");
+   end Ieee_Std_Logic_1164_Resolved_RESOLV;
+end Grt.Shadow_Ieee;
diff --git a/src/translate/grt/grt-shadow_ieee.ads b/src/translate/grt/grt-shadow_ieee.ads
new file mode 100644
index 000000000..f12b4792f
--- /dev/null
+++ b/src/translate/grt/grt-shadow_ieee.ads
@@ -0,0 +1,41 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+--  This packages provides dummy declaration for main IEEE.STD_LOGIC_1164
+--  type descriptors.
+--  The package must not have elaboration code, since the actual type
+--  descriptors are not writable (they are constant).  Making it preelaborated
+--  is not enough, the variables must be initialized.  This current
+--  implementation provides bad values; this is not a problem since they are
+--  not read in grt.
+
+package Grt.Shadow_Ieee is
+   pragma Preelaborate (Grt.Shadow_Ieee);
+
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV;
+private
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_RESOLV,
+                  "ieee__std_logic_1164__resolved_RESOLV");
+end Grt.Shadow_Ieee;
diff --git a/src/translate/grt/grt-signals.adb b/src/translate/grt/grt-signals.adb
new file mode 100644
index 000000000..9698d8178
--- /dev/null
+++ b/src/translate/grt/grt-signals.adb
@@ -0,0 +1,3400 @@
+--  GHDL Run Time (GRT) - signals management.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Ada.Unchecked_Deallocation;
+with Grt.Errors; use Grt.Errors;
+with Grt.Processes; use Grt.Processes;
+with Grt.Options; use Grt.Options;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+with Grt.Disp_Signals;
+with Grt.Astdio;
+with Grt.Stdio;
+with Grt.Threads; use Grt.Threads;
+
+package body Grt.Signals is
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Transaction, Name => Transaction_Acc);
+
+   procedure Free_In (Trans : Transaction_Acc)
+   is
+      Ntrans : Transaction_Acc;
+   begin
+      Ntrans := Trans;
+      Free (Ntrans);
+   end Free_In;
+   pragma Inline (Free_In);
+
+   --  RTI for the current signal.
+   Sig_Rti : Ghdl_Rtin_Object_Acc;
+
+   --  Signal mode (and flags) for the current signal.
+   Sig_Mode : Mode_Signal_Type;
+   Sig_Has_Active : Boolean;
+   Sig_Kind : Kind_Signal_Type;
+
+   --  Last created implicit signal.  This is used to add dependencies on
+   --  the prefix.
+   Last_Implicit_Signal : Ghdl_Signal_Ptr;
+
+   --  Current signal resolver.
+   Current_Resolv : Resolved_Signal_Acc := null;
+
+   function Get_Current_Mode_Signal return Mode_Signal_Type is
+   begin
+      return Sig_Mode;
+   end Get_Current_Mode_Signal;
+
+   procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
+                                   Ctxt : Ghdl_Rti_Access;
+                                   Addr : Address)
+   is
+      pragma Unreferenced (Ctxt);
+      pragma Unreferenced (Addr);
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc (Sig);
+      Sig_Mode := Mode_Signal_Type'Val
+        (Sig.Mode and Ghdl_Rti_Signal_Mode_Mask);
+      Sig_Kind := Kind_Signal_Type'Val
+        ((Sig.Mode and Ghdl_Rti_Signal_Kind_Mask)
+         / Ghdl_Rti_Signal_Kind_Offset);
+      Sig_Has_Active :=
+        (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0;
+   end Ghdl_Signal_Name_Rti;
+
+   procedure Ghdl_Signal_Set_Mode (Mode : Mode_Signal_Type;
+                                   Kind : Kind_Signal_Type;
+                                   Has_Active : Boolean) is
+   begin
+      Sig_Rti := null;
+      Sig_Mode := Mode;
+      Sig_Kind := Kind;
+      Sig_Has_Active := Has_Active;
+   end Ghdl_Signal_Set_Mode;
+
+   function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean is
+   begin
+      return Sig.Sig_Kind /= Kind_Signal_No;
+   end Is_Signal_Guarded;
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Signal_Ptr, Target => Address);
+
+   function Create_Signal
+     (Mode : Mode_Type;
+      Init_Val : Value_Union;
+      Mode_Sig : Mode_Signal_Type;
+      Resolv_Proc : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+      Resolv : Resolved_Signal_Acc;
+      S : Ghdl_Signal_Data (Mode_Sig);
+   begin
+      Sig_Table.Increment_Last;
+
+      if Current_Resolv = null then
+         if Resolv_Proc /= null then
+            Resolv := new Resolved_Signal_Type'
+              (Resolv_Proc => Resolv_Proc,
+               Resolv_Inst => Resolv_Inst,
+               Resolv_Ptr => Null_Address,
+               Sig_Range => (Sig_Table.Last, Sig_Table.Last),
+               Disconnect_Time => Bad_Time);
+         else
+            Resolv := null;
+         end if;
+      else
+         if Resolv_Proc /= null then
+            --  Only one resolution function is allowed!
+            Internal_Error ("create_signal");
+         end if;
+         Resolv := Current_Resolv;
+         if Current_Resolv.Sig_Range.Last = Sig_Table.Last then
+            Current_Resolv := null;
+         end if;
+      end if;
+
+      case Mode_Sig is
+         when Mode_Signal_User =>
+            S.Nbr_Drivers := 0;
+            S.Drivers := null;
+            S.Effective := null;
+            S.Resolv := Resolv;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            S.Conv := null;
+         when Mode_Stable
+           | Mode_Quiet
+           | Mode_Delayed =>
+            S.Time := 0;
+         when Mode_Guard =>
+            S.Guard_Func := null;
+            S.Guard_Instance := System.Null_Address;
+         when Mode_Transaction
+           | Mode_End =>
+            null;
+      end case;
+
+      Res := new Ghdl_Signal'(Value => Init_Val,
+                              Driving_Value => Init_Val,
+                              Last_Value => Init_Val,
+                              --  Note: use -Std_Time'last instead of
+                              --  Std_Time'First so that NOW - x'last_event
+                              --  returns time'high at initialization!
+                              Last_Event => -Std_Time'Last,
+                              Last_Active => -Std_Time'Last,
+                              Event => False,
+                              Active => False,
+                              Has_Active => False,
+                              Sig_Kind => Sig_Kind,
+
+                              Is_Direct_Active => False,
+                              Mode => Mode,
+                              Flags => (Propag => Propag_None,
+                                        Is_Dumped => False,
+                                        Cyc_Event => False,
+                                        Seen => False),
+
+                              Net => No_Signal_Net,
+                              Link => null,
+                              Alink => null,
+                              Flink => null,
+
+                              Event_List => null,
+                              Rti => Sig_Rti,
+
+                              Nbr_Ports => 0,
+                              Ports => null,
+
+                              S => S);
+
+      if Resolv /= null and then Resolv.Resolv_Ptr = System.Null_Address then
+         Resolv.Resolv_Ptr := To_Address (Res);
+      end if;
+
+      case Flag_Activity is
+         when Activity_All =>
+            Res.Has_Active := True;
+         when Activity_Minimal =>
+            Res.Has_Active := Sig_Has_Active;
+         when Activity_None =>
+            Res.Has_Active := False;
+      end case;
+
+      --  Put the signal in the table.
+      Sig_Table.Table (Sig_Table.Last) := Res;
+
+      return Res;
+   end Create_Signal;
+
+   procedure Ghdl_Signal_Init (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is
+   begin
+      Sig.Value := Val;
+      Sig.Driving_Value := Val;
+      Sig.Last_Value := Val;
+   end Ghdl_Signal_Init;
+
+   procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
+                                    Rti : Ghdl_Rti_Access)
+   is
+      S_Rti : Ghdl_Rtin_Object_Acc;
+   begin
+      S_Rti := To_Ghdl_Rtin_Object_Acc (Rti);
+      if Flag_Activity = Activity_Minimal then
+         if (S_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then
+            Sig.Has_Active := True;
+         end if;
+      end if;
+   end Ghdl_Signal_Merge_Rti;
+
+   procedure Ghdl_Signal_Create_Resolution (Proc : Resolver_Acc;
+                                            Instance : System.Address;
+                                            Sig : System.Address;
+                                            Nbr_Sig : Ghdl_Index_Type)
+   is
+   begin
+      if Current_Resolv /= null then
+         Internal_Error ("Ghdl_Signal_Create_Resolution");
+      end if;
+      Current_Resolv := new Resolved_Signal_Type'
+        (Resolv_Proc => Proc,
+         Resolv_Inst => Instance,
+         Resolv_Ptr => Sig,
+         Sig_Range => (First => Sig_Table.Last + 1,
+                       Last => Sig_Table.Last + Sig_Table_Index (Nbr_Sig)),
+         Disconnect_Time => Bad_Time);
+   end Ghdl_Signal_Create_Resolution;
+
+   procedure Check_New_Source (Sig : Ghdl_Signal_Ptr)
+   is
+      use Grt.Stdio;
+      use Grt.Astdio;
+   begin
+      if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then
+         if Sig.S.Resolv = null then
+            --  LRM 4.3.1.2 Signal Declaration
+            --  It is an error if, after the elaboration of a description, a
+            --  signal has multiple sources and it is not a resolved signal.
+            if Sig.Rti /= null then
+               Put ("for signal: ");
+               Disp_Signals.Put_Signal_Name (stderr, Sig);
+               New_Line (stderr);
+            end if;
+            Error ("several sources for unresolved signal");
+         elsif Sig.S.Mode_Sig = Mode_Buffer and False then
+            --  LRM 1.1.1.2  Ports
+            --  A BUFFER port may have at most one source.
+
+            --  FIXME: this is not true with VHDL-02.
+            --  With VHDL-87/93, should also check that: any actual associated
+            --  with a formal buffer port may have at most one source.
+            Error ("buffer port which more than one source");
+         end if;
+      end if;
+   end Check_New_Source;
+
+   --  Return TRUE if already present.
+   function Ghdl_Signal_Add_Driver (Sign : Ghdl_Signal_Ptr;
+                                    Trans : Transaction_Acc)
+                                   return Boolean
+   is
+      type Size_T is mod 2**Standard'Address_Size;
+
+      function Malloc (Size : Size_T) return Driver_Arr_Ptr;
+      pragma Import (C, Malloc);
+
+      function Realloc (Ptr : Driver_Arr_Ptr; Size : Size_T)
+        return Driver_Arr_Ptr;
+      pragma Import (C, Realloc);
+
+      function Size (N : Ghdl_Index_Type) return Size_T is
+      begin
+         return Size_T (N * Driver_Fat_Array'Component_Size
+                        / System.Storage_Unit);
+      end Size;
+
+      Proc : Process_Acc;
+   begin
+      Proc := Get_Current_Process;
+      if Sign.S.Nbr_Drivers = 0 then
+         Check_New_Source (Sign);
+         Sign.S.Drivers := Malloc (Size (1));
+         Sign.S.Nbr_Drivers := 1;
+      else
+         -- Do not create a driver twice.
+         for I in 0 .. Sign.S.Nbr_Drivers - 1 loop
+            if Sign.S.Drivers (I).Proc = Proc then
+               return True;
+            end if;
+         end loop;
+         Check_New_Source (Sign);
+         Sign.S.Nbr_Drivers := Sign.S.Nbr_Drivers + 1;
+         Sign.S.Drivers := Realloc (Sign.S.Drivers, Size (Sign.S.Nbr_Drivers));
+      end if;
+      Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) :=
+        (First_Trans => Trans,
+         Last_Trans => Trans,
+         Proc => Proc);
+      return False;
+   end Ghdl_Signal_Add_Driver;
+
+   procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Line => 0,
+                                Time => 0,
+                                Next => null,
+                                Val => Sign.Value);
+      if Ghdl_Signal_Add_Driver (Sign, Trans) then
+         Free (Trans);
+      end if;
+   end Ghdl_Process_Add_Driver;
+
+   procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr;
+                                            Drv : Ghdl_Value_Ptr)
+   is
+      Trans : Transaction_Acc;
+      Trans1 : Transaction_Acc;
+   begin
+      --  Create transaction for current driving value.
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Line => 0,
+                                Time => 0,
+                                Next => null,
+                                Val => Sign.Value);
+      if Ghdl_Signal_Add_Driver (Sign, Trans) then
+         Free (Trans);
+         return;
+      end if;
+      --  Create transaction for the next driving value.
+      Trans1 := new Transaction'(Kind => Trans_Direct,
+                                 Line => 0,
+                                 Time => 0,
+                                 Next => null,
+                                 Val_Ptr => Drv);
+      Sign.S.Drivers (Sign.S.Nbr_Drivers - 1).Last_Trans := Trans1;
+      Trans.Next := Trans1;
+   end Ghdl_Signal_Add_Direct_Driver;
+
+   procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
+   is
+      type Size_T is new Integer;
+
+      function Malloc (Size : Size_T) return Signal_Arr_Ptr;
+      pragma Import (C, Malloc);
+
+      function Realloc (Ptr : Signal_Arr_Ptr; Size : Size_T)
+        return Signal_Arr_Ptr;
+      pragma Import (C, Realloc);
+
+      function Size (N : Ghdl_Index_Type) return Size_T is
+      begin
+         return Size_T (N * Ghdl_Signal_Ptr'Size / System.Storage_Unit);
+      end Size;
+   begin
+      if Targ.Nbr_Ports = 0 then
+         Targ.Ports := Malloc (Size (1));
+         Targ.Nbr_Ports := 1;
+      else
+         Targ.Nbr_Ports := Targ.Nbr_Ports + 1;
+         Targ.Ports := Realloc (Targ.Ports, Size (Targ.Nbr_Ports));
+      end if;
+      Targ.Ports (Targ.Nbr_Ports - 1) := Src;
+   end Append_Port;
+
+   --  Add SRC to port list of TARG, but only if not already in this list.
+   procedure Add_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      for I in 1 .. Targ.Nbr_Ports loop
+         if Targ.Ports (I - 1) = Src then
+            return;
+         end if;
+      end loop;
+      Append_Port (Targ, Src);
+   end Add_Port;
+
+   procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr;
+                                     Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      Check_New_Source (Targ);
+      Append_Port (Targ, Src);
+   end Ghdl_Signal_Add_Source;
+
+   procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
+                                         Time : Std_Time) is
+   begin
+      if Sign.S.Resolv = null then
+         Internal_Error ("ghdl_signal_set_disconnect: not resolved");
+      end if;
+      if Sign.S.Resolv.Disconnect_Time /= Bad_Time then
+         Error ("disconnection already specified for signal");
+      end if;
+      if Time < 0 then
+         Error ("disconnection time is negative");
+      end if;
+      Sign.S.Resolv.Disconnect_Time := Time;
+   end Ghdl_Signal_Set_Disconnect;
+
+   procedure Direct_Assign
+     (Targ : out Value_Union; Val : Ghdl_Value_Ptr; Mode : Mode_Type)
+   is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            Targ.B1 := Val.B1;
+         when Mode_E8 =>
+            Targ.E8 := Val.E8;
+         when Mode_E32 =>
+            Targ.E32 := Val.E32;
+         when Mode_I32 =>
+            Targ.I32 := Val.I32;
+         when Mode_I64 =>
+            Targ.I64 := Val.I64;
+         when Mode_F64 =>
+            Targ.F64 := Val.F64;
+      end case;
+   end Direct_Assign;
+
+   function Value_Equal (Left, Right : Value_Union; Mode : Mode_Type)
+     return Boolean
+   is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            return Left.B1 = Right.B1;
+         when Mode_E8 =>
+            return Left.E8 = Right.E8;
+         when Mode_E32 =>
+            return Left.E32 = Right.E32;
+         when Mode_I32 =>
+            return Left.I32 = Right.I32;
+         when Mode_I64 =>
+            return Left.I64 = Right.I64;
+         when Mode_F64 =>
+            return Left.F64 = Right.F64;
+      end case;
+   end Value_Equal;
+
+   procedure Error_Trans_Error (Trans : Transaction_Acc) is
+   begin
+      Error_C ("range check error on signal at ");
+      Error_C (Trans.File);
+      Error_C (":");
+      Error_C (Natural (Trans.Line));
+      Error_E ("");
+   end Error_Trans_Error;
+   pragma No_Return (Error_Trans_Error);
+
+   function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type
+   is
+      Proc : Process_Acc;
+   begin
+      if Sig.S.Drivers = null then
+         Error ("assignment to a signal without any driver");
+      end if;
+      Proc := Get_Current_Process;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Proc then
+            return I;
+         end if;
+      end loop;
+      Error ("assignment to a signal without a driver for the process");
+   end Find_Driver;
+
+   function Get_Driver (Sig : Ghdl_Signal_Ptr) return Driver_Acc
+   is
+      Proc : Process_Acc;
+   begin
+      if Sig.S.Drivers = null then
+         return null;
+      end if;
+      Proc := Get_Current_Process;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Proc then
+            return Sig.S.Drivers (I)'Access;
+         end if;
+      end loop;
+      return null;
+   end Get_Driver;
+
+   --  Return TRUE iff SIG has a future transaction for the current time,
+   --  ie iff SIG will be active in the next delta cycle.  This is used to
+   --  recompute wether SIG must be in the active chain.  SIG must be a user
+   --  signal.
+   function Has_Transaction_In_Next_Delta (Sig : Ghdl_Signal_Ptr)
+                                          return Boolean  is
+   begin
+      if Sig.Is_Direct_Active then
+         return True;
+      end if;
+
+      for I in 1 .. Sig.S.Nbr_Drivers loop
+         declare
+            Trans : constant Transaction_Acc :=
+              Sig.S.Drivers (I - 1).First_Trans.Next;
+         begin
+            if Trans.Kind /= Trans_Direct
+              and then Trans.Time = Current_Time
+            then
+               return True;
+            end if;
+         end;
+      end loop;
+      return False;
+   end Has_Transaction_In_Next_Delta;
+
+   --  Unused but well-known signal which always terminate
+   --    ghdl_signal_active_chain.
+   --  As a consequence, every element of the chain has a link field set to
+   --  a non-null value (this is of course not true for SIGNAL_END).  This may
+   --  be used to quickly check if a signal is in the list.
+   --  This signal is not in the signal table.
+   Signal_End : Ghdl_Signal_Ptr;
+
+   --  List of signals which have projected waveforms in the future (beyond
+   --  the next delta cycle).
+   Future_List : aliased Ghdl_Signal_Ptr;
+
+   procedure Ghdl_Signal_Start_Assign (Sign : Ghdl_Signal_Ptr;
+                                       Reject : Std_Time;
+                                       Trans : Transaction_Acc;
+                                       After : Std_Time)
+   is
+      Assign_Time : Std_Time;
+      Drv : constant Ghdl_Index_Type := Find_Driver (Sign);
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Drv);
+   begin
+      --  LRM93 8.4.1
+      --  It is an error if the time expression in a waveform element
+      --  evaluates to a negative value.
+      if After < 0 then
+         Error ("negative time expression in signal assignment");
+      end if;
+
+      if After = 0 then
+         --  Put SIGN on the active list if the transaction is scheduled
+         --   for the next delta cycle.
+         if Sign.Link = null then
+            Sign.Link := Grt.Threads.Atomic_Insert
+              (Ghdl_Signal_Active_Chain'access, Sign);
+         end if;
+      else
+         --  AFTER > 0.
+         --  Put SIGN on the future list.
+         if Sign.Flink = null then
+            Sign.Flink := Grt.Threads.Atomic_Insert (Future_List'access, Sign);
+         end if;
+      end if;
+
+      Assign_Time := Current_Time + After;
+      if Assign_Time < 0 then
+         --  Beyond the future
+         Free_In (Trans);
+         return;
+      end if;
+
+      --  Handle sign as direct driver.
+      if Driver.Last_Trans.Kind = Trans_Direct then
+         if After /= 0 then
+            Internal_Error ("direct assign with non-0 after");
+         end if;
+         --  FIXME: can be a bound-error too!
+         if Trans.Kind = Trans_Value then
+            case Sign.Mode is
+               when Mode_B1 =>
+                  Driver.Last_Trans.Val_Ptr.B1 := Trans.Val.B1;
+               when Mode_E8 =>
+                  Driver.Last_Trans.Val_Ptr.E8 := Trans.Val.E8;
+               when Mode_E32 =>
+                  Driver.Last_Trans.Val_Ptr.E32 := Trans.Val.E32;
+               when Mode_I32 =>
+                  Driver.Last_Trans.Val_Ptr.I32 := Trans.Val.I32;
+               when Mode_I64 =>
+                  Driver.Last_Trans.Val_Ptr.I64 := Trans.Val.I64;
+               when Mode_F64 =>
+                  Driver.Last_Trans.Val_Ptr.F64 := Trans.Val.F64;
+            end case;
+            Free_In (Trans);
+         elsif Trans.Kind = Trans_Error then
+            Error_Trans_Error (Trans);
+         else
+            Internal_Error ("direct assign with non-value");
+         end if;
+         return;
+      end if;
+
+      --  LRM93 8.4.1
+      --  1. All old transactions that are projected to occur at or after the
+      --     time at which the earliest new transaction is projected to occur
+      --     are deleted from the projected output waveform.
+      if Driver.Last_Trans.Time >= Assign_Time then
+         declare
+            --  LAST is the last transaction to keep.
+            Last : Transaction_Acc;
+            Next : Transaction_Acc;
+         begin
+            Last := Driver.First_Trans;
+            --  Find the first transaction to be deleted.
+            Next := Last.Next;
+            while Next /= null and then Next.Time < Assign_Time loop
+               Last := Next;
+               Next := Next.Next;
+            end loop;
+            --  Delete old transactions.
+            if Next /= null then
+               --  Set the last transaction of the driver.
+               Driver.Last_Trans := Last;
+               --  Cut the chain.  This is not strickly necessary, since
+               --  it will be overriden below, by appending TRANS to the
+               --  driver.
+               Last.Next := null;
+               --  Free removed transactions.
+               loop
+                  Last := Next.Next;
+                  Free (Next);
+                  exit when Last = null;
+                  Next := Last;
+               end loop;
+            end if;
+         end;
+      end if;
+
+      --  2.  The new transaction are then appended to the projected output
+      --      waveform in the order of their projected occurence.
+      Trans.Time := Assign_Time;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+
+      --  If the initial delay is inertial delay according to the definitions
+      --  of section 8.4, the projected output waveform is further modified
+      --  as follows:
+      --  1.  All of the new transactions are marked.
+      --  2.  An old transaction is marked if the time at which it is projected
+      --      to occur is less than the time at which the first new transaction
+      --      is projected to occur minus the pulse rejection limit.
+      --  3.  For each remaining unmarked, old transaction, the old transaction
+      --      is marked if it immediatly precedes a marked transaction and its
+      --      value component is the same as that of the marked transaction;
+      --  4.  The transaction that determines the current value of the driver
+      --      is marked.
+      --  5.  All unmarked transactions (all of which are old transactions) are
+      --      deleted from the projected output waveform.
+      --
+      --  GHDL: only transactions that are projected to occur at [T-R, T[
+      --  can be deleted (R is the reject time, T is now + after time).
+      if Reject > 0 then
+         --  LRM93 8.4
+         --  It is an error if the pulse rejection limit for any inertially
+         --  delayed signal assignment statement is [...] or greater than the
+         --  time expression associated with the first waveform element.
+         if Reject > After then
+            Error ("pulse rejection greater than first waveform delay");
+         end if;
+
+         declare
+            Prev : Transaction_Acc;
+            Next : Transaction_Acc;
+         begin
+            --  Find the first transaction after the project time less the
+            --  rejection time.
+            --  PREV will be the last old transaction which is projected to
+            --  occur before T - R.
+            Prev := Driver.First_Trans;
+            loop
+               Next := Prev.Next;
+               exit when Next.Time >= Assign_Time - Reject;
+               Prev := Next;
+            end loop;
+
+            --  Scan every transaction until TRANS.  If a transaction value is
+            --  different from the TRANS value, then delete all previous
+            --  transactions (from T - R to the currently scanned transaction),
+            --  since they are not marked.
+            while Next /= Trans loop
+               if Next.Kind /= Trans.Kind
+                 or else
+                 (Trans.Kind = Trans_Value
+                  and then not Value_Equal (Next.Val, Trans.Val, Sign.Mode))
+               then
+                  --  NEXT is different from TRANS.
+                  --  Delete ]PREV;NEXT].
+                  declare
+                     D, N : Transaction_Acc;
+                  begin
+                     D := Prev.Next;
+                     Next := Next.Next;
+                     Prev.Next := Next;
+                     loop
+                        N := D.Next;
+                        Free (D);
+                        exit when N = Next;
+                        D := N;
+                     end loop;
+                  end;
+               else
+                  Next := Next.Next;
+               end if;
+            end loop;
+
+            --  A previous assignment (with a 0 after time) may have put this
+            --  signal on the active chain.  But maybe this previous
+            --  transaction has been removed (due to rejection) and therefore
+            --  this signal won't be active at the next delta.  So remove it
+            --  from the active chain.  This is a little bit costly (because
+            --  the chain is simply linked), but that issue doesn't appear
+            --  frequently.
+            if Sign.Link /= null
+              and then not Has_Transaction_In_Next_Delta (Sign)
+            then
+               if Ghdl_Signal_Active_Chain = Sign then
+                  --  At the head of the chain.
+                  --  FIXME: this is not atomic.
+                  Ghdl_Signal_Active_Chain := Sign.Link;
+               else
+                  --  In the middle of the chain.
+                  declare
+                     Prev : Ghdl_Signal_Ptr := Ghdl_Signal_Active_Chain;
+                  begin
+                     while Prev.Link /= Sign loop
+                        Prev := Prev.Link;
+                     end loop;
+                     Prev.Link := Sign.Link;
+                  end;
+               end if;
+               Sign.Link := null;
+            end if;
+         end;
+      elsif Reject /= 0 then
+         --  LRM93 8.4
+         --  It is an error if the pulse rejection limit for any inertially
+         --  delayed signal assignment statement is either negative or [...].
+         Error ("pulse rejection is negative");
+      end if;
+
+      --  Do some checks.
+      if Driver.Last_Trans.Next /= null then
+         Error ("ghdl_signal_start_assign internal_error");
+      end if;
+   end Ghdl_Signal_Start_Assign;
+
+   procedure Ghdl_Signal_Next_Assign (Sign : Ghdl_Signal_Ptr;
+                                      Val : Value_Union;
+                                      After : Std_Time)
+   is
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign));
+
+      Trans : Transaction_Acc;
+   begin
+      if After > 0 and then Sign.Flink = null then
+         --  Put SIGN on the future list.
+         Sign.Flink := Future_List;
+         Future_List := Sign;
+      end if;
+
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Line => 0,
+                                Time => Current_Time + After,
+                                Next => null,
+                                Val => Val);
+      if Trans.Time <= Driver.Last_Trans.Time then
+         Error ("transactions not in ascending order");
+      end if;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+   end Ghdl_Signal_Next_Assign;
+
+   procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr) is
+   begin
+      if Sign.Link = null then
+         Sign.Link := Grt.Threads.Atomic_Insert
+           (Ghdl_Signal_Active_Chain'access, Sign);
+      end if;
+
+      --  Must be always set (as Sign.Link may be set by a regular driver).
+      Sign.Is_Direct_Active := True;
+   end Ghdl_Signal_Direct_Assign;
+
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                              File : Ghdl_C_String;
+                                              Line : Ghdl_I32)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
+                                Time => 0,
+                                Next => null,
+                                File => File);
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_Error;
+
+   procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                             Rej : Std_Time;
+                                             After : Std_Time;
+                                             File : Ghdl_C_String;
+                                             Line : Ghdl_I32)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
+                                Time => 0,
+                                Next => null,
+                                File => File);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_Error;
+
+   procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                            After : Std_Time;
+                                            File : Ghdl_C_String;
+                                            Line : Ghdl_I32)
+   is
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign));
+
+      Trans : Transaction_Acc;
+   begin
+      if After > 0 and then Sign.Flink = null then
+         --  Put SIGN on the future list.
+         Sign.Flink := Future_List;
+         Future_List := Sign;
+      end if;
+
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
+                                Time => Current_Time + After,
+                                Next => null,
+                                File => File);
+      if Trans.Time <= Driver.Last_Trans.Time then
+         Error ("transactions not in ascending order");
+      end if;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+   end Ghdl_Signal_Next_Assign_Error;
+
+   procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr;
+                                            Rej : Std_Time;
+                                            After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Is_Signal_Guarded (Sign) then
+         Error ("null transaction for a non-guarded target");
+      end if;
+      Trans := new Transaction'(Kind => Trans_Null,
+                                Line => 0,
+                                Time => 0,
+                                Next => null);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_Null;
+
+   procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr)
+   is
+      Trans : Transaction_Acc;
+      Time : Std_Time;
+   begin
+      if not Is_Signal_Guarded (Sign) then
+         Error ("null transaction for a non-guarded target");
+      end if;
+      Trans := new Transaction'(Kind => Trans_Null,
+                                Line => 0,
+                                Time => 0,
+                                Next => null);
+      Time := Sign.S.Resolv.Disconnect_Time;
+      Ghdl_Signal_Start_Assign (Sign, Time, Trans, Time);
+   end Ghdl_Signal_Disconnect;
+
+   procedure Ghdl_Signal_Associate (Sig : Ghdl_Signal_Ptr; Val : Value_Union)
+   is
+   begin
+      Sig.Value := Val;
+      Sig.Driving_Value := Val;
+   end Ghdl_Signal_Associate;
+
+   function Ghdl_Create_Signal_B1
+     (Init_Val : Ghdl_B1;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_B1;
+
+   procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1) is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B1, B1 => Init_Val));
+   end Ghdl_Signal_Init_B1;
+
+   procedure Ghdl_Signal_Associate_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B1, B1 => Val));
+   end Ghdl_Signal_Associate_B1;
+
+   procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B1)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.B1
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B1, B1 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_B1;
+
+   procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B1;
+                                          After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B1, B1 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_B1;
+
+   procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B1;
+                                         After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_B1, B1 => Val), After);
+   end Ghdl_Signal_Next_Assign_B1;
+
+   function Ghdl_Create_Signal_E8
+     (Init_Val : Ghdl_E8;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_E8, Value_Union'(Mode => Mode_E8, E8 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_E8;
+
+   procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8) is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E8, E8 => Init_Val));
+   end Ghdl_Signal_Init_E8;
+
+   procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E8, E8 => Val));
+   end Ghdl_Signal_Associate_E8;
+
+   procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_E8)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.E8
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E8, E8 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_E8;
+
+   procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_E8;
+                                          After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E8, E8 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_E8;
+
+   procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_E8;
+                                         After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After);
+   end Ghdl_Signal_Next_Assign_E8;
+
+   function Ghdl_Create_Signal_E32
+     (Init_Val : Ghdl_E32;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_E32;
+
+   procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val));
+   end Ghdl_Signal_Init_E32;
+
+   procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val));
+   end Ghdl_Signal_Associate_E32;
+
+   procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_E32)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.E32
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_E32;
+
+   procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_E32;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_E32;
+
+   procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_E32;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After);
+   end Ghdl_Signal_Next_Assign_E32;
+
+   function Ghdl_Create_Signal_I32
+     (Init_Val : Ghdl_I32;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_I32, Value_Union'(Mode => Mode_I32, I32 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_I32;
+
+   procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I32, I32 => Init_Val));
+   end Ghdl_Signal_Init_I32;
+
+   procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I32, I32 => Val));
+   end Ghdl_Signal_Associate_I32;
+
+   procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I32)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.I32
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I32, I32 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_I32;
+
+   procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I32;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I32, I32 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_I32;
+
+   procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I32;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_I32, I32 => Val), After);
+   end Ghdl_Signal_Next_Assign_I32;
+
+   function Ghdl_Create_Signal_I64
+     (Init_Val : Ghdl_I64;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_I64, Value_Union'(Mode => Mode_I64, I64 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_I64;
+
+   procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I64, I64 => Init_Val));
+   end Ghdl_Signal_Init_I64;
+
+   procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I64, I64 => Val));
+   end Ghdl_Signal_Associate_I64;
+
+   procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I64)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.I64
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I64, I64 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_I64;
+
+   procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I64;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I64, I64 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_I64;
+
+   procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I64;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_I64, I64 => Val), After);
+   end Ghdl_Signal_Next_Assign_I64;
+
+   function Ghdl_Create_Signal_F64
+     (Init_Val : Ghdl_F64;
+      Resolv_Func : Resolver_Acc;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_F64, Value_Union'(Mode => Mode_F64, F64 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_F64;
+
+   procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_F64, F64 => Init_Val));
+   end Ghdl_Signal_Init_F64;
+
+   procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_F64, F64 => Val));
+   end Ghdl_Signal_Associate_F64;
+
+   procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_F64)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.F64
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_F64, F64 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_F64;
+
+   procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_F64;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Line => 0,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_F64, F64 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_F64;
+
+   procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_F64;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_F64, F64 => Val), After);
+   end Ghdl_Signal_Next_Assign_F64;
+
+   procedure Ghdl_Signal_Internal_Checks
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         --  Check drivers.
+         case Sig.S.Mode_Sig is
+            when Mode_Signal_User =>
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  declare
+                     Trans : Transaction_Acc;
+                  begin
+                     Trans := Sig.S.Drivers (J - 1).First_Trans;
+                     while Trans.Next /= null loop
+                        if Trans.Next.Time < Trans.Time then
+                           Internal_Error ("ghdl_signal_internal_checks: "
+                                           & "bad transaction order");
+                        end if;
+                        Trans := Trans.Next;
+                     end loop;
+                     if Trans /= Sig.S.Drivers (J - 1).Last_Trans then
+                        Internal_Error ("ghdl_signal_internal_checks: "
+                                        & "last transaction mismatch");
+                     end if;
+                  end;
+               end loop;
+            when others =>
+               null;
+         end case;
+      end loop;
+   end Ghdl_Signal_Internal_Checks;
+
+   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
+                                          Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Targ.S.Effective /= null then
+         Error ("internal error: already effective value");
+      end if;
+      Targ.S.Effective := Src;
+   end Ghdl_Signal_Effective_Value;
+
+   Bit_Signal_Rti : aliased Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => Null_Rti_Loc,
+      Obj_Type => null);
+
+   Boolean_Signal_Rti : aliased Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => Null_Rti_Loc,
+      Obj_Type => null);
+
+   function Ghdl_Create_Signal_Attribute
+     (Mode : Mode_Signal_Type; Time : Std_Time)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+--      Sig_Type : Ghdl_Desc_Ptr;
+   begin
+      case Mode is
+         when Mode_Transaction =>
+            Sig_Rti := To_Ghdl_Rtin_Object_Acc
+              (To_Ghdl_Rti_Access (Bit_Signal_Rti'Address));
+         when Mode_Quiet
+           | Mode_Stable =>
+            Sig_Rti := To_Ghdl_Rtin_Object_Acc
+              (To_Ghdl_Rti_Access (Boolean_Signal_Rti'Address));
+         when others =>
+            Internal_Error ("ghdl_create_signal_attribute");
+      end case;
+      --  Note: bit and boolean are both mode_b1.
+      Res := Create_Signal
+        (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => True),
+         Mode, null, Null_Address);
+      Sig_Rti := null;
+      Last_Implicit_Signal := Res;
+
+      if Mode /= Mode_Transaction then
+         Res.S.Time := Time;
+         Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                              Line => 0,
+                                              Time => 0,
+                                              Next => null,
+                                              Val => Res.Value);
+      end if;
+
+      if Time > 0 then
+         Res.Flink := Future_List;
+         Future_List := Res;
+      end if;
+
+      return Res;
+   end Ghdl_Create_Signal_Attribute;
+
+   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Stable, Val);
+   end Ghdl_Create_Stable_Signal;
+
+   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Quiet, Val);
+   end Ghdl_Create_Quiet_Signal;
+
+   function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Transaction, 0);
+   end Ghdl_Create_Transaction_Signal;
+
+   procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Add_Port (Last_Implicit_Signal, Sig);
+   end Ghdl_Signal_Attribute_Register_Prefix;
+
+   --Guard_String : constant String := "guard";
+   --Guard_Name : constant Ghdl_Str_Len_Address_Type :=
+   --  (Len => 5, Str => Guard_String'Address);
+   --function To_Ghdl_Str_Len_Ptr is new Ada.Unchecked_Conversion
+   --  (Source => System.Address, Target => Ghdl_Str_Len_Ptr);
+
+   Guard_Rti : aliased constant Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => Null_Rti_Loc,
+      Obj_Type => Std_Standard_Boolean_RTI_Ptr);
+
+   function Ghdl_Signal_Create_Guard (This : System.Address;
+                                      Proc : Guard_Func_Acc)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc
+        (To_Ghdl_Rti_Access (Guard_Rti'Address));
+      Res := Create_Signal
+        (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Proc.all (This)),
+         Mode_Guard, null, Null_Address);
+      Sig_Rti := null;
+      Res.S.Guard_Func := Proc;
+      Res.S.Guard_Instance := This;
+      Last_Implicit_Signal := Res;
+      return Res;
+   end Ghdl_Signal_Create_Guard;
+
+   procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Add_Port (Last_Implicit_Signal, Sig);
+      Sig.Has_Active := True;
+   end Ghdl_Signal_Guard_Dependence;
+
+   function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time)
+                                       return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+   begin
+      Res := Create_Signal (Sig.Mode, Sig.Value,
+                            Mode_Delayed, null, Null_Address);
+      Res.S.Time := Val;
+      if Val > 0 then
+         Res.Flink := Future_List;
+         Future_List := Res;
+      end if;
+      Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                           Line => 0,
+                                           Time => 0,
+                                           Next => null,
+                                           Val => Res.Value);
+      Append_Port (Res, Sig);
+      return Res;
+   end Ghdl_Create_Delayed_Signal;
+
+   function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index
+   is
+   begin
+      --  Note: we may start from ptr.instance_name.sig_index, but
+      --  instance_name is *not* set for conversion signals.
+      for I in reverse Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I) = Ptr then
+            return I;
+         end if;
+      end loop;
+      return -1;
+   end Signal_Ptr_To_Index;
+
+   function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr)
+                                      return Ghdl_Index_Type is
+   begin
+      return Sig.Nbr_Ports;
+   end Ghdl_Signal_Get_Nbr_Ports;
+
+   function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr)
+                                        return Ghdl_Index_Type is
+   begin
+      return Sig.S.Nbr_Drivers;
+   end Ghdl_Signal_Get_Nbr_Drivers;
+
+   function Ghdl_Signal_Read_Port
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr
+   is
+   begin
+      if Index >= Sig.Nbr_Ports then
+         Internal_Error ("ghdl_signal_read_port: bad index");
+      end if;
+      return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address);
+   end Ghdl_Signal_Read_Port;
+
+   function Ghdl_Signal_Read_Driver
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr
+   is
+      Trans : Transaction_Acc;
+   begin
+      if Index >= Sig.S.Nbr_Drivers then
+         Internal_Error ("ghdl_signal_read_driver: bad index");
+      end if;
+      Trans := Sig.S.Drivers (Index).First_Trans;
+      case Trans.Kind is
+         when Trans_Value =>
+            return To_Ghdl_Value_Ptr (Trans.Val'Address);
+         when Trans_Direct =>
+            Internal_Error ("ghdl_signal_read_driver: trans_direct");
+         when Trans_Null =>
+            return null;
+         when Trans_Error =>
+            Error_Trans_Error (Trans);
+      end case;
+   end Ghdl_Signal_Read_Driver;
+
+   procedure Ghdl_Signal_Conversion (Func : System.Address;
+                                     Instance : System.Address;
+                                     Src : Ghdl_Signal_Ptr;
+                                     Src_Len : Ghdl_Index_Type;
+                                     Dst : Ghdl_Signal_Ptr;
+                                     Dst_Len : Ghdl_Index_Type;
+                                     Mode : Mode_Signal_Type)
+   is
+      Data : Sig_Conversion_Acc;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Data := new Sig_Conversion_Type'(Func => Func,
+                                       Instance => Instance,
+                                       Src => (-1, -1),
+                                       Dest => (-1, -1));
+      Data.Src.First := Signal_Ptr_To_Index (Src);
+      Data.Src.Last := Data.Src.First + Sig_Table_Index (Src_Len) - 1;
+
+      Data.Dest.First := Signal_Ptr_To_Index (Dst);
+      Data.Dest.Last := Data.Dest.First + Sig_Table_Index (Dst_Len) - 1;
+
+      --  Convert DEST to new mode.
+      for I in Data.Dest.First .. Data.Dest.Last loop
+         Sig := Sig_Table.Table (I);
+         case Mode is
+            when Mode_Conv_In =>
+               Sig.S := (Mode_Sig => Mode_Conv_In,
+                         Conv => Data);
+            when Mode_Conv_Out =>
+               Sig.S := (Mode_Sig => Mode_Conv_Out,
+                         Conv => Data);
+            when others =>
+               Internal_Error ("ghdl_signal_conversion");
+         end case;
+      end loop;
+   end Ghdl_Signal_Conversion;
+
+   procedure Ghdl_Signal_In_Conversion (Func : System.Address;
+                                        Instance : System.Address;
+                                        Src : Ghdl_Signal_Ptr;
+                                        Src_Len : Ghdl_Index_Type;
+                                        Dst : Ghdl_Signal_Ptr;
+                                        Dst_Len : Ghdl_Index_Type)
+   is
+   begin
+      Ghdl_Signal_Conversion
+        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_In);
+   end Ghdl_Signal_In_Conversion;
+
+   procedure Ghdl_Signal_Out_Conversion (Func : System.Address;
+                                         Instance : System.Address;
+                                         Src : Ghdl_Signal_Ptr;
+                                         Src_Len : Ghdl_Index_Type;
+                                         Dst : Ghdl_Signal_Ptr;
+                                         Dst_Len : Ghdl_Index_Type)
+   is
+   begin
+      Ghdl_Signal_Conversion
+        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_Out);
+   end Ghdl_Signal_Out_Conversion;
+
+   function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null then
+         --  FIXME: disp signal and process.
+         Error ("'driving error: no driver in process for signal");
+      end if;
+      if Drv.First_Trans.Kind /= Trans_Null then
+         return True;
+      else
+         return False;
+      end if;
+   end Ghdl_Signal_Driving;
+
+   function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) return Ghdl_B1
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.B1;
+      end if;
+   end Ghdl_Signal_Driving_Value_B1;
+
+   function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E8
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.E8;
+      end if;
+   end Ghdl_Signal_Driving_Value_E8;
+
+   function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E32
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.E32;
+      end if;
+   end Ghdl_Signal_Driving_Value_E32;
+
+   function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I32
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.I32;
+      end if;
+   end Ghdl_Signal_Driving_Value_I32;
+
+   function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I64
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.I64;
+      end if;
+   end Ghdl_Signal_Driving_Value_I64;
+
+   function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_F64
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.F64;
+      end if;
+   end Ghdl_Signal_Driving_Value_F64;
+
+   Ghdl_Implicit_Signal_Active_Chain : Ghdl_Signal_Ptr;
+
+   procedure Flush_Active_List
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Next_Sig : Ghdl_Signal_Ptr;
+   begin
+      --  Free active_chain.
+      Sig := Ghdl_Signal_Active_Chain;
+      loop
+         Next_Sig := Sig.Link;
+         exit when Next_Sig = null;
+         Sig.Link := null;
+         Sig := Next_Sig;
+      end loop;
+      Ghdl_Signal_Active_Chain := Sig;
+   end Flush_Active_List;
+
+   function Find_Next_Time return Std_Time
+   is
+      Res : Std_Time;
+      Sig : Ghdl_Signal_Ptr;
+
+      procedure Check_Transaction (Trans : Transaction_Acc)
+      is
+      begin
+         if Trans = null or else Trans.Kind = Trans_Direct then
+            --  Activity of direct drivers is done through link.
+            return;
+         end if;
+
+         if Trans.Time = Res and Sig.Link = null then
+            Sig.Link := Ghdl_Signal_Active_Chain;
+            Ghdl_Signal_Active_Chain := Sig;
+         elsif Trans.Time < Res then
+            Flush_Active_List;
+
+            --  Put sig on the list.
+            Sig.Link := Ghdl_Signal_Active_Chain;
+            Ghdl_Signal_Active_Chain := Sig;
+
+            Res := Trans.Time;
+         end if;
+         if Res = Current_Time then
+            --  Must have been in the active list.
+            Internal_Error ("find_next_time(2)");
+         end if;
+      end Check_Transaction;
+   begin
+      --  If there is signals in the active list, then next cycle is a delta
+      --  cycle, so next time is current_time.
+      if Ghdl_Signal_Active_Chain.Link /= null then
+         return Current_Time;
+      end if;
+      if Ghdl_Implicit_Signal_Active_Chain.Link /= null then
+         return Current_Time;
+      end if;
+      Res := Std_Time'Last;
+
+      Sig := Future_List;
+      while Sig.Flink /= null loop
+         case Sig.S.Mode_Sig is
+            when Mode_Signal_User =>
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Check_Transaction (Sig.S.Drivers (J - 1).First_Trans.Next);
+               end loop;
+            when Mode_Delayed
+              | Mode_Stable
+              | Mode_Quiet =>
+               Check_Transaction (Sig.S.Attr_Trans.Next);
+            when others =>
+               Internal_Error ("find_next_time(3)");
+         end case;
+         Sig := Sig.Flink;
+      end loop;
+      return Res;
+   end Find_Next_Time;
+
+--    function Get_Nbr_Non_Null_Source (Sig : Ghdl_Signal_Ptr)
+--                                     return Natural
+--    is
+--       Length : Natural;
+--    begin
+--       Length := Sig.Nbr_Ports;
+--       for I in 0 .. Sig.Nbr_Drivers - 1 loop
+--          case Sig.Drivers (I).First_Trans.Kind is
+--             when Trans_Value =>
+--                Length := Length + 1;
+--             when Trans_Null =>
+--                null;
+--             when Trans_Error =>
+--                Error ("range check error");
+--          end case;
+--       end loop;
+--       return Length;
+--    end Get_Nbr_Non_Null_Source;
+
+   function To_Resolver_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Resolver_Acc);
+
+   procedure Compute_Resolved_Signal (Resolv : Resolved_Signal_Acc)
+   is
+      Sig : constant Ghdl_Signal_Ptr :=
+        Sig_Table.Table (Resolv.Sig_Range.First);
+      Length : Ghdl_Index_Type;
+      type Bool_Array_Type is array (1 .. Sig.S.Nbr_Drivers) of Boolean;
+      Vec : Bool_Array_Type;
+   begin
+      --  Compute number of non-null drivers.
+      Length := 0;
+      for I in 1 .. Sig.S.Nbr_Drivers loop
+         case Sig.S.Drivers (I - 1).First_Trans.Kind is
+            when Trans_Value =>
+               Length := Length + 1;
+               Vec (I) := True;
+            when Trans_Null =>
+               Vec (I) := False;
+            when Trans_Error =>
+               Error ("range check error");
+            when Trans_Direct =>
+               Internal_Error ("compute_resolved_signal: trans_direct");
+         end case;
+      end loop;
+
+      --  Check driving condition on all signals.
+      for J in Resolv.Sig_Range.First + 1.. Resolv.Sig_Range.Last loop
+         for I in 1 .. Sig.S.Nbr_Drivers loop
+            if (Sig_Table.Table (J).S.Drivers (I - 1).First_Trans.Kind
+                /= Trans_Null)
+              xor Vec (I)
+            then
+               Error ("null-transaction required");
+            end if;
+         end loop;
+      end loop;
+
+      --  if no driving sources and register, exit.
+      if Length = 0
+        and then Sig.Nbr_Ports = 0
+        and then Sig.Sig_Kind = Kind_Signal_Register
+      then
+         return;
+      end if;
+
+      --  Call the procedure.
+      Resolv.Resolv_Proc.all (Resolv.Resolv_Inst,
+                              Resolv.Resolv_Ptr,
+                              Vec'Address,
+                              Length,
+                              Sig.S.Nbr_Drivers,
+                              Sig.Nbr_Ports);
+   end Compute_Resolved_Signal;
+
+   procedure Call_Conversion_Function (Conv : Sig_Conversion_Acc)
+   is
+      F : Conversion_Func_Acc;
+   begin
+      F := To_Conversion_Func_Acc (Conv.Func);
+      F.all (Conv.Instance);
+   end Call_Conversion_Function;
+
+   procedure Resume_Process_If_Event
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc)
+   is
+      El : Action_List_Acc;
+   begin
+      El := new Action_List'(Dynamic => False,
+                             Proc => Proc,
+                             Next => Sig.Event_List);
+      Sig.Event_List := El;
+   end Resume_Process_If_Event;
+
+   --  Order of signals:
+   --  To be computed: driving value or/and effective value
+   --  To be considered: ports, signals, implicit signals, resolution,
+   --                    conversion
+   --
+
+   procedure Add_Propagation (P : Propagation_Type) is
+   begin
+      Propagation.Increment_Last;
+      Propagation.Table (Propagation.Last) := P;
+   end Add_Propagation;
+
+   procedure Add_Forward_Propagation (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      for I in 1 .. Sig.Nbr_Ports loop
+         Add_Propagation
+           ((Kind => Imp_Forward_Build,
+             Forward => new Forward_Build_Type'(Src => Sig.Ports (I - 1),
+                                                Targ => Sig)));
+      end loop;
+   end Add_Forward_Propagation;
+
+   --  Put SIG in PROPAGATION table until ORDER level.
+   procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag);
+
+   --  Return TRUE is the effective value of SIG is the driving value of SIG.
+   function Is_Eff_Drv (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+   begin
+      case Sig.S.Mode_Sig is
+         when Mode_Signal
+           | Mode_Buffer =>
+            return True;
+         when Mode_Linkage
+           | Mode_Out =>
+            --  No effective value.
+            return False;
+         when Mode_Inout
+           | Mode_In =>
+            if Sig.S.Effective = null then
+               if Sig.S.Nbr_Drivers > 0 or Sig.Nbr_Ports > 0 then
+                  --  Only for inout.
+                  return True;
+               else
+                  return False;
+               end if;
+            else
+               return False;
+            end if;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            return False;
+         when Mode_Stable
+           | Mode_Guard
+           | Mode_Quiet
+           | Mode_Transaction
+           | Mode_Delayed =>
+            return True;
+         when Mode_End =>
+            return False;
+      end case;
+   end Is_Eff_Drv;
+
+   procedure Order_Signal_List (Sig : Ghdl_Signal_Ptr;
+                                Order : Propag_Order_Flag)
+   is
+   begin
+      for I in 1 .. Sig.Nbr_Ports loop
+         Order_Signal (Sig.Ports (I - 1), Order);
+      end loop;
+   end Order_Signal_List;
+
+   --  Put SIG in PROPAGATION table until ORDER level.
+   procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag)
+   is
+   begin
+      if Sig = null then
+         return;
+      end if;
+
+      --  Catch infinite loops, which must never happen.
+      --  Also exit if the signal is already fully ordered.
+      case Sig.Flags.Propag is
+         when Propag_None =>
+            null;
+         when Propag_Being_Driving =>
+            Internal_Error ("order_signal: being driving");
+         when Propag_Being_Effective =>
+            Internal_Error ("order_signal: being effective");
+         when Propag_Driving =>
+            null;
+         when Propag_Done =>
+            --  If sig was already handled, nothing to do!
+            return;
+      end case;
+
+      --  First, the driving value.
+      if Sig.Flags.Propag = Propag_None then
+         case Sig.S.Mode_Sig is
+            when Mode_Signal_User =>
+               if Sig.S.Nbr_Drivers = 0 and Sig.Nbr_Ports = 0 then
+                  --  No source.
+                  Sig.Flags.Propag := Propag_Driving;
+               elsif Sig.S.Resolv = null then
+                  --  Not resolved (so at most one source).
+                  if Sig.S.Nbr_Drivers = 1 then
+                     --  Not resolved, 1 source : a driver.
+                     if Is_Eff_Drv (Sig) then
+                        Add_Propagation ((Kind => Eff_One_Driver, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Done;
+                     else
+                        Add_Propagation ((Kind => Drv_One_Driver, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Driving;
+                     end if;
+                  else
+                     Sig.Flags.Propag := Propag_Being_Driving;
+                     --  not resolved, 1 source : Source is a port.
+                     Order_Signal (Sig.Ports (0), Propag_Driving);
+                     if Is_Eff_Drv (Sig) then
+                        Add_Propagation ((Kind => Eff_One_Port, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Done;
+                     else
+                        Add_Propagation ((Kind => Drv_One_Port, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Driving;
+                     end if;
+                  end if;
+               else
+                  --  Resolved signal.
+                  declare
+                     Resolv : Resolved_Signal_Acc;
+                     S : Ghdl_Signal_Ptr;
+                  begin
+                     --  Compute driving value of brothers.
+                     Resolv := Sig.S.Resolv;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        if S.Flags.Propag /= Propag_None then
+                           Internal_Error ("order_signal(1)");
+                        end if;
+                        S.Flags.Propag := Propag_Being_Driving;
+                     end loop;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        --  Compute driving value of the sources.
+                        for J in 1 .. S.Nbr_Ports loop
+                           Order_Signal (S.Ports (J - 1), Propag_Driving);
+                        end loop;
+                     end loop;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        S.Flags.Propag := Propag_Driving;
+                     end loop;
+
+                     if Is_Eff_Drv (Sig) then
+                        if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then
+                           Add_Propagation ((Kind => Eff_One_Resolved,
+                                             Sig => Sig));
+                        else
+                           Add_Propagation ((Kind => Eff_Multiple,
+                                             Resolv => Resolv));
+                        end if;
+                     else
+                        if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then
+                           Add_Propagation ((Kind => Drv_One_Resolved,
+                                             Sig => Sig));
+                        else
+                           Add_Propagation ((Kind => Drv_Multiple,
+                                             Resolv => Resolv));
+                        end if;
+                     end if;
+                  end;
+               end if;
+            when Mode_Signal_Implicit =>
+               Sig.Flags.Propag := Propag_Being_Driving;
+               Order_Signal_List (Sig, Propag_Done);
+               Sig.Flags.Propag := Propag_Done;
+               if Sig.S.Mode_Sig in Mode_Signal_Forward then
+                  Add_Forward_Propagation (Sig);
+               end if;
+               case Mode_Signal_Implicit (Sig.S.Mode_Sig) is
+                  when Mode_Guard =>
+                     Add_Propagation ((Kind => Imp_Guard, Sig => Sig));
+                  when Mode_Stable =>
+                     Add_Propagation ((Kind => Imp_Stable, Sig => Sig));
+                  when Mode_Quiet =>
+                     Add_Propagation ((Kind => Imp_Quiet, Sig => Sig));
+                  when Mode_Transaction =>
+                     Add_Propagation ((Kind => Imp_Transaction, Sig => Sig));
+                  when Mode_Delayed =>
+                     Add_Propagation ((Kind => Imp_Delayed, Sig => Sig));
+               end case;
+               return;
+            when Mode_Conv_In =>
+               --  In conversion signals have no driving value
+               null;
+            when Mode_Conv_Out =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+               begin
+                  Conv := Sig.S.Conv;
+                  for I in Conv.Dest.First .. Conv.Dest.Last loop
+                     Sig_Table.Table (I).Flags.Propag := Propag_Being_Driving;
+                  end loop;
+                  for I in Conv.Src.First .. Conv.Src.Last loop
+                     Order_Signal (Sig_Table.Table (I), Propag_Driving);
+                  end loop;
+                  Add_Propagation ((Kind => Out_Conversion, Conv => Conv));
+                  for I in Conv.Dest.First .. Conv.Dest.Last loop
+                     Sig_Table.Table (I).Flags.Propag := Propag_Done;
+                  end loop;
+               end;
+            when Mode_End =>
+               Internal_Error ("order_signal: mode_end");
+         end case;
+      end if;
+
+      -- Effective value.
+      if Order = Propag_Driving then
+         --  Will be done later.
+         return;
+      end if;
+
+      case Sig.S.Mode_Sig is
+         when Mode_Signal
+           | Mode_Buffer =>
+            --  Effective value is driving value.
+            Sig.Flags.Propag := Propag_Done;
+         when Mode_Linkage
+           | Mode_Out =>
+            --  No effective value.
+            Sig.Flags.Propag := Propag_Done;
+         when Mode_Inout
+           | Mode_In =>
+            if Sig.S.Effective = null then
+               --  Effective value is driving value or initial value.
+               null;
+            else
+               Sig.Flags.Propag := Propag_Being_Effective;
+               Order_Signal (Sig.S.Effective, Propag_Done);
+               Add_Propagation ((Kind => Eff_Actual, Sig => Sig));
+               Sig.Flags.Propag := Propag_Done;
+            end if;
+         when Mode_Stable
+           | Mode_Guard
+           | Mode_Quiet
+           | Mode_Transaction
+           | Mode_Delayed =>
+            --  Sig.Propag is already set to PROPAG_DONE.
+            null;
+         when Mode_Conv_In =>
+            declare
+               Conv : Sig_Conversion_Acc;
+            begin
+               Conv := Sig.S.Conv;
+               for I in Conv.Dest.First .. Conv.Dest.Last loop
+                  Sig_Table.Table (I).Flags.Propag := Propag_Being_Effective;
+               end loop;
+               for I in Conv.Src.First .. Conv.Src.Last loop
+                  Order_Signal (Sig_Table.Table (I), Propag_Done);
+               end loop;
+               Add_Propagation ((Kind => In_Conversion, Conv => Conv));
+               for I in Conv.Dest.First .. Conv.Dest.Last loop
+                  Sig_Table.Table (I).Flags.Propag := Propag_Done;
+               end loop;
+            end;
+         when Mode_Conv_Out =>
+            --  No effective value.
+            null;
+         when Mode_End =>
+            Internal_Error ("order_signal: mode_end");
+      end case;
+   end Order_Signal;
+
+   procedure Set_Net (Sig : Ghdl_Signal_Ptr;
+                      Net : Signal_Net_Type;
+                      Link : Ghdl_Signal_Ptr)
+   is
+      use Astdio;
+      use Stdio;
+   begin
+      if Sig = null then
+         return;
+      end if;
+
+      if Boolean'(False) then
+         Put ("set_net ");
+         Put_I32 (stdout, Ghdl_I32 (Net));
+         Put (" on ");
+         Put (stdout, Sig.all'Address);
+         Put ("  ");
+         Disp_Signals.Disp_Mode_Signal (Sig.S.Mode_Sig);
+         New_Line;
+      end if;
+
+      if Sig.Net /= No_Signal_Net then
+         if Sig.Net /= Net then
+            --  Renumber.
+            if Boolean'(False) then
+               Put ("set_net renumber ");
+               Put_I32 (stdout, Ghdl_I32 (Net));
+               Put (" on ");
+               Put (stdout, Sig.all'Address);
+               New_Line;
+            end if;
+
+            declare
+               S : Ghdl_Signal_Ptr;
+               Old : constant Signal_Net_Type := Sig.Net;
+            begin
+               --  Merge the old net into NET.
+               S := Sig;
+               loop
+                  S.Net := Net;
+                  S := S.Link;
+                  exit when S = Sig;
+               end loop;
+
+               --  Add to the ring.
+               S := Sig.Link;
+               Sig.Link := Link.Link;
+               Link.Link := S;
+
+               --  Check.
+               for I in Sig_Table.First .. Sig_Table.Last loop
+                  if Sig_Table.Table (I).Net = Old then
+--                      Disp_Signals.Disp_Signals_Table;
+--                      Disp_Signals.Disp_Signals_Map;
+
+                     Internal_Error ("set_net: link corrupted");
+                  end if;
+               end loop;
+            end;
+         end if;
+         return;
+      end if;
+
+      Sig.Net := Net;
+
+      --  Add SIG in the LINK ring.
+      --  Note: this works even if LINK is not a ring (ie, LINK.link = null).
+      if Link.Link = null and then Sig /= Link then
+         Internal_Error ("set_net: bad link");
+      end if;
+      Sig.Link := Link.Link;
+      Link.Link := Sig;
+
+      --  Dependences.
+      case Sig.S.Mode_Sig is
+         when Mode_Signal_User =>
+            for I in 1 .. Sig.Nbr_Ports loop
+               Set_Net (Sig.Ports (I - 1), Net, Link);
+            end loop;
+            Set_Net (Sig.S.Effective, Net, Link);
+            if Sig.S.Resolv /= null then
+               for I in Sig.S.Resolv.Sig_Range.First
+                 .. Sig.S.Resolv.Sig_Range.Last
+               loop
+                  Set_Net (Sig_Table.Table (I), Net, Link);
+               end loop;
+            end if;
+         when Mode_Signal_Forward =>
+            null;
+         when Mode_Transaction
+           | Mode_Guard =>
+            for I in 1 .. Sig.Nbr_Ports loop
+               Set_Net (Sig.Ports (I - 1), Net, Link);
+            end loop;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            declare
+               S : Ghdl_Signal_Ptr;
+               Conv : Sig_Conversion_Acc;
+            begin
+               Conv := Sig.S.Conv;
+               S := Sig_Table.Table (Conv.Src.First);
+               if Sig = S or else S.Net /= Net then
+                  for J in Conv.Src.First .. Conv.Src.Last loop
+                     Set_Net (Sig_Table.Table (J), Net, Link);
+                  end loop;
+                  for J in Conv.Dest.First .. Conv.Dest.Last loop
+                     Set_Net (Sig_Table.Table (J), Net, Link);
+                  end loop;
+               end if;
+            end;
+         when Mode_End =>
+            Internal_Error ("set_net");
+      end case;
+   end Set_Net;
+
+   function Get_Propagation_Net (P : Signal_Net_Type) return Signal_Net_Type
+   is
+   begin
+      case Propagation.Table (P).Kind is
+         when Drv_Multiple
+           | Eff_Multiple =>
+            return Sig_Table.Table
+              (Propagation.Table (P).Resolv.Sig_Range.First).Net;
+         when In_Conversion
+           | Out_Conversion =>
+            return Sig_Table.Table
+              (Propagation.Table (P).Conv.Src.First).Net;
+         when Imp_Forward_Build =>
+            return Propagation.Table (P).Forward.Src.Net;
+         when others =>
+            return Propagation.Table (P).Sig.Net;
+      end case;
+   end Get_Propagation_Net;
+
+   Last_Signal_Net : Signal_Net_Type;
+
+   --  Create a net for SIG, or if one of its dependences has already a net,
+   --  merge SIG in this net.
+   procedure Merge_Net (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.S.Mode_Sig in Mode_Signal_User then
+         if Sig.S.Resolv = null
+           and then Sig.Nbr_Ports = 0
+           and then Sig.S.Effective = null
+         then
+            Internal_Error ("merge_net(1)");
+         end if;
+
+         if Sig.S.Effective /= null
+           and then Sig.S.Effective.Net /= No_Signal_Net
+         then
+            --  Avoid to create a net, just merge.
+            Set_Net (Sig, Sig.S.Effective.Net, Sig.S.Effective);
+            return;
+         end if;
+      end if;
+
+      if Sig.Nbr_Ports >= 1
+        and then Sig.Ports (0).Net /= No_Signal_Net
+      then
+         --  Avoid to create a net, just merge.
+         Set_Net (Sig, Sig.Ports (0).Net, Sig.Ports (0));
+      else
+         Last_Signal_Net := Last_Signal_Net + 1;
+         Set_Net (Sig, Last_Signal_Net, Sig);
+      end if;
+   end Merge_Net;
+
+   --  Create nets.
+   --  For all signals, set the net field.
+   procedure Create_Nets
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Last_Signal_Net := No_Signal_Net;
+
+      for I in reverse Propagation.First .. Propagation.Last loop
+         case Propagation.Table (I).Kind is
+            when Drv_Error
+              | Prop_End =>
+               null;
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               null;
+            when Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               --  Do not create a net if the signal has no dependences.
+               if Sig.Net = No_Signal_Net
+                 and then (Sig.S.Effective /= null or Sig.Nbr_Ports /= 0)
+               then
+                  Merge_Net (Sig);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port
+              | Imp_Guard
+              | Imp_Transaction
+              | Eff_Actual
+              | Drv_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Net = No_Signal_Net then
+                  Merge_Net (Sig);
+               end if;
+            when Imp_Forward =>
+               --  Should not yet appear.
+               Internal_Error ("create_nets - forward");
+            when Imp_Forward_Build =>
+               Sig := Propagation.Table (I).Forward.Src;
+               if Sig.Net = No_Signal_Net then
+                  --  Create a new net with only sig.
+                  Last_Signal_Net := Last_Signal_Net + 1;
+                  Set_Net (Sig, Last_Signal_Net, Sig);
+               end if;
+            when Imp_Quiet
+              | Imp_Stable
+              | Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Net = No_Signal_Net then
+                  --  Create a new net with only sig.
+                  Last_Signal_Net := Last_Signal_Net + 1;
+                  Sig.Net := Last_Signal_Net;
+                  Sig.Link := Sig;
+               end if;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+                  Link : Ghdl_Signal_Ptr;
+               begin
+                  Last_Signal_Net := Last_Signal_Net + 1;
+                  Resolv := Propagation.Table (I).Resolv;
+                  Link := Sig_Table.Table (Resolv.Sig_Range.First);
+                  for J in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Set_Net (Sig_Table.Table (J), Last_Signal_Net, Link);
+                  end loop;
+               end;
+            when In_Conversion
+              | Out_Conversion =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+                  Link : Ghdl_Signal_Ptr;
+               begin
+                  Conv := Propagation.Table (I).Conv;
+                  Link := Sig_Table.Table (Conv.Src.First);
+                  if Link.Net = No_Signal_Net then
+                     Last_Signal_Net := Last_Signal_Net + 1;
+                     Set_Net (Link, Last_Signal_Net, Link);
+                  end if;
+               end;
+         end case;
+      end loop;
+
+      --  Reorder propagation table.
+      declare
+         type Off_Array is array (Signal_Net_Type range <>) of Signal_Net_Type;
+         Offs : Off_Array (0 .. Last_Signal_Net) := (others => 0);
+
+         Last_Off : Signal_Net_Type;
+         Num : Signal_Net_Type;
+
+--          procedure Disp_Offs
+--          is
+--             use Grt.Astdio;
+--             use Grt.Stdio;
+--          begin
+--             for I in Offs'Range loop
+--                if Offs (I) /= 0 then
+--                   Put_I32 (stdout, Ghdl_I32 (I));
+--                   Put (": ");
+--                   Put_I32 (stdout, Ghdl_I32 (Offs (I)));
+--                   New_Line;
+--                end if;
+--             end loop;
+--          end Disp_Offs;
+
+         type Propag_Array is array (Signal_Net_Type range <>)
+           of Propagation_Type;
+
+         procedure Deallocate is new Ada.Unchecked_Deallocation
+           (Object => Forward_Build_Type, Name => Forward_Build_Acc);
+
+         Net : Signal_Net_Type;
+      begin
+         --  1) Count number of propagation cell per net.
+         for I in Propagation.First .. Propagation.Last loop
+            Net := Get_Propagation_Net (I);
+            Offs (Net) := Offs (Net) + 1;
+         end loop;
+
+         --  2) Convert numbers to offsets.
+         Last_Off := 1;
+         for I in 1 .. Last_Signal_Net loop
+            Num := Offs (I);
+            if Num /= 0 then
+               --  Reserve one slot for a prepended 'prop_end'.
+               Offs (I) := Last_Off + 1;
+               Last_Off := Last_Off + 1 + Num;
+            end if;
+         end loop;
+         Offs (0) := Last_Off + 1;
+
+         declare
+            Propag : Propag_Array (1 .. Last_Off);  --  := (others => 0);
+         begin
+            for I in Propagation.First .. Propagation.Last loop
+               Net := Get_Propagation_Net (I);
+               if Net /= No_Signal_Net then
+                  Propag (Offs (Net)) := Propagation.Table (I);
+                  Offs (Net) := Offs (Net) + 1;
+               end if;
+            end loop;
+            Propagation.Set_Last (Last_Off);
+            Propagation.Release;
+            for I in Propagation.First .. Propagation.Last loop
+               if Propag (I).Kind = Imp_Forward_Build then
+                  Propagation.Table (I) := (Kind => Imp_Forward,
+                                         Sig => Propag (I).Forward.Targ);
+                  Deallocate (Propag (I).Forward);
+               else
+                  Propagation.Table (I) := Propag (I);
+               end if;
+            end loop;
+         end;
+         for I in 1 .. Last_Signal_Net loop
+            --  Ignore holes.
+            if Offs (I) /= 0 then
+               Propagation.Table (Offs (I)) :=
+                 (Kind => Prop_End, Updated => True);
+            end if;
+         end loop;
+         Propagation.Table (1) := (Kind => Prop_End, Updated => True);
+
+         --  4) Convert back from offset to start position (on the prop_end
+         --     cell).
+         Offs (0) := 1;
+         Last_Off := 1;
+         for I in 1 .. Last_Signal_Net loop
+            if Offs (I) /= 0 then
+               Num := Offs (I);
+               Offs (I) := Last_Off;
+               Last_Off := Num;
+            end if;
+         end loop;
+
+         --  5) Re-map the nets to cell indexes.
+         for I in Sig_Table.First .. Sig_Table.Last loop
+            Sig := Sig_Table.Table (I);
+            if Sig.Net = No_Signal_Net then
+               if Sig.S.Resolv /= null then
+                  Sig.Net := Net_One_Resolved;
+               elsif Sig.S.Nbr_Drivers = 1 then
+                  if Sig.S.Drivers (0).Last_Trans.Kind = Trans_Direct then
+                     Sig.Net := Net_One_Direct;
+                  else
+                     Sig.Net := Net_One_Driver;
+                  end if;
+               end if;
+            else
+               Sig.Net := Offs (Sig.Net);
+            end if;
+            Sig.Link := null;
+         end loop;
+      end;
+   end Create_Nets;
+
+   function Get_Nbr_Future return Ghdl_I32
+   is
+      Res : Ghdl_I32;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Res := 0;
+      Sig := Future_List;
+      while Sig.Flink /= null loop
+         Res := Res + 1;
+         Sig := Sig.Flink;
+      end loop;
+      return Res;
+   end Get_Nbr_Future;
+
+   --  Check every scalar subelement of a resolved signal has a driver
+   --  in the same process.
+   procedure Check_Resolved_Driver (Resolv : Resolved_Signal_Acc)
+   is
+      First_Sig : Ghdl_Signal_Ptr;
+      Nbr : Ghdl_Index_Type;
+   begin
+      First_Sig := Sig_Table.Table (Resolv.Sig_Range.First);
+      Nbr := First_Sig.S.Nbr_Drivers;
+      for I in Resolv.Sig_Range.First + 1 .. Resolv.Sig_Range.Last loop
+         if Sig_Table.Table (I).S.Nbr_Drivers /= Nbr then
+            --  FIXME: provide more information (signal name, process name).
+            Error ("missing drivers for subelement of a resolved signal");
+         end if;
+      end loop;
+   end Check_Resolved_Driver;
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address;
+   pragma Import (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Resolved_Signal_Acc, Object => Resolved_Signal_Type);
+
+   procedure Order_All_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Resolv : Resolved_Signal_Acc;
+   begin
+      --  Do checks and optimization.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         --  LRM 5.3
+         --  If, by the above rules, no disconnection specification applies to
+         --  the drivers of a guarded, scalar signal S whose type mark is T
+         --  (including a scalar subelement of a composite signal), then the
+         --  following default disconnection specification is implicitly
+         --  assumed:
+         --    disconnect S : T after 0 ns;
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            Resolv := Sig.S.Resolv;
+            if Resolv /= null and then Resolv.Disconnect_Time = Bad_Time then
+               Resolv.Disconnect_Time := 0;
+            end if;
+
+            if Resolv /= null
+              and then Resolv.Sig_Range.First = I
+              and then Resolv.Sig_Range.Last > I
+            then
+               --  Check every scalar subelement of a resolved signal
+               --  has a driver in the same process.
+               Check_Resolved_Driver (Resolv);
+            end if;
+
+            if Resolv /= null
+              and then Resolv.Sig_Range.First = I
+              and then Resolv.Sig_Range.Last = I
+              and then
+              (Resolv.Resolv_Proc
+                 = To_Resolver_Acc (Ieee_Std_Logic_1164_Resolved_Resolv_Ptr))
+              and then Sig.S.Nbr_Drivers + Sig.Nbr_Ports <= 1
+            then
+               --  Optimization: remove resolver if there is at most one
+               --  source.
+               Free (Sig.S.Resolv);
+            end if;
+         end if;
+      end loop;
+
+      --  Really order them.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Order_Signal (Sig_Table.Table (I), Propag_Driving);
+      end loop;
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Order_Signal (Sig_Table.Table (I), Propag_Done);
+      end loop;
+
+      Create_Nets;
+   end Order_All_Signals;
+
+   --  Add SIG in active_chain.
+   procedure Add_Active_Chain (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Add_Active_Chain);
+
+   procedure Add_Active_Chain (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.Link = null then
+         Sig.Link := Ghdl_Signal_Active_Chain;
+         Ghdl_Signal_Active_Chain := Sig;
+      end if;
+   end Add_Active_Chain;
+
+   Clear_List : Ghdl_Signal_Ptr := null;
+
+   --  Mark SIG as active and put it on Clear_List (if not already).
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Mark_Active);
+
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if not Sig.Active then
+         Sig.Active := True;
+         Sig.Last_Active := Current_Time;
+         Sig.Alink := Clear_List;
+         Clear_List := Sig;
+      end if;
+   end Mark_Active;
+
+   procedure Set_Guard_Activity (Sig : Ghdl_Signal_Ptr) is
+   begin
+      for I in 1 .. Sig.Nbr_Ports loop
+         if Sig.Ports (I - 1).Active then
+            Mark_Active (Sig);
+            return;
+         end if;
+      end loop;
+   end Set_Guard_Activity;
+
+   procedure Set_Stable_Quiet_Activity
+     (Mode : Propagation_Kind_Type; Sig : Ghdl_Signal_Ptr) is
+   begin
+      case Mode is
+         when Imp_Stable =>
+            for I in 0 .. Sig.Nbr_Ports - 1 loop
+               if Sig.Ports (I).Event then
+                  Mark_Active (Sig);
+                  return;
+               end if;
+            end loop;
+         when Imp_Quiet
+           | Imp_Transaction =>
+            for I in 0 .. Sig.Nbr_Ports - 1 loop
+               if Sig.Ports (I).Active then
+                  Mark_Active (Sig);
+                  return;
+               end if;
+            end loop;
+         when others =>
+            Internal_Error ("set_stable_quiet_activity");
+      end case;
+   end Set_Stable_Quiet_Activity;
+
+   function Get_Resolved_Activity (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+      Trans : Transaction_Acc;
+      Res : Boolean := False;
+   begin
+      for J in 1 .. Sig.S.Nbr_Drivers loop
+         Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
+         if Trans /= null then
+            if Trans.Kind = Trans_Direct then
+               Direct_Assign (Sig.S.Drivers (J - 1).First_Trans.Val,
+                              Trans.Val_Ptr, Sig.Mode);
+               --  In fact we knew the signal was active!
+               Res := True;
+            elsif Trans.Time = Current_Time then
+               Free (Sig.S.Drivers (J - 1).First_Trans);
+               Sig.S.Drivers (J - 1).First_Trans := Trans;
+               Res := True;
+            end if;
+         end if;
+      end loop;
+      if Res then
+         return True;
+      end if;
+      for J in 1 .. Sig.Nbr_Ports loop
+         if Sig.Ports (J - 1).Active then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Get_Resolved_Activity;
+
+   procedure Set_Conversion_Activity (Conv : Sig_Conversion_Acc)
+   is
+      Active : Boolean := False;
+   begin
+      for I in Conv.Src.First .. Conv.Src.Last loop
+         Active := Active or Sig_Table.Table (I).Active;
+      end loop;
+      if Active then
+         Call_Conversion_Function (Conv);
+      end if;
+      for I in Conv.Dest.First .. Conv.Dest.Last loop
+         Sig_Table.Table (I).Active := Active;
+      end loop;
+   end Set_Conversion_Activity;
+
+   procedure Delayed_Implicit_Process (Sig : Ghdl_Signal_Ptr)
+   is
+      Pfx : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+      Last : Transaction_Acc;
+      Prev : Transaction_Acc;
+   begin
+      Pfx := Sig.Ports (0);
+      if Pfx.Event then
+         --  LRM 14.1
+         --  P: process (S)
+         --  begin
+         --     R <= transport S after T;
+         --  end process;
+         Trans := new Transaction'(Kind => Trans_Value,
+                                   Line => 0,
+                                   Time => Current_Time + Sig.S.Time,
+                                   Next => null,
+                                   Val => Pfx.Value);
+         --  Find the last transaction.
+         Last := Sig.S.Attr_Trans;
+         Prev := Last;
+         while Last.Next /= null loop
+            Prev := Last;
+            Last := Last.Next;
+         end loop;
+         --  Maybe, remove it.
+         if Last.Time > Trans.Time then
+            Internal_Error ("delayed time");
+         elsif Last.Time = Trans.Time then
+            if Prev /= Last then
+               Free (Last);
+            else
+               --  No transaction.
+               if Last.Time /= 0 then
+                  --  This can happen only at time = 0.
+                  Internal_Error ("delayed");
+               end if;
+            end if;
+         else
+            Prev := Last;
+         end if;
+         --  Append the transaction.
+         Prev.Next := Trans;
+         if Sig.S.Time = 0 then
+            Add_Active_Chain (Sig);
+         end if;
+      end if;
+   end Delayed_Implicit_Process;
+
+   --  Set the effective value of signal SIG to VAL.
+   --  If the value is different from the previous one, resume processes.
+   procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union)
+   is
+      El : Action_List_Acc;
+   begin
+      if not Value_Equal (Sig.Value, Val, Sig.Mode) then
+         Sig.Last_Value := Sig.Value;
+         Sig.Value := Val;
+         Sig.Event := True;
+         Sig.Last_Event := Current_Time;
+         Sig.Flags.Cyc_Event := True;
+
+         El := Sig.Event_List;
+         while El /= null loop
+            Resume_Process (El.Proc);
+            El := El.Next;
+         end loop;
+      end if;
+   end Set_Effective_Value;
+
+   procedure Run_Propagation (Start : Signal_Net_Type)
+   is
+      I : Signal_Net_Type;
+      Sig : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+      First_Trans : Transaction_Acc;
+   begin
+      I := Start;
+      loop
+         --  First: the driving value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               Sig := Propagation.Table (I).Sig;
+               First_Trans := Sig.S.Drivers (0).First_Trans;
+               Trans := First_Trans.Next;
+               if Trans /= null then
+                  if Trans.Kind = Trans_Direct then
+                     --  Note: already or will be marked as active in
+                     --    update_signals.
+                     Mark_Active (Sig);
+                     Direct_Assign (First_Trans.Val,
+                                    Trans.Val_Ptr, Sig.Mode);
+                     Sig.Driving_Value := First_Trans.Val;
+                  elsif Trans.Time = Current_Time then
+                     Mark_Active (Sig);
+                     Free (First_Trans);
+                     Sig.S.Drivers (0).First_Trans := Trans;
+                     case Trans.Kind is
+                        when Trans_Value =>
+                           Sig.Driving_Value := Trans.Val;
+                        when Trans_Direct =>
+                           Internal_Error ("run_propagation: trans_direct");
+                        when Trans_Null =>
+                           Error ("null transaction");
+                        when Trans_Error =>
+                           Error_Trans_Error (Trans);
+                     end case;
+                  end if;
+               end if;
+            when Drv_One_Resolved
+              | Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Get_Resolved_Activity (Sig) then
+                  Mark_Active (Sig);
+                  Compute_Resolved_Signal (Propagation.Table (I).Sig.S.Resolv);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Ports (0).Active then
+                  Mark_Active (Sig);
+                  Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+               end if;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               --  Note: the signal may have drivers (inout ports).
+               if Sig.S.Effective.Active and not Sig.Active then
+                  Mark_Active (Sig);
+               end if;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               declare
+                  Active : Boolean := False;
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Sig := Sig_Table.Table (I);
+                     Active := Active or Get_Resolved_Activity (Sig);
+                  end loop;
+                  if Active then
+                     --  Mark the first signal as active (since only this one
+                     --  will be checked to set effective value).
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        Mark_Active (Sig_Table.Table (I));
+                     end loop;
+                     Compute_Resolved_Signal (Resolv);
+                  end if;
+               end;
+            when Imp_Guard
+              | Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction
+              | Imp_Forward_Build =>
+               null;
+            when Imp_Forward =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Link = null then
+                  Sig.Link := Ghdl_Implicit_Signal_Active_Chain;
+                  Ghdl_Implicit_Signal_Active_Chain := Sig;
+               end if;
+            when Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               Trans := Sig.S.Attr_Trans.Next;
+               if Trans /= null and then Trans.Time = Current_Time then
+                  Mark_Active (Sig);
+                  Free (Sig.S.Attr_Trans);
+                  Sig.S.Attr_Trans := Trans;
+                  Sig.Driving_Value := Trans.Val;
+               end if;
+            when In_Conversion =>
+               null;
+            when Out_Conversion =>
+               Set_Conversion_Activity (Propagation.Table (I).Conv);
+            when Prop_End =>
+               return;
+            when Drv_Error =>
+               Internal_Error ("update signals");
+         end case;
+
+         --  Second: the effective value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Drv_One_Port
+              | Drv_One_Resolved
+              | Drv_Multiple =>
+               null;
+            when Eff_One_Driver
+              | Eff_One_Port
+              | Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+            when Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  if Sig_Table.Table (Resolv.Sig_Range.First).Active then
+                     --  If one signal is active, all are active.
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        Sig := Sig_Table.Table (I);
+                        Set_Effective_Value (Sig, Sig.Driving_Value);
+                     end loop;
+                  end if;
+               end;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.S.Effective.Value);
+               end if;
+            when Imp_Forward
+              | Imp_Forward_Build =>
+               null;
+            when Imp_Guard =>
+               --  Guard signal is active iff one of its dependence is active.
+               Sig := Propagation.Table (I).Sig;
+               Set_Guard_Activity (Sig);
+               if Sig.Active then
+                  Sig.Driving_Value.B1 :=
+                    Sig.S.Guard_Func.all (Sig.S.Guard_Instance);
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+            when Imp_Stable
+              | Imp_Quiet =>
+               Sig := Propagation.Table (I).Sig;
+               Set_Stable_Quiet_Activity (Propagation.Table (I).Kind, Sig);
+               if Sig.Active then
+                  Sig.Driving_Value :=
+                    Value_Union'(Mode => Mode_B1, B1 => False);
+                  --  Set driver.
+                  Trans := new Transaction'
+                    (Kind => Trans_Value,
+                     Line => 0,
+                     Time => Current_Time + Sig.S.Time,
+                     Next => null,
+                     Val => Value_Union'(Mode => Mode_B1, B1 => True));
+                  if Sig.S.Attr_Trans.Next /= null then
+                     Free (Sig.S.Attr_Trans.Next);
+                  end if;
+                  Sig.S.Attr_Trans.Next := Trans;
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+                  if Sig.S.Time = 0 then
+                     Add_Active_Chain (Sig);
+                  end if;
+               else
+                  Trans := Sig.S.Attr_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Mark_Active (Sig);
+                     Free (Sig.S.Attr_Trans);
+                     Sig.S.Attr_Trans := Trans;
+                     Sig.Driving_Value := Trans.Val;
+                     Set_Effective_Value (Sig, Sig.Driving_Value);
+                  end if;
+               end if;
+            when Imp_Transaction =>
+               --  LRM 12.6.3 Updating Implicit Signals
+               --  Finally, for any implicit signal S'Transaction, the current
+               --  value of the signal is modified if and only if S is active.
+               --  If signal S is active, then S'Transaction is updated by
+               --  assigning the value of the expression (not S'Transaction)
+               --  to the variable representing the current value of
+               --  S'Transaction.
+               Sig := Propagation.Table (I).Sig;
+               for I in 0 .. Sig.Nbr_Ports - 1 loop
+                  if Sig.Ports (I).Active then
+                     Mark_Active (Sig);
+                     Set_Effective_Value
+                       (Sig, Value_Union'(Mode => Mode_B1,
+                                          B1 => not Sig.Value.B1));
+                     exit;
+                  end if;
+               end loop;
+            when Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+               Delayed_Implicit_Process (Sig);
+            when In_Conversion =>
+               Set_Conversion_Activity (Propagation.Table (I).Conv);
+            when Out_Conversion =>
+               null;
+            when Prop_End =>
+               null;
+            when Drv_Error =>
+               Internal_Error ("run_propagation(2)");
+         end case;
+         I := I + 1;
+      end loop;
+   end Run_Propagation;
+
+   procedure Reset_Active_Flag
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      --  1) Reset active flag.
+      Sig := Clear_List;
+      Clear_List := null;
+      while Sig /= null loop
+         if Options.Flag_Stats then
+            if Sig.Active then
+               Nbr_Active := Nbr_Active + 1;
+            end if;
+            if Sig.Event then
+               Nbr_Events := Nbr_Events + 1;
+            end if;
+         end if;
+         Sig.Active := False;
+         Sig.Event := False;
+
+         Sig := Sig.Alink;
+      end loop;
+
+--       for I in Sig_Table.First .. Sig_Table.Last loop
+--          Sig := Sig_Table.Table (I);
+--          if Sig.Active or Sig.Event then
+--             Internal_Error ("reset_active_flag");
+--          end if;
+--       end loop;
+   end Reset_Active_Flag;
+
+   procedure Update_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Next_Sig : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+   begin
+      --  LRM93 12.6.2
+      --  1) Reset active flag.
+      Reset_Active_Flag;
+
+      --  For each active signals
+      Sig := Ghdl_Signal_Active_Chain;
+      Ghdl_Signal_Active_Chain := Signal_End;
+      while Sig.S.Mode_Sig /= Mode_End loop
+         Next_Sig := Sig.Link;
+         Sig.Link := null;
+
+         case Sig.Net is
+            when Net_One_Driver =>
+               --  This signal is active.
+               Mark_Active (Sig);
+
+               Trans := Sig.S.Drivers (0).First_Trans.Next;
+               Free (Sig.S.Drivers (0).First_Trans);
+               Sig.S.Drivers (0).First_Trans := Trans;
+               case Trans.Kind is
+                  when Trans_Value =>
+                     Sig.Driving_Value := Trans.Val;
+                  when Trans_Direct =>
+                     Internal_Error ("update_signals: trans_direct");
+                  when Trans_Null =>
+                     Error ("null transaction");
+                  when Trans_Error =>
+                     Error_Trans_Error (Trans);
+               end case;
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when Net_One_Direct =>
+               Mark_Active (Sig);
+               Sig.Is_Direct_Active := False;
+
+               Trans := Sig.S.Drivers (0).Last_Trans;
+               Direct_Assign (Sig.Driving_Value, Trans.Val_Ptr, Sig.Mode);
+               Sig.S.Drivers (0).First_Trans.Val := Sig.Driving_Value;
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when Net_One_Resolved =>
+               --  This signal is active.
+               Mark_Active (Sig);
+               Sig.Is_Direct_Active := False;
+
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
+                  if Trans /= null then
+                     if Trans.Kind = Trans_Direct then
+                        Direct_Assign (Sig.S.Drivers (J - 1).First_Trans.Val,
+                                       Trans.Val_Ptr, Sig.Mode);
+                     elsif Trans.Time = Current_Time then
+                        Free (Sig.S.Drivers (J - 1).First_Trans);
+                        Sig.S.Drivers (J - 1).First_Trans := Trans;
+                     end if;
+                  end if;
+               end loop;
+               Compute_Resolved_Signal (Sig.S.Resolv);
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when No_Signal_Net =>
+               Internal_Error ("update_signals: no_signal_net");
+
+            when others =>
+               Sig.Is_Direct_Active := False;
+               if not Propagation.Table (Sig.Net).Updated then
+                  Propagation.Table (Sig.Net).Updated := True;
+                  Run_Propagation (Sig.Net + 1);
+
+                  --  Put it on the list, so that updated flag will be cleared.
+                  Add_Active_Chain (Sig);
+               end if;
+         end case;
+
+         Sig := Next_Sig;
+      end loop;
+
+      --  Implicit signals (forwarded).
+      loop
+         Sig := Ghdl_Implicit_Signal_Active_Chain;
+         exit when Sig.Link = null;
+         Ghdl_Implicit_Signal_Active_Chain := Sig.Link;
+         Sig.Link := null;
+
+         if not Propagation.Table (Sig.Net).Updated then
+            Propagation.Table (Sig.Net).Updated := True;
+            Run_Propagation (Sig.Net + 1);
+
+            --  Put it on the list, so that updated flag will be cleared.
+            Add_Active_Chain (Sig);
+         end if;
+      end loop;
+
+      --  Un-mark updated.
+      Sig := Ghdl_Signal_Active_Chain;
+      Ghdl_Signal_Active_Chain := Signal_End;
+      while Sig.Link /= null loop
+         Propagation.Table (Sig.Net).Updated := False;
+         Next_Sig := Sig.Link;
+         Sig.Link := null;
+
+         --  Maybe put SIG in the active list, if it will be active during
+         --  the next cycle.
+         --  This can happen only for 'quiet, 'stable or 'delayed.
+         case Sig.S.Mode_Sig is
+            when Mode_Stable
+              | Mode_Quiet
+              | Mode_Delayed =>
+               declare
+                  Trans : Transaction_Acc;
+               begin
+                  Trans := Sig.S.Attr_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Sig.Link := Ghdl_Implicit_Signal_Active_Chain;
+                     Ghdl_Implicit_Signal_Active_Chain := Sig;
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+
+         Sig := Next_Sig;
+      end loop;
+   end Update_Signals;
+
+   procedure Run_Propagation_Init (Start : Signal_Net_Type)
+   is
+      I : Signal_Net_Type;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      I := Start;
+      loop
+         --  First: the driving value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               --  Nothing to do: drivers were already created.
+               null;
+            when Drv_One_Resolved
+              | Eff_One_Resolved =>
+               --  Execute the resolution function.
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Nbr_Ports > 0 then
+                  Compute_Resolved_Signal (Sig.S.Resolv);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port =>
+               --  Copy value.
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+            when Eff_Actual =>
+               null;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               Compute_Resolved_Signal (Propagation.Table (I).Resolv);
+            when Imp_Guard
+              | Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction
+              | Imp_Forward
+              | Imp_Forward_Build =>
+               null;
+            when Imp_Delayed =>
+               --  LRM 14.1
+               --  Assuming that the initial value of R is the same as the
+               --  initial value of S, [...]
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+            when In_Conversion =>
+               null;
+            when Out_Conversion =>
+               Call_Conversion_Function (Propagation.Table (I).Conv);
+            when Prop_End =>
+               return;
+            when Drv_Error =>
+               Internal_Error ("init_signals");
+         end case;
+
+         --  Second: the effective value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Drv_One_Port
+              | Drv_One_Resolved
+              | Drv_Multiple =>
+               null;
+            when Eff_One_Driver
+              | Eff_One_Port
+              | Eff_One_Resolved
+              | Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               Sig.Value := Sig.Driving_Value;
+            when Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Sig := Sig_Table.Table (I);
+                     Sig.Value := Sig.Driving_Value;
+                  end loop;
+               end;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               Sig.Value := Sig.S.Effective.Value;
+            when Imp_Guard =>
+               --  Guard signal is active iff one of its dependence is active.
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value.B1 :=
+                 Sig.S.Guard_Func.all (Sig.S.Guard_Instance);
+               Sig.Value := Sig.Driving_Value;
+            when Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction
+              | Imp_Forward
+              | Imp_Forward_Build =>
+               --  Already initialized during creation.
+               null;
+            when In_Conversion =>
+               Call_Conversion_Function (Propagation.Table (I).Conv);
+            when Out_Conversion =>
+               null;
+            when Prop_End =>
+               null;
+            when Drv_Error =>
+               Internal_Error ("init_signals(2)");
+         end case;
+
+         I := I + 1;
+      end loop;
+   end Run_Propagation_Init;
+
+   procedure Init_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         case Sig.Net is
+            when Net_One_Driver
+              | Net_One_Direct =>
+               --  Nothing to do: drivers were already created.
+               null;
+
+            when Net_One_Resolved =>
+               Sig.Has_Active := True;
+               if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then
+                  Compute_Resolved_Signal (Sig.S.Resolv);
+                  Sig.Value := Sig.Driving_Value;
+               end if;
+
+            when No_Signal_Net =>
+               null;
+
+            when others =>
+               if Propagation.Table (Sig.Net).Updated then
+                  Propagation.Table (Sig.Net).Updated := False;
+                  Run_Propagation_Init (Sig.Net + 1);
+               end if;
+         end case;
+      end loop;
+
+   end Init_Signals;
+
+   procedure Init is
+   begin
+      Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B1,
+                                               B1 => False),
+                                     Driving_Value => (Mode => Mode_B1,
+                                                       B1 => False),
+                                     Last_Value => (Mode => Mode_B1,
+                                                    B1 => False),
+                                     Last_Event => 0,
+                                     Last_Active => 0,
+                                     Event => False,
+                                     Active => False,
+                                     Has_Active => False,
+                                     Is_Direct_Active => False,
+                                     Sig_Kind => Kind_Signal_No,
+                                     Mode => Mode_B1,
+
+                                     Flags => (Propag => Propag_None,
+                                               Is_Dumped => False,
+                                               Cyc_Event => False,
+                                               Seen => False),
+
+                                     Net => No_Signal_Net,
+                                     Link => null,
+                                     Alink => null,
+                                     Flink => null,
+
+                                     Event_List => null,
+                                     Rti => null,
+
+                                     Nbr_Ports => 0,
+                                     Ports => null,
+
+                                     S => (Mode_Sig => Mode_End));
+
+      Ghdl_Signal_Active_Chain := Signal_End;
+      Ghdl_Implicit_Signal_Active_Chain := Signal_End;
+      Future_List := Signal_End;
+
+      Boolean_Signal_Rti.Obj_Type := Std_Standard_Boolean_RTI_Ptr;
+      Bit_Signal_Rti.Obj_Type := Std_Standard_Bit_RTI_Ptr;
+   end Init;
+
+end Grt.Signals;
diff --git a/src/translate/grt/grt-signals.ads b/src/translate/grt/grt-signals.ads
new file mode 100644
index 000000000..d792f1634
--- /dev/null
+++ b/src/translate/grt/grt-signals.ads
@@ -0,0 +1,919 @@
+--  GHDL Run Time (GRT) - signals management.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+with Ada.Unchecked_Conversion;
+with Grt.Table;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+limited with Grt.Processes;
+pragma Elaborate_All (Grt.Table);
+
+package Grt.Signals is
+   pragma Suppress (All_Checks);
+
+   --  Kind of transaction.
+   type Transaction_Kind is
+     (
+      --  Normal transaction, with a value.
+      Trans_Value,
+      --  Normal transaction, with a pointer to a value (direct assignment).
+      Trans_Direct,
+      --  Null transaction.
+      Trans_Null,
+      --  Like a normal transaction, but without a value due to check error.
+      Trans_Error
+     );
+
+   type Transaction;
+   type Transaction_Acc is access Transaction;
+   type Transaction (Kind : Transaction_Kind) is record
+      --  Line for error.  Put here to compact the record.
+      Line : Ghdl_I32;
+
+      Next : Transaction_Acc;
+      Time : Std_Time;
+      case Kind is
+         when Trans_Value =>
+            Val : Value_Union;
+         when Trans_Direct =>
+            Val_Ptr : Ghdl_Value_Ptr;
+         when Trans_Null =>
+            null;
+         when Trans_Error =>
+            --  Filename for error.
+            File : Ghdl_C_String;
+      end case;
+   end record;
+
+   type Process_Acc is access Grt.Processes.Process_Type;
+
+   --  A driver is bound to a process (PROC) and contains a list of
+   --  transactions.
+   type Driver_Type is record
+      First_Trans : Transaction_Acc;
+      Last_Trans : Transaction_Acc;
+      Proc : Process_Acc;
+   end record;
+
+   type Driver_Acc is access all Driver_Type;
+   type Driver_Fat_Array is array (Ghdl_Index_Type) of aliased Driver_Type;
+   type Driver_Arr_Ptr is access Driver_Fat_Array;
+
+   --  Function access type used to evaluate the guard expression.
+   type Guard_Func_Acc is access function (This : System.Address)
+                                          return Ghdl_B1;
+   pragma Convention (C, Guard_Func_Acc);
+
+   --  Simply linked list of processes to be resumed in case of events.
+
+   type Ghdl_Signal;
+   type Ghdl_Signal_Ptr is access Ghdl_Signal;
+
+   function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Ghdl_Signal_Ptr);
+
+   type Signal_Fat_Array is array (Ghdl_Index_Type) of Ghdl_Signal_Ptr;
+   type Signal_Arr_Ptr is access Signal_Fat_Array;
+
+   function To_Signal_Arr_Ptr is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Signal_Arr_Ptr);
+
+   --  List of processes to wake-up in case of event on the signal.
+   type Action_List;
+   type Action_List_Acc is access Action_List;
+
+   type Action_List (Dynamic : Boolean) is record
+      --  Next action for the current signal.
+      Next : Action_List_Acc;
+
+      --  Process to wake-up.
+      Proc : Process_Acc;
+
+      case Dynamic is
+         when True =>
+            --  For a non-sensitized process.
+            --  Previous action (to speed-up remove from the chain).
+            Prev : Action_List_Acc;
+
+            Sig : Ghdl_Signal_Ptr;
+
+            --  Chain of signals for the process.
+            Chain : Action_List_Acc;
+         when False =>
+            null;
+      end case;
+   end record;
+
+   --  Resolution function.
+   --  There is a wrapper around resolution functions to simplify the call
+   --  from GRT.
+   --  INSTANCE is the opaque parameter given when the resolver is
+   --   registers (RESOLV_INST).
+   --  VAL is the signal (which may be composite).
+   --  BOOL_VEC is an array of NBR_DRV booleans (bytes) and indicates
+   --  non-null drivers.  There are VEC_LEN non-null drivers.  So the number
+   --  of values is VEC_LEN + NBR_PORTS.  This number of values is the length
+   --  of the array for the resolution function.
+   type Resolver_Acc is access procedure
+     (Instance : System.Address;
+      Val : System.Address;
+      Bool_Vec : System.Address;
+      Vec_Len : Ghdl_Index_Type;
+      Nbr_Drv : Ghdl_Index_Type;
+      Nbr_Ports : Ghdl_Index_Type);
+
+   --  On some platforms, GNAT use a descriptor (instead of a trampoline) for
+   --  nested subprograms. This descriptor contains the address of the
+   --  subprogram and the address of the chain. An unaligned pointer to this
+   --  descriptor (address + 1) is then used for 'Access, and every indirect
+   --  call check for unaligned address.
+   --
+   --  Disable this feature (as a resolver is never a nested subprogram), so
+   --  code generated by ghdl is compatible with ghdl runtimes built with
+   --  gnat.
+   pragma Convention (C, Resolver_Acc);
+
+   --  How to compute resolved signal.
+   type Resolved_Signal_Type is record
+      Resolv_Proc : Resolver_Acc;
+      Resolv_Inst : System.Address;
+      Resolv_Ptr : System.Address;
+      Sig_Range : Sig_Table_Range;
+      Disconnect_Time : Std_Time;
+   end record;
+
+   type Resolved_Signal_Acc is access Resolved_Signal_Type;
+
+   type Conversion_Func_Acc is access procedure (Instance : System.Address);
+   pragma Convention (C, Conversion_Func_Acc);
+
+   function To_Conversion_Func_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Conversion_Func_Acc);
+
+   --  Signal conversion data.
+   type Sig_Conversion_Type is record
+      --  Function which performs the conversion.
+      Func : System.Address;
+      Instance : System.Address;
+
+      Src : Sig_Table_Range;
+      Dest : Sig_Table_Range;
+   end record;
+   type Sig_Conversion_Acc is access Sig_Conversion_Type;
+
+   type Forward_Build_Type is record
+      Src : Ghdl_Signal_Ptr;
+      Targ : Ghdl_Signal_Ptr;
+   end record;
+   type Forward_Build_Acc is access Forward_Build_Type;
+
+   --  Used to order the signals for the propagation of signals values.
+   type Propag_Order_Flag is
+     (
+      --  The signal was not yet ordered.
+      Propag_None,
+      --  The signal is being ordered for driving value.
+      --  This stage is used to catch loop (which can not occur).
+      Propag_Being_Driving,
+      --  The signal has been ordered for driving value.
+      Propag_Driving,
+      --  The signal is being ordered for effective value.
+      Propag_Being_Effective,
+      --  The signal has completly been ordered.
+      Propag_Done);
+
+   --  Each signal belongs to a signal_net.
+   --  Signals on the same net must be updated in order.
+   --  Signals on different nets have no direct relation-ship, and thus may
+   --  be updated without order.
+   --  Net NO_SIGNAL_NET is special: it groups all lonely signals.
+   type Signal_Net_Type is new Integer;
+   No_Signal_Net : constant Signal_Net_Type := 0;
+   Net_One_Driver : constant Signal_Net_Type := -1;
+   Net_One_Direct : constant Signal_Net_Type := -2;
+   Net_One_Resolved : constant Signal_Net_Type := -3;
+
+   --  Flush the list of active signals.
+   procedure Flush_Active_List;
+
+   type Ghdl_Signal_Data (Mode_Sig : Mode_Signal_Type := Mode_Signal)
+   is record
+      case Mode_Sig is
+         when Mode_Signal_User =>
+            Nbr_Drivers : Ghdl_Index_Type;
+            Drivers : Driver_Arr_Ptr;
+
+            --  Signal which defines the effective value of this signal,
+            --  if any.
+            Effective : Ghdl_Signal_Ptr;
+
+            --  Null if not resolved.
+            Resolv : Resolved_Signal_Acc;
+
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            --  Conversion paramaters for conv_in, conv_out.
+            Conv : Sig_Conversion_Acc;
+
+         when Mode_Stable
+           | Mode_Quiet
+           | Mode_Delayed =>
+            --  Time parameter for 'stable, 'quiet or 'delayed
+            Time : Std_Time;
+            Attr_Trans : Transaction_Acc;
+
+         when Mode_Guard =>
+            --  Guard function and instance used to compute the
+            --  guard expression.
+            Guard_Func : Guard_Func_Acc;
+            Guard_Instance : System.Address;
+
+         when Mode_Transaction
+           | Mode_End =>
+            null;
+      end case;
+   end record;
+   pragma Suppress (Discriminant_Check, On => Ghdl_Signal_Data);
+
+   type Ghdl_Signal_Flags is record
+      --  Status of the ordering.
+      Propag : Propag_Order_Flag;
+
+      --  If set, the signal is dumped in a GHW file.
+      Is_Dumped : Boolean;
+
+      --  Set when an event occured.
+      --  Only reset by GHW file dumper.
+      Cyc_Event : Boolean;
+
+      --  Set if the signal has already been visited.  When outside of the
+      --  algorithm that use it, it must be cleared.
+      Seen : Boolean;
+   end record;
+   pragma Pack (Ghdl_Signal_Flags);
+
+   type Ghdl_Signal is record
+      --  Fields known by the compilers.
+      Value : Value_Union;
+      Driving_Value : Value_Union;
+      Last_Value : Value_Union;
+      Last_Event : Std_Time;
+      Last_Active : Std_Time;
+
+      Event : Boolean;
+      Active : Boolean;
+      --  If set, the activity of the signal is required by the user.
+      Has_Active : Boolean;
+
+      --  Internal fields.
+      --  NOTE: keep above fields (components) in sync with translation.
+
+      --  If set, the signal has an active direct driver.
+      Is_Direct_Active : Boolean;
+
+      --  Kind of the signal (none, bus or register).
+      Sig_Kind : Kind_Signal_Type;
+
+      --  Values mode of this signal.
+      Mode : Mode_Type;
+
+      --  Misc flags.
+      Flags : Ghdl_Signal_Flags;
+
+      --  Net of the signal.
+      Net : Signal_Net_Type;
+
+      --  Chain of signals that will be active in the next delta-cycle.
+      --  (Also used to build nets).
+      Link : Ghdl_Signal_Ptr;
+
+      --  Chain of signals whose active flag was set.  Used to clear the active
+      --  flag at the end of the delta cycle.
+      Alink : Ghdl_Signal_Ptr;
+
+      --  Chain of signals that have a projected waveform in the real future.
+      Flink : Ghdl_Signal_Ptr;
+
+      --  List of processes to resume when there is an event on
+      --  this signal.
+      Event_List : Action_List_Acc;
+
+      --  Path of the signal (with its name) in the design hierarchy.
+      --  Used to get the type of the signal.
+      Rti : Ghdl_Rtin_Object_Acc;
+
+      --  For user signals: the sources of a signals are drivers
+      --  and connected ports.
+      --  For implicit signals: PORTS is used as dependence list.
+      Nbr_Ports : Ghdl_Index_Type;
+      Ports : Signal_Arr_Ptr;
+
+      --  Mode of the signal (in, out ...)
+      --Mode_Signal : Mode_Signal_Type;
+      S : Ghdl_Signal_Data;
+   end record;
+
+   --  Each simple signal declared can be accessed by SIG_TABLE.
+   package Sig_Table is new Grt.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Sig_Table_Index,
+      Table_Low_Bound => 0,
+      Table_Initial => 128);
+
+   --  Return the next time at which a driver becomes active.
+   function Find_Next_Time return Std_Time;
+
+   --  Elementary propagation computation.
+   --  See LRM 12.6.2 and 12.6.3
+   type Propagation_Kind_Type is
+     (
+      --  How to compute driving value:
+      --  Default value.
+      Drv_Error,
+
+      --  One source, a driver and not resolved:
+      --  the driving value is the driver.
+      Drv_One_Driver,
+
+      --  Same as previous, and the effective value is the driving value.
+      Eff_One_Driver,
+
+      --  One source, a port and not resolved:
+      --  the driving value is the driving value of the port.
+      --  Dependence.
+      Drv_One_Port,
+
+      --  Same as previous, and the effective value is the driving value.
+      Eff_One_Port,
+
+      --  Several sources or resolved:
+      --  signal is not composite.
+      Drv_One_Resolved,
+      Eff_One_Resolved,
+
+      --  Use the resolution function, signal is composite.
+      Drv_Multiple,
+
+      --  Same as previous, but the effective value is the previous value.
+      Eff_Multiple,
+
+      --  The effective value is the actual associated.
+      Eff_Actual,
+
+      --  Sig must be updated but does not belong to the same net.
+      Imp_Forward,
+      Imp_Forward_Build,
+
+      --  Implicit guard signal.
+      --  Its value must be evaluated after the effective value of its
+      --  dependences.
+      Imp_Guard,
+
+      --  Implicit stable.
+      --  Its value must be evaluated after the effective value of its
+      --  dependences.
+      Imp_Stable,
+
+      --  Implicit quiet.
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Quiet,
+
+      --  Implicit transaction.
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Transaction,
+
+      --  Implicit delayed
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Delayed,
+
+      --  in_conversion.
+      --  Pseudo-signal which is set by conversion function.
+      In_Conversion,
+      Out_Conversion,
+
+      --  End of propagation.
+      Prop_End
+      );
+
+   type Propagation_Type (Kind : Propagation_Kind_Type := Drv_Error) is record
+      case Kind is
+         when Drv_Error =>
+            null;
+         when Drv_One_Driver
+           | Eff_One_Driver
+           | Drv_One_Port
+           | Eff_One_Port
+           | Imp_Forward
+           | Imp_Guard
+           | Imp_Quiet
+           | Imp_Transaction
+           | Imp_Stable
+           | Imp_Delayed
+           | Eff_Actual
+           | Eff_One_Resolved
+           | Drv_One_Resolved =>
+            Sig : Ghdl_Signal_Ptr;
+         when Drv_Multiple
+           | Eff_Multiple =>
+            Resolv : Resolved_Signal_Acc;
+         when In_Conversion
+           | Out_Conversion =>
+            Conv : Sig_Conversion_Acc;
+         when Imp_Forward_Build =>
+            Forward : Forward_Build_Acc;
+         when Prop_End =>
+            Updated : Boolean;
+      end case;
+   end record;
+
+   package Propagation is new Grt.Table
+     (Table_Component_Type => Propagation_Type,
+      Table_Index_Type => Signal_Net_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 128);
+
+   --  Get the signal index of PTR.
+   function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index;
+
+   --  Compute propagation order of signals.
+   procedure Order_All_Signals;
+
+   --  Initialize the package (mainly the lists).
+   procedure Init;
+
+   --  Initialize all signals.
+   procedure Init_Signals;
+
+   --  Update signals.
+   procedure Update_Signals;
+
+   --  Set the effective value of signal SIG to VAL.
+   --  If the value is different from the previous one, resume processes.
+   procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union);
+
+   --  Add PROC in the list of processes to be resumed in case of event on
+   --  SIG.
+   procedure Resume_Process_If_Event
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc);
+
+   --  Creating a signal:
+   --  1a) call Ghdl_Signal_Name_Rti (CTXT and ADDR are unused) to register
+   --      the RTI for the whole signal (in particular the mode and the
+   --      has_active flag)
+   --  or
+   --  1b) call Ghdl_Signal_Set_Mode to register the mode and the has_active
+   --      flag.  In that case, the signal has no name.
+   --
+   --  2) call Ghdl_Create_Signal_XXX for each non-composite element
+
+   procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
+                                   Ctxt : Ghdl_Rti_Access;
+                                   Addr : System.Address);
+
+   procedure Ghdl_Signal_Set_Mode (Mode : Mode_Signal_Type;
+                                   Kind : Kind_Signal_Type;
+                                   Has_Active : Boolean);
+
+   --  FIXME: document.
+   --  Merge RTI with SIG: adjust the has_active flag of SIG according to RTI.
+   procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
+                                    Rti : Ghdl_Rti_Access);
+
+   --  Assigning a waveform to a signal:
+   --
+   --  For simple waveform (sig <= val), the short form can be used:
+   --    Ghdl_Signal_Simple_Assign_XX (Sig, Val);
+   --  For all other forms
+   --  SIG <= reject R inertial V1 after T1, V2 after T2, ...:
+   --    Ghdl_Signal_Start_Assign_XX (SIG, R, V1, T1);
+   --    Ghdl_Signal_Next_Assign_XX (SIG, V2, T2);
+   --    ...
+   --  If the delay mechanism is transport, they R = 0,
+   --  if there is no rejection time, the mechanism is internal and R = T1.
+
+   --  Performs some internal checks on signals (transaction order).
+   --  Internal_error is called in case of error.
+   procedure Ghdl_Signal_Internal_Checks;
+
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                              File : Ghdl_C_String;
+                                              Line : Ghdl_I32);
+   procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                             Rej : Std_Time;
+                                             After : Std_Time;
+                                             File : Ghdl_C_String;
+                                             Line : Ghdl_I32);
+   procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                            After : Std_Time;
+                                            File : Ghdl_C_String;
+                                            Line : Ghdl_I32);
+
+   procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr);
+
+   procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
+                                         Time : Std_Time);
+
+   procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr);
+
+   procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr;
+                                            Rej : Std_Time;
+                                            After : Std_Time);
+
+   function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1;
+
+   function Ghdl_Create_Signal_B1 (Init_Val : Ghdl_B1;
+                                   Resolv_Func : Resolver_Acc;
+                                   Resolv_Inst : System.Address)
+                                  return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1);
+   procedure Ghdl_Signal_Associate_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1);
+   procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B1);
+   procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B1;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B1;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_B1;
+
+   function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8;
+                                   Resolv_Func : Resolver_Acc;
+                                   Resolv_Inst : System.Address)
+                                  return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8);
+   procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8);
+   procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_E8);
+   procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_E8;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_E8;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E8;
+
+   function Ghdl_Create_Signal_E32 (Init_Val : Ghdl_E32;
+                                    Resolv_Func : Resolver_Acc;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32);
+   procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32);
+   procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_E32);
+   procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_E32;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_E32;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E32;
+
+   function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32;
+                                    Resolv_Func : Resolver_Acc;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32);
+   procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32);
+   procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I32);
+   procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I32;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I32;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_I32;
+
+   function Ghdl_Create_Signal_I64 (Init_Val : Ghdl_I64;
+                                    Resolv_Func : Resolver_Acc;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64);
+   procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64);
+   procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I64);
+   procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I64;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I64;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I64;
+
+   function Ghdl_Create_Signal_F64 (Init_Val : Ghdl_F64;
+                                    Resolv_Func : Resolver_Acc;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64);
+   procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64);
+   procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_F64);
+   procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_F64;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_F64;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_F64;
+
+   --  Add a driver to SIGN for the current process.
+   procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr);
+
+   --  Add a direct driver for the current process.  This is an optimization
+   --  that could be used when a driver has no projected waveforms.
+   --
+   --  Assignment using direct driver:
+   --  * the driver value is set
+   --  * put the signal on the ghdl_signal_active_chain, if the signal will
+   --    be active and if not already on the chain.
+   procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr;
+                                            Drv : Ghdl_Value_Ptr);
+
+   --  Used for connexions:
+   --  SRC is a source for TARG.
+   procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr;
+                                     Src : Ghdl_Signal_Ptr);
+
+   --  The effective value of TARG is the effective value of SRC.
+   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
+                                          Src : Ghdl_Signal_Ptr);
+
+   --  Conversions.  In order to do conversion from A to B, an intermediate
+   --  signal T must be created.  The flow is A -> T -> B.
+   --  The link from A -> T is a conversion, added by one of the two
+   --  following procedures.  The type of A and T is different.
+   --  The link from T -> B is a normal connection: either an effective
+   --  one (for in conversion) or a source (for out conversion).
+
+   --  Add an in conversion (from SRC to DEST using function FUNC).
+   --  The effective value can be read and writen directly.
+   procedure Ghdl_Signal_In_Conversion (Func : System.Address;
+                                        Instance : System.Address;
+                                        Src : Ghdl_Signal_Ptr;
+                                        Src_Len : Ghdl_Index_Type;
+                                        Dst : Ghdl_Signal_Ptr;
+                                        Dst_Len : Ghdl_Index_Type);
+
+   --  Add an out conversion.
+   --  The driving value can be read and writen directly.
+   procedure Ghdl_Signal_Out_Conversion (Func : System.Address;
+                                         Instance : System.Address;
+                                         Src : Ghdl_Signal_Ptr;
+                                         Src_Len : Ghdl_Index_Type;
+                                         Dst : Ghdl_Signal_Ptr;
+                                         Dst_Len : Ghdl_Index_Type);
+
+   --  Mark the next (and not yet created) NBR_SIG signals as resolved.
+   procedure Ghdl_Signal_Create_Resolution (Proc : Resolver_Acc;
+                                            Instance : System.Address;
+                                            Sig : System.Address;
+                                            Nbr_Sig : Ghdl_Index_Type);
+
+   --  Create a new 'stable (VAL) signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
+   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+   --  Create a new 'quiet (VAL) signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
+   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+   --  Create a new 'transaction signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
+   function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr;
+
+   --  Create a new SIG'delayed (VAL) signal.
+   function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time)
+                                       return Ghdl_Signal_Ptr;
+
+   --  Add SIG in the set of prefix for the last created signal.
+   procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr);
+
+   --  Create a new implicitly defined GUARD signal.
+   function Ghdl_Signal_Create_Guard (This : System.Address;
+                                      Proc : Guard_Func_Acc)
+                                     return Ghdl_Signal_Ptr;
+
+   --  Add SIG to the list of referenced signals that appear in the guard
+   --  expression.
+   procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr);
+
+   --  Return number of ports/drivers.
+   function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr)
+                                      return Ghdl_Index_Type;
+   function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr)
+                                        return Ghdl_Index_Type;
+
+   --  Read a source (port or driver) from a signal.  This is used by
+   --  resolution functions.
+   function Ghdl_Signal_Read_Port
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr;
+   function Ghdl_Signal_Read_Driver
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr;
+
+   Ghdl_Signal_Active_Chain : aliased Ghdl_Signal_Ptr;
+
+   --  Statistics.
+   Nbr_Active : Ghdl_I32;
+   Nbr_Events: Ghdl_I32;
+   function Get_Nbr_Future return Ghdl_I32;
+private
+   pragma Export (C, Ghdl_Signal_Name_Rti,
+                  "__ghdl_signal_name_rti");
+   pragma Export (C, Ghdl_Signal_Merge_Rti,
+                  "__ghdl_signal_merge_rti");
+
+   pragma Export (C, Ghdl_Signal_Simple_Assign_Error,
+                  "__ghdl_signal_simple_assign_error");
+   pragma Export (C, Ghdl_Signal_Start_Assign_Error,
+                  "__ghdl_signal_start_assign_error");
+   pragma Export (C, Ghdl_Signal_Next_Assign_Error,
+                  "__ghdl_signal_next_assign_error");
+
+   pragma Export (C, Ghdl_Signal_Start_Assign_Null,
+                  "__ghdl_signal_start_assign_null");
+
+   pragma Export (C, Ghdl_Signal_Direct_Assign,
+                  "__ghdl_signal_direct_assign");
+
+   pragma Export (C, Ghdl_Signal_Set_Disconnect,
+                  "__ghdl_signal_set_disconnect");
+   pragma Export (C, Ghdl_Signal_Disconnect,
+                  "__ghdl_signal_disconnect");
+
+   pragma Export (Ada, Ghdl_Signal_Driving,
+                  "__ghdl_signal_driving");
+
+   pragma Export (Ada, Ghdl_Create_Signal_B1,
+                  "__ghdl_create_signal_b1");
+   pragma Export (Ada, Ghdl_Signal_Init_B1,
+                  "__ghdl_signal_init_b1");
+   pragma Export (Ada, Ghdl_Signal_Associate_B1,
+                  "__ghdl_signal_associate_b1");
+   pragma Export (Ada, Ghdl_Signal_Simple_Assign_B1,
+                  "__ghdl_signal_simple_assign_b1");
+   pragma Export (Ada, Ghdl_Signal_Start_Assign_B1,
+                  "__ghdl_signal_start_assign_b1");
+   pragma Export (Ada, Ghdl_Signal_Next_Assign_B1,
+                  "__ghdl_signal_next_assign_b1");
+   pragma Export (Ada, Ghdl_Signal_Driving_Value_B1,
+                  "__ghdl_signal_driving_value_b1");
+
+   pragma Export (C, Ghdl_Create_Signal_E8,
+                  "__ghdl_create_signal_e8");
+   pragma Export (C, Ghdl_Signal_Init_E8,
+                  "__ghdl_signal_init_e8");
+   pragma Export (C, Ghdl_Signal_Associate_E8,
+                  "__ghdl_signal_associate_e8");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_E8,
+                  "__ghdl_signal_simple_assign_e8");
+   pragma Export (C, Ghdl_Signal_Start_Assign_E8,
+                  "__ghdl_signal_start_assign_e8");
+   pragma Export (C, Ghdl_Signal_Next_Assign_E8,
+                  "__ghdl_signal_next_assign_e8");
+   pragma Export (C, Ghdl_Signal_Driving_Value_E8,
+                  "__ghdl_signal_driving_value_e8");
+
+   pragma Export (C, Ghdl_Create_Signal_E32,
+                  "__ghdl_create_signal_e32");
+   pragma Export (C, Ghdl_Signal_Init_E32,
+                  "__ghdl_signal_init_e32");
+   pragma Export (C, Ghdl_Signal_Associate_E32,
+                  "__ghdl_signal_associate_e32");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_E32,
+                  "__ghdl_signal_simple_assign_e32");
+   pragma Export (C, Ghdl_Signal_Start_Assign_E32,
+                  "__ghdl_signal_start_assign_e32");
+   pragma Export (C, Ghdl_Signal_Next_Assign_E32,
+                  "__ghdl_signal_next_assign_e32");
+   pragma Export (C, Ghdl_Signal_Driving_Value_E32,
+                  "__ghdl_signal_driving_value_e32");
+
+   pragma Export (C, Ghdl_Create_Signal_I32,
+                  "__ghdl_create_signal_i32");
+   pragma Export (C, Ghdl_Signal_Init_I32,
+                  "__ghdl_signal_init_i32");
+   pragma Export (C, Ghdl_Signal_Associate_I32,
+                  "__ghdl_signal_associate_i32");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_I32,
+                  "__ghdl_signal_simple_assign_i32");
+   pragma Export (C, Ghdl_Signal_Start_Assign_I32,
+                  "__ghdl_signal_start_assign_i32");
+   pragma Export (C, Ghdl_Signal_Next_Assign_I32,
+                  "__ghdl_signal_next_assign_i32");
+   pragma Export (C, Ghdl_Signal_Driving_Value_I32,
+                  "__ghdl_signal_driving_value_i32");
+
+   pragma Export (C, Ghdl_Create_Signal_I64,
+                  "__ghdl_create_signal_i64");
+   pragma Export (C, Ghdl_Signal_Init_I64,
+                  "__ghdl_signal_init_i64");
+   pragma Export (C, Ghdl_Signal_Associate_I64,
+                  "__ghdl_signal_associate_i64");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_I64,
+                  "__ghdl_signal_simple_assign_i64");
+   pragma Export (C, Ghdl_Signal_Start_Assign_I64,
+                  "__ghdl_signal_start_assign_i64");
+   pragma Export (C, Ghdl_Signal_Next_Assign_I64,
+                  "__ghdl_signal_next_assign_i64");
+   pragma Export (C, Ghdl_Signal_Driving_Value_I64,
+                  "__ghdl_signal_driving_value_i64");
+
+   pragma Export (C, Ghdl_Create_Signal_F64,
+                  "__ghdl_create_signal_f64");
+   pragma Export (C, Ghdl_Signal_Init_F64,
+                  "__ghdl_signal_init_f64");
+   pragma Export (C, Ghdl_Signal_Associate_F64,
+                  "__ghdl_signal_associate_f64");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_F64,
+                  "__ghdl_signal_simple_assign_f64");
+   pragma Export (C, Ghdl_Signal_Start_Assign_F64,
+                  "__ghdl_signal_start_assign_f64");
+   pragma Export (C, Ghdl_Signal_Next_Assign_F64,
+                  "__ghdl_signal_next_assign_f64");
+   pragma Export (C, Ghdl_Signal_Driving_Value_F64,
+                  "__ghdl_signal_driving_value_f64");
+
+   pragma Export (C, Ghdl_Process_Add_Driver,
+                  "__ghdl_process_add_driver");
+   pragma Export (C, Ghdl_Signal_Add_Direct_Driver,
+                  "__ghdl_signal_add_direct_driver");
+
+   pragma Export (C, Ghdl_Signal_Add_Source,
+                  "__ghdl_signal_add_source");
+   pragma Export (C, Ghdl_Signal_Effective_Value,
+                  "__ghdl_signal_effective_value");
+   pragma Export (C, Ghdl_Signal_In_Conversion,
+                  "__ghdl_signal_in_conversion");
+   pragma Export (C, Ghdl_Signal_Out_Conversion,
+                  "__ghdl_signal_out_conversion");
+
+   pragma Export (C, Ghdl_Signal_Create_Resolution,
+                  "__ghdl_signal_create_resolution");
+
+   pragma Export (C, Ghdl_Create_Stable_Signal,
+                  "__ghdl_create_stable_signal");
+   pragma Export (C, Ghdl_Create_Quiet_Signal,
+                  "__ghdl_create_quiet_signal");
+   pragma Export (C, Ghdl_Create_Transaction_Signal,
+                  "__ghdl_create_transaction_signal");
+   pragma Export (C, Ghdl_Signal_Attribute_Register_Prefix,
+                  "__ghdl_signal_attribute_register_prefix");
+   pragma Export (C, Ghdl_Create_Delayed_Signal,
+                  "__ghdl_create_delayed_signal");
+
+   pragma Export (Ada, Ghdl_Signal_Create_Guard,
+                  "__ghdl_signal_create_guard");
+   pragma Export (C, Ghdl_Signal_Guard_Dependence,
+                  "__ghdl_signal_guard_dependence");
+
+   pragma Export (C, Ghdl_Signal_Get_Nbr_Ports,
+                  "__ghdl_signal_get_nbr_ports");
+   pragma Export (C, Ghdl_Signal_Get_Nbr_Drivers,
+                  "__ghdl_signal_get_nbr_drivers");
+   pragma Export (C, Ghdl_Signal_Read_Port,
+                  "__ghdl_signal_read_port");
+   pragma Export (C, Ghdl_Signal_Read_Driver,
+                  "__ghdl_signal_read_driver");
+
+   pragma Export (C, Ghdl_Signal_Active_Chain,
+                  "__ghdl_signal_active_chain");
+
+end Grt.Signals;
diff --git a/src/translate/grt/grt-stack2.adb b/src/translate/grt/grt-stack2.adb
new file mode 100644
index 000000000..82341d072
--- /dev/null
+++ b/src/translate/grt/grt-stack2.adb
@@ -0,0 +1,205 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Grt.Errors; use Grt.Errors;
+with Grt.Stdio;
+with Grt.Astdio;
+
+package body Grt.Stack2 is
+   --  This should be storage_elements.storage_element, but I don't want to
+   --  use system.storage_elements package (not pure).  Unfortunatly, this is
+   --  currently a failure (storage_elements is automagically used).
+   type Memory is array (Mark_Id range <>) of Character;
+
+   type Chunk_Type (First, Last : Mark_Id);
+   type Chunk_Acc is access all Chunk_Type;
+   type Chunk_Type (First, Last : Mark_Id) is record
+      Next : Chunk_Acc;
+      Mem : Memory (First .. Last);
+   end record;
+
+   type Stack2_Type is record
+      First_Chunk : Chunk_Acc;
+      Last_Chunk : Chunk_Acc;
+      Top : Mark_Id;
+   end record;
+   type Stack2_Acc is access all Stack2_Type;
+
+   function To_Acc is new Ada.Unchecked_Conversion
+     (Source => Stack2_Ptr, Target => Stack2_Acc);
+   function To_Addr is new Ada.Unchecked_Conversion
+     (Source => Stack2_Acc, Target => Stack2_Ptr);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Chunk_Type, Name => Chunk_Acc);
+
+   function Mark (S : Stack2_Ptr) return Mark_Id
+   is
+      S2 : Stack2_Acc;
+   begin
+      S2 := To_Acc (S);
+      return S2.Top;
+   end Mark;
+
+   procedure Release (S : Stack2_Ptr; Mark : Mark_Id)
+   is
+      S2 : Stack2_Acc;
+   begin
+      S2 := To_Acc (S);
+      S2.Top := Mark;
+   end Release;
+
+   function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
+     return System.Address
+   is
+      pragma Suppress (All_Checks);
+
+      S2 : Stack2_Acc;
+      Chunk : Chunk_Acc;
+      N_Chunk : Chunk_Acc;
+
+      Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
+      Max_Size  : constant Mark_Id :=
+        ((Mark_Id (Size) + Max_Align - 1) / Max_Align) * Max_Align;
+
+      Res : System.Address;
+   begin
+      S2 := To_Acc (S);
+
+      --  Find the chunk to which S2.TOP belong.
+      Chunk := S2.First_Chunk;
+      loop
+         exit when S2.Top >= Chunk.First and S2.Top <= Chunk.Last;
+         Chunk := Chunk.Next;
+         exit when Chunk = null;
+      end loop;
+
+      if Chunk /= null then
+         --  If there is enough place in it, allocate from the chunk.
+         if S2.Top + Max_Size <= Chunk.Last then
+            Res := Chunk.Mem (S2.Top)'Address;
+            S2.Top := S2.Top + Max_Size;
+            return Res;
+         end if;
+
+         --  If there is not enough place in it:
+         --    find a chunk which has enough room, deallocate skipped chunk.
+         loop
+            N_Chunk := Chunk.Next;
+            exit when N_Chunk = null;
+            if N_Chunk.Last - N_Chunk.First + 1 < Max_Size then
+               --  Not enough place in this chunk.
+               Chunk.Next := N_Chunk.Next;
+               Free (N_Chunk);
+               if Chunk.Next = null then
+                  S2.Last_Chunk := Chunk;
+                  exit;
+               end if;
+            else
+               Res := N_Chunk.Mem (N_Chunk.First)'Address;
+               S2.Top := N_Chunk.First + Max_Size;
+               return Res;
+            end if;
+         end loop;
+      end if;
+
+      --    If not such chunk, allocate a chunk
+      S2.Top := S2.Last_Chunk.Last + 1;
+      Chunk := new Chunk_Type (First => S2.Top,
+                               Last => S2.Top + Max_Size - 1);
+      Chunk.Next := null;
+      S2.Last_Chunk.Next := Chunk;
+      S2.Last_Chunk := Chunk;
+      S2.Top := Chunk.Last + 1;
+      return Chunk.Mem (Chunk.First)'Address;
+   end Allocate;
+
+   function Create return Stack2_Ptr is
+      Res : Stack2_Acc;
+      Chunk : Chunk_Acc;
+   begin
+      Chunk := new Chunk_Type (First => 1, Last => 8 * 1024);
+      Chunk.Next := null;
+      Res := new Stack2_Type'(First_Chunk => Chunk,
+                              Last_Chunk => Chunk,
+                              Top => 1);
+      return To_Addr (Res);
+   end Create;
+
+   procedure Check_Empty (S : Stack2_Ptr)
+   is
+      S2 : Stack2_Acc;
+   begin
+      S2 := To_Acc (S);
+      if S2 /= null and then S2.Top /= S2.First_Chunk.First then
+         Internal_Error ("stack2.check_empty: stack is not empty");
+      end if;
+   end Check_Empty;
+
+   --  May be used to debug.
+   procedure Dump_Stack2 (S : Stack2_Ptr);
+   pragma Unreferenced (Dump_Stack2);
+
+   procedure Dump_Stack2 (S : Stack2_Ptr)
+   is
+      use Grt.Astdio;
+      use Grt.Stdio;
+      use System;
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Chunk_Acc, Target => Address);
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Mark_Id, Target => Address);
+      S2 : Stack2_Acc;
+      Chunk : Chunk_Acc;
+   begin
+      S2 := To_Acc (S);
+      Put ("Stack 2 at ");
+      Put (stdout, Address (S));
+      New_Line;
+      Put ("First Chunk at ");
+      Put (stdout, To_Address (S2.First_Chunk));
+      Put (", last chunk at ");
+      Put (stdout, To_Address (S2.Last_Chunk));
+      Put (", top at ");
+      Put (stdout, To_Address (S2.Top));
+      New_Line;
+      Chunk := S2.First_Chunk;
+      while Chunk /= null loop
+         Put ("Chunk ");
+         Put (stdout, To_Address (Chunk));
+         Put (": first: ");
+         Put (stdout, To_Address (Chunk.First));
+         Put (", last: ");
+         Put (stdout, To_Address (Chunk.Last));
+         Put (", len: ");
+         Put (stdout, To_Address (Chunk.Last - Chunk.First + 1));
+         Put (", next = ");
+         Put (stdout, To_Address (Chunk.Next));
+         New_Line;
+         Chunk := Chunk.Next;
+      end loop;
+   end Dump_Stack2;
+end Grt.Stack2;
diff --git a/src/translate/grt/grt-stack2.ads b/src/translate/grt/grt-stack2.ads
new file mode 100644
index 000000000..b3de6b76d
--- /dev/null
+++ b/src/translate/grt/grt-stack2.ads
@@ -0,0 +1,43 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+with Grt.Types; use Grt.Types;
+
+--  Secondary stack management.
+package Grt.Stack2 is
+   type Stack2_Ptr is new System.Address;
+   Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
+
+   type Mark_Id is new Integer_Address;
+
+   function Mark (S : Stack2_Ptr) return Mark_Id;
+   procedure Release (S : Stack2_Ptr; Mark : Mark_Id);
+   function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
+     return System.Address;
+   function Create return Stack2_Ptr;
+
+   --  Check S is empty.
+   procedure Check_Empty (S : Stack2_Ptr);
+end Grt.Stack2;
diff --git a/src/translate/grt/grt-stacks.adb b/src/translate/grt/grt-stacks.adb
new file mode 100644
index 000000000..adb008d02
--- /dev/null
+++ b/src/translate/grt/grt-stacks.adb
@@ -0,0 +1,43 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Stacks is
+   procedure Error_Grow_Failed is
+   begin
+      Error ("cannot grow the stack");
+   end Error_Grow_Failed;
+
+   procedure Error_Memory_Access is
+   begin
+      Error
+        ("invalid memory access (dangling accesses or stack size too small)");
+   end Error_Memory_Access;
+
+   procedure Error_Null_Access is
+   begin
+      Error ("NULL access dereferenced");
+   end Error_Null_Access;
+end Grt.Stacks;
diff --git a/src/translate/grt/grt-stacks.ads b/src/translate/grt/grt-stacks.ads
new file mode 100644
index 000000000..dd9434080
--- /dev/null
+++ b/src/translate/grt/grt-stacks.ads
@@ -0,0 +1,87 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Ada.Unchecked_Conversion;
+
+package Grt.Stacks is
+   --  Instance is the parameter of the process procedure.
+   --  This is in fact a fully opaque type whose content is private to the
+   --  process.
+   type Instance is limited private;
+   type Instance_Acc is access all Instance;
+   pragma Convention (C, Instance_Acc);
+
+   --  A process is identified by a procedure having a single private
+   --  parameter (its instance).
+   type Proc_Acc is access procedure (Self : Instance_Acc);
+   pragma Convention (C, Proc_Acc);
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Instance_Acc, System.Address);
+
+   type Stack_Type is new Address;
+   Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
+
+   --  Initialize the stacks package.
+   --  This may adjust stack sizes.
+   --  Must be called after grt.options.decode.
+   procedure Stack_Init;
+
+   --  Create a new stack, which on first execution will call FUNC with
+   --  an argument ARG.
+   function Stack_Create (Func : Proc_Acc; Arg : Instance_Acc)
+                         return Stack_Type;
+
+   --  Resume stack TO and save the current context to the stack pointed by
+   --  CUR.
+   procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
+
+   --  Delete stack STACK, which must not be currently executed.
+   procedure Stack_Delete (Stack : Stack_Type);
+
+   --  Error during stack handling:
+   --  Cannot grow the stack.
+   procedure Error_Grow_Failed;
+   pragma No_Return (Error_Grow_Failed);
+
+   --  Invalid memory access detected (other than dereferencing a NULL access).
+   procedure Error_Memory_Access;
+   pragma No_Return (Error_Memory_Access);
+
+   --  A NULL access is dereferenced.
+   procedure Error_Null_Access;
+   pragma No_Return (Error_Null_Access);
+private
+   type Instance is null record;
+
+   pragma Import (C, Stack_Init, "grt_stack_init");
+   pragma Import (C, Stack_Create, "grt_stack_create");
+   pragma Import (C, Stack_Switch, "grt_stack_switch");
+   pragma Import (C, Stack_Delete, "grt_stack_delete");
+
+   pragma Export (C, Error_Grow_Failed, "grt_stack_error_grow_failed");
+   pragma Export (C, Error_Memory_Access, "grt_stack_error_memory_access");
+   pragma Export (C, Error_Null_Access, "grt_stack_error_null_access");
+end Grt.Stacks;
diff --git a/src/translate/grt/grt-stats.adb b/src/translate/grt/grt-stats.adb
new file mode 100644
index 000000000..5bc046d00
--- /dev/null
+++ b/src/translate/grt/grt-stats.adb
@@ -0,0 +1,370 @@
+--  GHDL Run Time (GRT) - statistics.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Signals;
+with Grt.Processes;
+with Grt.Types; use Grt.Types;
+with Grt.Disp;
+
+package body Grt.Stats is
+   type Clock_T is new Integer;
+
+   type Time_Stats is record
+      Wall : Clock_T;
+      User : Clock_T;
+      Sys : Clock_T;
+   end record;
+
+   --  Number of CLOCK_T per second.
+   One_Second : Clock_T;
+
+
+   --  Get number of seconds per CLOCK_T.
+   function Get_Clk_Tck return Clock_T;
+   pragma Import (C, Get_Clk_Tck, "grt_get_clk_tck");
+
+   --  Get wall, user and system times.
+   --  This is a binding to times(2).
+   procedure Get_Times (Wall : Address; User : Address; Sys : Address);
+   pragma Import (C, Get_Times, "grt_get_times");
+
+   procedure Get_Stats (Stats : out Time_Stats)
+   is
+   begin
+      Get_Times (Stats.Wall'Address, Stats.User'Address, Stats.Sys'Address);
+   end Get_Stats;
+
+   function "-" (L : Time_Stats; R : Time_Stats) return Time_Stats
+   is
+   begin
+      return Time_Stats'(Wall => L.Wall - R.Wall,
+                         User => L.User - R.User,
+                         Sys => L.Sys - R.Sys);
+   end "-";
+
+   function "+" (L : Time_Stats; R : Time_Stats) return Time_Stats
+   is
+   begin
+      return Time_Stats'(Wall => L.Wall + R.Wall,
+                         User => L.User + R.User,
+                         Sys => L.Sys + R.Sys);
+   end "+";
+
+   procedure Put (Stream : FILEs; Val : Clock_T)
+   is
+      procedure Fprintf_Clock (Stream : FILEs; A, B : Clock_T);
+      pragma Import (C, Fprintf_Clock, "__ghdl_fprintf_clock");
+
+      Sec : Clock_T;
+      Ms : Clock_T;
+   begin
+      Sec := Val / One_Second;
+
+      --  Avoid overflow.
+      Ms := ((Val mod One_Second) * 1000) / One_Second;
+
+      Fprintf_Clock (Stream, Sec, Ms);
+   end Put;
+
+   procedure Put (Stream : FILEs; T : Time_Stats) is
+   begin
+      Put (Stream, "wall: ");
+      Put (Stream, T.Wall);
+      Put (Stream, "  user: ");
+      Put (Stream, T.User);
+      Put (Stream, "  sys: ");
+      Put (Stream, T.Sys);
+   end Put;
+
+   type Counter_Kind is (Counter_Elab, Counter_Order,
+                         Counter_Process, Counter_Update,
+                         Counter_Next, Counter_Resume);
+
+   type Counter_Array is array (Counter_Kind) of Time_Stats;
+   Counters : Counter_Array := (others => (0, 0, 0));
+
+   Init_Time : Time_Stats;
+   Last_Counter : Counter_Kind;
+   Last_Time : Time_Stats;
+
+--     --  Stats at origin.
+--     Start_Time : Time_Stats;
+--     End_Elab_Time : Time_Stats;
+--     End_Order_Time : Time_Stats;
+
+--     Start_Proc_Time : Time_Stats;
+--     Proc_Times : Time_Stats;
+
+--     Start_Update_Time : Time_Stats;
+--     Update_Times : Time_Stats;
+
+--     Start_Next_Time_Time : Time_Stats;
+--     Next_Time_Times : Time_Stats;
+
+--     Start_Resume_Time : Time_Stats;
+--     Resume_Times : Time_Stats;
+
+--     Running_Time : Time_Stats;
+--     Simu_Time : Time_Stats;
+
+   procedure Start_Elaboration is
+   begin
+      One_Second := Get_Clk_Tck;
+
+      Get_Stats (Init_Time);
+      Last_Time := Init_Time;
+      Last_Counter := Counter_Elab;
+   end Start_Elaboration;
+
+   procedure Change_Counter (Cnt : Counter_Kind)
+   is
+      New_Time : Time_Stats;
+   begin
+      Get_Stats (New_Time);
+      Counters (Last_Counter) := Counters (Last_Counter)
+        + (New_Time - Last_Time);
+      Last_Time := New_Time;
+      Last_Counter := Cnt;
+   end Change_Counter;
+
+   procedure Start_Order is
+   begin
+      Change_Counter (Counter_Order);
+   end Start_Order;
+
+   procedure Start_Processes is
+   begin
+      Change_Counter (Counter_Process);
+   end Start_Processes;
+
+   procedure Start_Update is
+   begin
+      Change_Counter (Counter_Update);
+   end Start_Update;
+
+   procedure Start_Next_Time is
+   begin
+      Change_Counter (Counter_Next);
+   end Start_Next_Time;
+
+   procedure Start_Resume is
+   begin
+      Change_Counter (Counter_Resume);
+   end Start_Resume;
+
+   procedure End_Simulation is
+   begin
+      Change_Counter (Last_Counter);
+   end End_Simulation;
+
+   procedure Disp_Signals_Stats
+   is
+      use Grt.Signals;
+      Nbr_No_Drivers : Ghdl_I32;
+      Nbr_Resolv : Ghdl_I32;
+      Nbr_Multi_Src : Ghdl_I32;
+      Nbr_Active : Ghdl_I32;
+      Nbr_Drivers : Ghdl_I32;
+      Nbr_Direct_Drivers : Ghdl_I32;
+
+      type Propagation_Kind_Array is array (Propagation_Kind_Type) of Ghdl_I32;
+      Propag_Count : Propagation_Kind_Array;
+
+      type Mode_Array is array (Mode_Type) of Ghdl_I32;
+      Mode_Counts : Mode_Array;
+
+      type Mode_Name_Type is array (Mode_Type) of String (1 .. 4);
+      Mode_Names : constant Mode_Name_Type := (Mode_B1 => "B1: ",
+                                               Mode_E8 => "E8: ",
+                                               Mode_E32 => "E32:",
+                                               Mode_I32 => "I32:",
+                                               Mode_I64 => "I64:",
+                                               Mode_F64 => "F64:");
+   begin
+      Put (stdout, "Number of simple signals: ");
+      Put_I32 (stdout, Ghdl_I32 (Sig_Table.Last - Sig_Table.First + 1));
+      New_Line;
+      Put (stdout, "Number of signals with projected wave: ");
+      Put_I32 (stdout, Get_Nbr_Future);
+      New_Line;
+
+      Nbr_No_Drivers := 0;
+      Nbr_Resolv := 0;
+      Nbr_Multi_Src := 0;
+      Nbr_Active := 0;
+      Nbr_Drivers := 0;
+      Nbr_Direct_Drivers := 0;
+      Mode_Counts := (others => 0);
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         declare
+            Sig : Ghdl_Signal_Ptr;
+            Trans : Transaction_Acc;
+         begin
+            Sig := Sig_Table.Table (I);
+            if Sig.S.Mode_Sig in Mode_Signal_User then
+               if Sig.S.Nbr_Drivers = 0 then
+                  Nbr_No_Drivers := Nbr_No_Drivers + 1;
+               end if;
+               if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 1 then
+                  Nbr_Multi_Src := Nbr_Multi_Src + 1;
+               end if;
+               if Sig.S.Resolv /= null then
+                  Nbr_Resolv := Nbr_Resolv + 1;
+               end if;
+               Nbr_Drivers := Nbr_Drivers + Ghdl_I32 (Sig.S.Nbr_Drivers);
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Trans := Sig.S.Drivers (J - 1).Last_Trans;
+                  if Trans /= null and then Trans.Kind = Trans_Direct then
+                     Nbr_Direct_Drivers := Nbr_Direct_Drivers + 1;
+                  end if;
+               end loop;
+            end if;
+            Mode_Counts (Sig.Mode) := Mode_Counts (Sig.Mode) + 1;
+            if Sig.Has_Active then
+               Nbr_Active := Nbr_Active + 1;
+            end if;
+         end;
+      end loop;
+      Put (stdout, "Number of non-driven simple signals: ");
+      Put_I32 (stdout, Nbr_No_Drivers);
+      New_Line;
+      Put (stdout, "Number of resolved simple signals: ");
+      Put_I32 (stdout, Nbr_Resolv);
+      New_Line;
+      Put (stdout, "Number of multi-sourced signals: ");
+      Put_I32 (stdout, Nbr_Multi_Src);
+      New_Line;
+      Put (stdout, "Number of signals whose activity is managed: ");
+      Put_I32 (stdout, Nbr_Active);
+      New_Line;
+      Put (stdout, "Number of drivers: ");
+      Put_I32 (stdout, Nbr_Drivers);
+      New_Line;
+      Put (stdout, "Number of direct drivers: ");
+      Put_I32 (stdout, Nbr_Direct_Drivers);
+      New_Line;
+      Put (stdout, "Number of signals per mode:");
+      New_Line;
+      for I in Mode_Type loop
+         Put (stdout, "  ");
+         Put (stdout, Mode_Names (I));
+         Put (stdout, "  ");
+         Put_I32 (stdout, Mode_Counts (I));
+         New_Line;
+      end loop;
+      New_Line;
+
+      Propag_Count := (others => 0);
+      for I in Propagation.First .. Propagation.Last loop
+         Propag_Count (Propagation.Table (I).Kind) :=
+           Propag_Count (Propagation.Table (I).Kind) + 1;
+      end loop;
+
+      Put (stdout, "Propagation table length: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Signals.Propagation.Last));
+      New_Line;
+      Put (stdout, "Propagation table count:");
+      New_Line;
+      for I in Propagation_Kind_Type loop
+         if Propag_Count (I) /= 0 then
+            Put (stdout, "  ");
+            Grt.Disp.Disp_Propagation_Kind (I);
+            Put (stdout, ": ");
+            Put_I32 (stdout, Propag_Count (I));
+            New_Line;
+         end if;
+      end loop;
+   end Disp_Signals_Stats;
+
+   --  Disp all statistics.
+   procedure Disp_Stats
+   is
+      N : Natural;
+   begin
+      Put (stdout, "total:          ");
+      Put (stdout, Last_Time - Init_Time);
+      New_Line (stdout);
+      Put (stdout, " elab:          ");
+      Put (stdout, Counters (Counter_Elab));
+      New_Line (stdout);
+      Put (stdout, " internal elab: ");
+      Put (stdout, Counters (Counter_Order));
+      New_Line (stdout);
+      Put (stdout, " cycle (sum):   ");
+      Put (stdout, Counters (Counter_Process) + Counters (Counter_Resume)
+           + Counters (Counter_Update) + Counters (Counter_Next));
+      New_Line (stdout);
+      Put (stdout, "  processes:    ");
+      Put (stdout, Counters (Counter_Process));
+      New_Line (stdout);
+      Put (stdout, "  resume:       ");
+      Put (stdout, Counters (Counter_Resume));
+      New_Line (stdout);
+      Put (stdout, "  update:       ");
+      Put (stdout, Counters (Counter_Update));
+      New_Line (stdout);
+      Put (stdout, "  next compute: ");
+      Put (stdout, Counters (Counter_Next));
+      New_Line (stdout);
+
+      Disp_Signals_Stats;
+
+      Put (stdout, "Number of delta cycles: ");
+      Put_I32 (stdout, Ghdl_I32 (Processes.Nbr_Delta_Cycles));
+      New_Line;
+      Put (stdout, "Number of non-delta cycles: ");
+      Put_I32 (stdout, Ghdl_I32 (Processes.Nbr_Cycles));
+      New_Line;
+
+      Put (stdout, "Nbr of events: ");
+      Put_I32 (stdout, Signals.Nbr_Events);
+      New_Line;
+      Put (stdout, "Nbr of active: ");
+      Put_I32 (stdout, Signals.Nbr_Active);
+      New_Line;
+
+      Put (stdout, "Number of processes: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Processes.Get_Nbr_Processes));
+      New_Line;
+      Put (stdout, "Number of sensitized processes: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Processes.Get_Nbr_Sensitized_Processes));
+      New_Line;
+      Put (stdout, "Number of resumed processes: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Processes.Get_Nbr_Resumed_Processes));
+      New_Line;
+      Put (stdout, "Average number of resumed processes per cycle: ");
+      N := Processes.Nbr_Delta_Cycles + Processes.Nbr_Cycles;
+      if N = 0 then
+         Put (stdout, "-");
+      else
+         Put_I32 (stdout, Ghdl_I32 (Processes.Get_Nbr_Resumed_Processes / N));
+      end if;
+      New_Line;
+   end Disp_Stats;
+end Grt.Stats;
diff --git a/src/translate/grt/grt-stats.ads b/src/translate/grt/grt-stats.ads
new file mode 100644
index 000000000..6f60261af
--- /dev/null
+++ b/src/translate/grt/grt-stats.ads
@@ -0,0 +1,54 @@
+--  GHDL Run Time (GRT) - statistics.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package Grt.Stats is
+   --  Entry points to gather statistics.
+   procedure Start_Elaboration;
+   procedure Start_Order;
+
+   --  Time in user processes.
+   procedure Start_Processes;
+
+
+   --  Time in next time computation.
+   procedure Start_Next_Time;
+
+
+   --  Time in signals update.
+   procedure Start_Update;
+
+
+   --  Time in process resume
+   procedure Start_Resume;
+
+
+   procedure End_Simulation;
+
+   --  Disp all statistics.
+   procedure Disp_Stats;
+end Grt.Stats;
+
+
+
diff --git a/src/translate/grt/grt-std_logic_1164.adb b/src/translate/grt/grt-std_logic_1164.adb
new file mode 100644
index 000000000..5be308bd6
--- /dev/null
+++ b/src/translate/grt/grt-std_logic_1164.adb
@@ -0,0 +1,146 @@
+--  GHDL Run Time (GRT) std_logic_1664 subprograms.
+--  Copyright (C) 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with Grt.Lib;
+
+package body Grt.Std_Logic_1164 is
+   Assert_DC_Msg : constant String :=
+     "STD_LOGIC_1164: '-' operand for matching ordering operator";
+
+   Assert_DC_Msg_Bound : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1, Right => Assert_DC_Msg'Length, Dir => Dir_To,
+                Length => Assert_DC_Msg'Length));
+
+   Assert_DC_Msg_Str : aliased constant Std_String :=
+     (Base => To_Std_String_Basep (Assert_DC_Msg'Address),
+      Bounds => To_Std_String_Boundp (Assert_DC_Msg_Bound'Address));
+
+   Filename : constant String := "std_logic_1164.vhdl" & NUL;
+   Loc : aliased constant Ghdl_Location :=
+     (Filename => To_Ghdl_C_String (Filename'Address),
+      Line => 58,
+      Col => 3);
+
+   procedure Assert_Not_Match (V : Std_Ulogic)
+   is
+      use Grt.Lib;
+   begin
+      if V = '-' then
+         Ghdl_Ieee_Assert_Failed
+           (To_Std_String_Ptr (Assert_DC_Msg_Str'Address), Error_Severity,
+            To_Ghdl_Location_Ptr (Loc'Address));
+      end if;
+   end Assert_Not_Match;
+
+   function Ghdl_Std_Ulogic_Match_Eq (L, R : Ghdl_E8) return Ghdl_E8
+   is
+      Left : constant Std_Ulogic := Std_Ulogic'Val (L);
+      Right : constant Std_Ulogic := Std_Ulogic'Val (R);
+   begin
+      Assert_Not_Match (Left);
+      Assert_Not_Match (Right);
+      return Std_Ulogic'Pos (Match_Eq_Table (Left, Right));
+   end Ghdl_Std_Ulogic_Match_Eq;
+
+   function Ghdl_Std_Ulogic_Match_Ne (L, R : Ghdl_E8) return Ghdl_E8
+   is
+      Left : constant Std_Ulogic := Std_Ulogic'Val (L);
+      Right : constant Std_Ulogic := Std_Ulogic'Val (R);
+   begin
+      Assert_Not_Match (Left);
+      Assert_Not_Match (Right);
+      return Std_Ulogic'Pos (Not_Table (Match_Eq_Table (Left, Right)));
+   end Ghdl_Std_Ulogic_Match_Ne;
+
+   function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8
+   is
+      Left : constant Std_Ulogic := Std_Ulogic'Val (L);
+      Right : constant Std_Ulogic := Std_Ulogic'Val (R);
+   begin
+      Assert_Not_Match (Left);
+      Assert_Not_Match (Right);
+      return Std_Ulogic'Pos (Match_Lt_Table (Left, Right));
+   end Ghdl_Std_Ulogic_Match_Lt;
+
+   function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8
+   is
+      Left : constant Std_Ulogic := Std_Ulogic'Val (L);
+      Right : constant Std_Ulogic := Std_Ulogic'Val (R);
+   begin
+      Assert_Not_Match (Left);
+      Assert_Not_Match (Right);
+      return Std_Ulogic'Pos (Or_Table (Match_Lt_Table (Left, Right),
+                                       Match_Eq_Table (Left, Right)));
+   end Ghdl_Std_Ulogic_Match_Le;
+
+   Assert_Arr_Msg : constant String :=
+     "parameters of '?=' array operator are not of the same length";
+
+   Assert_Arr_Msg_Bound : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1, Right => Assert_Arr_Msg'Length, Dir => Dir_To,
+                Length => Assert_Arr_Msg'Length));
+
+   Assert_Arr_Msg_Str : aliased constant Std_String :=
+     (Base => To_Std_String_Basep (Assert_Arr_Msg'Address),
+      Bounds => To_Std_String_Boundp (Assert_Arr_Msg_Bound'Address));
+
+
+   function Ghdl_Std_Ulogic_Array_Match_Eq (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32
+   is
+      use Grt.Lib;
+      L_Arr : constant Ghdl_E8_Array_Base_Ptr :=
+        To_Ghdl_E8_Array_Base_Ptr (L);
+      R_Arr : constant Ghdl_E8_Array_Base_Ptr :=
+        To_Ghdl_E8_Array_Base_Ptr (R);
+      Res : Std_Ulogic := '1';
+   begin
+      if L_Len /= R_Len then
+         Ghdl_Ieee_Assert_Failed
+           (To_Std_String_Ptr (Assert_Arr_Msg_Str'Address), Error_Severity,
+            To_Ghdl_Location_Ptr (Loc'Address));
+      end if;
+      for I in 1 .. L_Len loop
+         Res := And_Table
+           (Res, Std_Ulogic'Val (Ghdl_Std_Ulogic_Match_Eq (L_Arr (I - 1),
+                                                           R_Arr (I - 1))));
+      end loop;
+      return Std_Ulogic'Pos (Res);
+   end Ghdl_Std_Ulogic_Array_Match_Eq;
+
+   function Ghdl_Std_Ulogic_Array_Match_Ne (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32 is
+   begin
+      return Std_Ulogic'Pos
+        (Not_Table (Std_Ulogic'Val
+                      (Ghdl_Std_Ulogic_Array_Match_Eq (L, L_Len, R, R_Len))));
+   end Ghdl_Std_Ulogic_Array_Match_Ne;
+end Grt.Std_Logic_1164;
diff --git a/src/translate/grt/grt-std_logic_1164.ads b/src/translate/grt/grt-std_logic_1164.ads
new file mode 100644
index 000000000..4d1569553
--- /dev/null
+++ b/src/translate/grt/grt-std_logic_1164.ads
@@ -0,0 +1,124 @@
+--  GHDL Run Time (GRT) std_logic_1664 subprograms.
+--  Copyright (C) 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with Grt.Types; use Grt.Types;
+
+package Grt.Std_Logic_1164 is
+   type Std_Ulogic is ('U', 'X', '0', '1', 'Z', 'W','L', 'H', '-');
+
+   type Stdlogic_Table_2d is array (Std_Ulogic, Std_Ulogic) of Std_Ulogic;
+   type Stdlogic_Table_1d is array (Std_Ulogic) of Std_Ulogic;
+
+   --  LRM08 9.2.3 Relational operators
+   Match_Eq_Table : constant Stdlogic_Table_2d :=
+     --UX01ZWLH-
+     ("UUUUUUUU1",
+      "UXXXXXXX1",
+      "UX10XX101",
+      "UX01XX011",
+      "UXXXXXXX1",
+      "UXXXXXXX1",
+      "UX10XX101",
+      "UX01XX011",
+      "111111111");
+
+   Match_Lt_Table : constant Stdlogic_Table_2d :=
+     --UX01ZWLH-
+     ("UUUUUUUUX",
+      "UXXXXXXXX",
+      "UX01XX01X",
+      "UX00XX00X",
+      "UXXXXXXXX",
+      "UXXXXXXXX",
+      "UX01XX01X",
+      "UX00XX00X",
+      "XXXXXXXXX");
+
+   And_Table : constant Stdlogic_Table_2d :=
+     --UX01ZWLH-
+     ("UU0UUU0UX",  -- U
+      "UX0XXX0XX",  -- X
+      "000000000",  -- 0
+      "UX01XX01X",  -- 1
+      "UX0XXX0XX",  -- Z
+      "UX0XXX0XX",  -- W
+      "000000000",  -- L
+      "UX01XX01X",  -- H
+      "UX0XXX0XX"); -- -
+
+   Or_Table : constant Stdlogic_Table_2d :=
+     --UX01ZWLH-
+     ("UUU1UUU1U",  -- U
+      "UXX1XXX1X",  -- X
+      "UX01XX01X",  -- 0
+      "111111111",  -- 1
+      "UXX1XXX1X",  -- Z
+      "UXX1XXX1X",  -- W
+      "UX01XX01X",  -- L
+      "111111111",  -- H
+      "UXX1XXX1X"); -- -
+
+   Xor_Table : constant Stdlogic_Table_2d :=
+     --UX01ZWLH-
+     ("UUUUUUUUU",  -- U
+      "UXXXXXXXX",  -- X
+      "UX01XX01X",  -- 0
+      "UX10XX10X",  -- 1
+      "UXXXXXXXX",  -- Z
+      "UXXXXXXXX",  -- W
+      "UX01XX01X",  -- L
+      "UX10XX10X",  -- H
+      "UXXXXXXXX"); -- -
+
+   Not_Table : constant Stdlogic_Table_1d := "UX10XX10X";
+
+   function Ghdl_Std_Ulogic_Match_Eq (L, R : Ghdl_E8) return Ghdl_E8;
+   function Ghdl_Std_Ulogic_Match_Ne (L, R : Ghdl_E8) return Ghdl_E8;
+   function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8;
+   function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8;
+   --  For Gt and Ge, use Lt and Le with swapped parameters.
+
+   function Ghdl_Std_Ulogic_Array_Match_Eq (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32;
+   function Ghdl_Std_Ulogic_Array_Match_Ne (L : Ghdl_Ptr;
+                                            L_Len : Ghdl_Index_Type;
+                                            R : Ghdl_Ptr;
+                                            R_Len : Ghdl_Index_Type)
+                                           return Ghdl_I32;
+
+private
+   pragma Export (C, Ghdl_Std_Ulogic_Match_Eq, "__ghdl_std_ulogic_match_eq");
+   pragma Export (C, Ghdl_Std_Ulogic_Match_Ne, "__ghdl_std_ulogic_match_ne");
+   pragma Export (C, Ghdl_Std_Ulogic_Match_Lt, "__ghdl_std_ulogic_match_lt");
+   pragma Export (C, Ghdl_Std_Ulogic_Match_Le, "__ghdl_std_ulogic_match_le");
+
+   pragma Export (C, Ghdl_Std_Ulogic_Array_Match_Eq,
+                  "__ghdl_std_ulogic_array_match_eq");
+   pragma Export (C, Ghdl_Std_Ulogic_Array_Match_Ne,
+                  "__ghdl_std_ulogic_array_match_ne");
+end Grt.Std_Logic_1164;
diff --git a/src/translate/grt/grt-stdio.ads b/src/translate/grt/grt-stdio.ads
new file mode 100644
index 000000000..229249ac9
--- /dev/null
+++ b/src/translate/grt/grt-stdio.ads
@@ -0,0 +1,107 @@
+--  GHDL Run Time (GRT) - stdio binding.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System;
+with Grt.C; use Grt.C;
+
+--  This package provides a thin binding to the stdio.h of the C library.
+--  It mimics GNAT package Interfaces.C_Streams.
+--  The purpose of this package is to remove dependencies on the GNAT run time.
+
+package Grt.Stdio is
+   pragma Preelaborate (Grt.Stdio);
+
+   --  Type FILE *.
+   type FILEs is new System.Address;
+
+   --  NULL for a stream.
+   NULL_Stream : constant FILEs;
+
+   --  Predefined streams.
+   function stdout return FILEs;
+   function stderr return FILEs;
+   function stdin return FILEs;
+
+   --  The following subprograms are translation of the C prototypes.
+
+   function fopen (path: chars; mode : chars) return FILEs;
+
+   function fwrite (buffer : voids;
+                    size : size_t;
+                    count : size_t;
+                    stream : FILEs)
+                   return size_t;
+
+   function fread (buffer : voids;
+                   size : size_t;
+                   count : size_t;
+                   stream : FILEs)
+                  return size_t;
+
+   function fputc (c : int; stream : FILEs) return int;
+   procedure fputc (c : int; stream : FILEs);
+
+   function fputs (s : chars; stream : FILEs) return int;
+
+   function fgetc (stream : FILEs) return int;
+   function fgets (s : chars; size : int; stream : FILEs) return chars;
+   function ungetc (c : int; stream : FILEs) return int;
+
+   function fflush (stream : FILEs) return int;
+   procedure fflush (stream : FILEs);
+
+   function feof (stream : FILEs) return int;
+
+   function ftell (stream : FILEs) return long;
+
+   function fclose (stream : FILEs) return int;
+   procedure fclose (Stream : FILEs);
+private
+   --  This is a little bit dubious, but this package should be preelaborated,
+   --  and Null_Address is not static (since defined in the private part
+   --  of System).
+   --  I am pretty sure the C definition of NULL is 0.
+   NULL_Stream : constant FILEs := FILEs (System'To_Address (0));
+
+   pragma Import (C, fopen);
+
+   pragma Import (C, fwrite);
+   pragma Import (C, fread);
+
+   pragma Import (C, fputs);
+   pragma Import (C, fputc);
+
+   pragma Import (C, fgetc);
+   pragma Import (C, fgets);
+   pragma Import (C, ungetc);
+
+   pragma Import (C, fflush);
+   pragma Import (C, feof);
+   pragma Import (C, ftell);
+   pragma Import (C, fclose);
+
+   pragma Import (C, stdout, "__ghdl_get_stdout");
+   pragma Import (C, stderr, "__ghdl_get_stderr");
+   pragma Import (C, stdin, "__ghdl_get_stdin");
+end Grt.Stdio;
diff --git a/src/translate/grt/grt-table.adb b/src/translate/grt/grt-table.adb
new file mode 100644
index 000000000..36aa99982
--- /dev/null
+++ b/src/translate/grt/grt-table.adb
@@ -0,0 +1,120 @@
+--  GHDL Run Time (GRT) - Resizable array
+--  Copyright (C) 2008 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with System; use System;
+with Grt.C; use Grt.C;
+
+package body Grt.Table is
+
+   --  Maximum index of table before resizing.
+   Max : Table_Index_Type := Table_Index_Type'Pred (Table_Low_Bound);
+
+   --  Current value of Last
+   Last_Val : Table_Index_Type;
+
+   function Malloc (Size : size_t) return Table_Ptr;
+   pragma Import (C, Malloc);
+
+   procedure Free (T : Table_Ptr);
+   pragma Import (C, Free);
+
+   --  Resize and reallocate the table according to LAST_VAL.
+   procedure Resize is
+      function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr;
+      pragma Import (C, Realloc);
+
+      New_Size : size_t;
+   begin
+      while Max < Last_Val loop
+         Max := Max + (Max - Table_Low_Bound + 1);
+      end loop;
+
+      New_Size := size_t ((Max - Table_Low_Bound + 1) *
+                            (Table_Type'Component_Size / Storage_Unit));
+
+      Table := Realloc (Table, New_Size);
+
+      if Table = null then
+         raise Storage_Error;
+      end if;
+   end Resize;
+
+   procedure Append (New_Val : Table_Component_Type) is
+   begin
+      Increment_Last;
+      Table (Last_Val) := New_Val;
+   end Append;
+
+   procedure Decrement_Last is
+   begin
+      Last_Val := Table_Index_Type'Pred (Last_Val);
+   end Decrement_Last;
+
+   procedure Free is
+   begin
+      Free (Table);
+      Table := null;
+   end Free;
+
+   procedure Increment_Last is
+   begin
+      Last_Val := Table_Index_Type'Succ (Last_Val);
+
+      if Last_Val > Max then
+         Resize;
+      end if;
+   end Increment_Last;
+
+   function Last return Table_Index_Type is
+   begin
+      return Last_Val;
+   end Last;
+
+   procedure Release is
+   begin
+      Max := Last_Val;
+      Resize;
+   end Release;
+
+   procedure Set_Last (New_Val : Table_Index_Type) is
+   begin
+      if New_Val < Last_Val then
+         Last_Val := New_Val;
+      else
+         Last_Val := New_Val;
+
+         if Last_Val > Max then
+            Resize;
+         end if;
+      end if;
+   end Set_Last;
+
+begin
+   Last_Val := Table_Index_Type'Pred (Table_Low_Bound);
+   Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1;
+
+   Table := Malloc (size_t (Table_Initial *
+                              (Table_Type'Component_Size / Storage_Unit)));
+end Grt.Table;
diff --git a/src/translate/grt/grt-table.ads b/src/translate/grt/grt-table.ads
new file mode 100644
index 000000000..f814eff5c
--- /dev/null
+++ b/src/translate/grt/grt-table.ads
@@ -0,0 +1,75 @@
+--  GHDL Run Time (GRT) - Resizable array
+--  Copyright (C) 2008 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+generic
+   type Table_Component_Type is private;
+   type Table_Index_Type     is range <>;
+
+   Table_Low_Bound : Table_Index_Type;
+   Table_Initial   : Positive;
+
+package Grt.Table is
+   pragma Elaborate_Body;
+
+   type Table_Type is
+     array (Table_Index_Type range <>) of Table_Component_Type;
+   subtype Fat_Table_Type is
+     Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
+
+   --  Thin pointer.
+   type Table_Ptr is access all Fat_Table_Type;
+
+   --  The table itself.
+   Table : aliased Table_Ptr := null;
+
+   --  Get the high bound.
+   function Last return Table_Index_Type;
+   pragma Inline (Last);
+
+   --  Get the low bound.
+   First : constant Table_Index_Type := Table_Low_Bound;
+
+   --  Increase the length by 1.
+   procedure Increment_Last;
+   pragma Inline (Increment_Last);
+
+   --  Decrease the length by 1.
+   procedure Decrement_Last;
+   pragma Inline (Decrement_Last);
+
+   --  Set the last bound.
+   procedure Set_Last (New_Val : Table_Index_Type);
+
+   --  Release extra memory.
+   procedure Release;
+
+   --  Free all the memory used by the table.
+   --  The table won't be useable anymore.
+   procedure Free;
+
+   --  Append a new element.
+   procedure Append (New_Val : Table_Component_Type);
+   pragma Inline (Append);
+end Grt.Table;
diff --git a/src/translate/grt/grt-threads.ads b/src/translate/grt/grt-threads.ads
new file mode 100644
index 000000000..248f2c41b
--- /dev/null
+++ b/src/translate/grt/grt-threads.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - threading.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Unithread;
+
+package Grt.Threads renames Grt.Unithread;
diff --git a/src/translate/grt/grt-types.ads b/src/translate/grt/grt-types.ads
new file mode 100644
index 000000000..fed822554
--- /dev/null
+++ b/src/translate/grt/grt-types.ads
@@ -0,0 +1,327 @@
+--  GHDL Run Time (GRT) - common types.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+
+package Grt.Types is
+   pragma Preelaborate (Grt.Types);
+
+   type Ghdl_B1 is new Boolean;
+   type Ghdl_E8 is new Unsigned_8;
+   type Ghdl_U32 is new Unsigned_32;
+   subtype Ghdl_E32 is Ghdl_U32;
+   type Ghdl_I32 is new Integer_32;
+   type Ghdl_I64 is new Integer_64;
+   type Ghdl_U64 is new Unsigned_64;
+   type Ghdl_F64 is new IEEE_Float_64;
+
+   type Ghdl_Ptr is new Address;
+   type Ghdl_Index_Type is mod 2 ** 32;
+   subtype Ghdl_Real is Ghdl_F64;
+
+   type Ghdl_Dir_Type is (Dir_To, Dir_Downto);
+   for Ghdl_Dir_Type use (Dir_To => 0, Dir_Downto => 1);
+   for Ghdl_Dir_Type'Size use 8;
+
+   --  Access to an unconstrained string.
+   type String_Access is access String;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Access, Object => String);
+
+   subtype Std_Integer is Ghdl_I32;
+
+   type Std_Time is new Ghdl_I64;
+   Bad_Time : constant Std_Time := Std_Time'First;
+
+   type Std_Integer_Trt is record
+      Left : Std_Integer;
+      Right : Std_Integer;
+      Dir : Ghdl_Dir_Type;
+      Length : Ghdl_Index_Type;
+   end record;
+
+   subtype Std_Character is Character;
+   type Std_String_Uncons is array (Ghdl_Index_Type range <>) of Std_Character;
+   subtype Std_String_Base is Std_String_Uncons (Ghdl_Index_Type);
+   type Std_String_Basep is access all Std_String_Base;
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Std_String_Basep);
+
+   type Std_String_Bound is record
+      Dim_1 : Std_Integer_Trt;
+   end record;
+   type Std_String_Boundp is access all Std_String_Bound;
+   function To_Std_String_Boundp is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Std_String_Boundp);
+
+   type Std_String is record
+      Base : Std_String_Basep;
+      Bounds : Std_String_Boundp;
+   end record;
+   type Std_String_Ptr is access all Std_String;
+   function To_Std_String_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Std_String_Ptr);
+
+   type Std_Bit is ('0', '1');
+   type Std_Bit_Vector_Uncons is array (Ghdl_Index_Type range <>) of Std_Bit;
+   subtype Std_Bit_Vector_Base is Std_Bit_Vector_Uncons (Ghdl_Index_Type);
+   type Std_Bit_Vector_Basep is access all Std_Bit_Vector_Base;
+
+   --  An unconstrained array.
+   --  It is in fact a fat pointer to the base and the bounds.
+   type Ghdl_Uc_Array is record
+      Base : Address;
+      Bounds : Address;
+   end record;
+   type Ghdl_Uc_Array_Acc is access Ghdl_Uc_Array;
+   function To_Ghdl_Uc_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Uc_Array_Acc);
+
+   --  Verilog types.
+
+   type Ghdl_Logic32 is record
+      Val : Ghdl_U32;
+      Xz : Ghdl_U32;
+   end record;
+   type Ghdl_Logic32_Ptr is access Ghdl_Logic32;
+   type Ghdl_Logic32_Vec is array (Ghdl_U32) of Ghdl_Logic32;
+   type Ghdl_Logic32_Vptr is access Ghdl_Logic32_Vec;
+
+   function To_Ghdl_Logic32_Vptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Logic32_Vptr);
+
+   function To_Ghdl_Logic32_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Logic32_Ptr);
+
+   --  Mimics C strings (NUL ended).
+   --  Note: this is 1 based.
+   type Ghdl_C_String is access String (Positive);
+   NUL : constant Character := Character'Val (0);
+
+   Nl : constant Character := Character'Val (10);  -- LF, nl or '\n'.
+
+   function strlen (Str : Ghdl_C_String) return Natural;
+   pragma Import (C, strlen);
+
+   function Strcmp (L , R : Ghdl_C_String) return Integer;
+   pragma Import (C, Strcmp);
+
+   function To_Ghdl_C_String is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_C_String);
+
+   --  Str_len.
+   type String_Ptr is access String (1 .. Natural'Last);
+   type Ghdl_Str_Len_Type is record
+      Len : Natural;
+      Str : String_Ptr;
+   end record;
+   --  Same as previous one, but using 'address.
+   type Ghdl_Str_Len_Address_Type is record
+      Len : Natural;
+      Str : Address;
+   end record;
+   type Ghdl_Str_Len_Ptr is access constant Ghdl_Str_Len_Type;
+   type Ghdl_Str_Len_Array is array (Natural) of Ghdl_Str_Len_Type;
+   type Ghdl_Str_Len_Array_Ptr is access all Ghdl_Str_Len_Array;
+
+   --  Location is used for errors/messages.
+   type Ghdl_Location is record
+      Filename : Ghdl_C_String;
+      Line : Integer;
+      Col : Integer;
+   end record;
+   type Ghdl_Location_Ptr is access Ghdl_Location;
+   function To_Ghdl_Location_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Location_Ptr);
+
+   --  Signal index.
+   type Sig_Table_Index is new Integer;
+
+   --  A range of signals.
+   type Sig_Table_Range is record
+      First, Last : Sig_Table_Index;
+   end record;
+
+   --  Simple values, used for signals.
+   type Mode_Type is
+     (Mode_B1, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64);
+
+   type Ghdl_B1_Array is array (Ghdl_Index_Type range <>) of Ghdl_B1;
+   subtype Ghdl_B1_Array_Base is Ghdl_B1_Array (Ghdl_Index_Type);
+   type Ghdl_B1_Array_Base_Ptr is access Ghdl_B1_Array_Base;
+   function To_Ghdl_B1_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_B1_Array_Base_Ptr);
+
+   type Ghdl_E8_Array is array (Ghdl_Index_Type range <>) of Ghdl_E8;
+   subtype Ghdl_E8_Array_Base is Ghdl_E8_Array (Ghdl_Index_Type);
+   type Ghdl_E8_Array_Base_Ptr is access Ghdl_E8_Array_Base;
+   function To_Ghdl_E8_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_E8_Array_Base_Ptr);
+
+   type Ghdl_E32_Array is array (Ghdl_Index_Type range <>) of Ghdl_E32;
+   subtype Ghdl_E32_Array_Base is Ghdl_E32_Array (Ghdl_Index_Type);
+   type Ghdl_E32_Array_Base_Ptr is access Ghdl_E32_Array_Base;
+   function To_Ghdl_E32_Array_Base_Ptr is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Ptr, Target => Ghdl_E32_Array_Base_Ptr);
+
+   type Ghdl_I32_Array is array (Ghdl_Index_Type range <>) of Ghdl_I32;
+
+   type Value_Union (Mode : Mode_Type := Mode_B1) is record
+      case Mode is
+         when Mode_B1 =>
+            B1 : Ghdl_B1;
+         when Mode_E8 =>
+            E8 : Ghdl_E8;
+         when Mode_E32 =>
+            E32 : Ghdl_E32;
+         when Mode_I32 =>
+            I32 : Ghdl_I32;
+         when Mode_I64 =>
+            I64 : Ghdl_I64;
+         when Mode_F64 =>
+            F64 : Ghdl_F64;
+      end case;
+   end record;
+   pragma Unchecked_Union (Value_Union);
+
+   type Ghdl_Value_Ptr is access Value_Union;
+   function To_Ghdl_Value_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Value_Ptr);
+
+   --  Ranges.
+   type Ghdl_Range_B1 is record
+      Left : Ghdl_B1;
+      Right : Ghdl_B1;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_E8 is record
+      Left : Ghdl_E8;
+      Right : Ghdl_E8;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_E32 is record
+      Left : Ghdl_E32;
+      Right : Ghdl_E32;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_I32 is record
+      Left : Ghdl_I32;
+      Right : Ghdl_I32;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_I64 is record
+      Left : Ghdl_I64;
+      Right : Ghdl_I64;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_F64 is record
+      Left : Ghdl_F64;
+      Right : Ghdl_F64;
+      Dir : Ghdl_Dir_Type;
+   end record;
+
+   type Ghdl_Range_Type (K : Mode_Type := Mode_B1) is record
+      case K is
+         when Mode_B1 =>
+            B1 : Ghdl_Range_B1;
+         when Mode_E8 =>
+            E8 : Ghdl_Range_E8;
+         when Mode_E32 =>
+            E32 : Ghdl_Range_E32;
+         when Mode_I32 =>
+            I32 : Ghdl_Range_I32;
+         when Mode_I64 =>
+            P64 : Ghdl_Range_I64;
+         when Mode_F64 =>
+            F64 : Ghdl_Range_F64;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Range_Type);
+
+   type Ghdl_Range_Ptr is access all Ghdl_Range_Type;
+
+   function To_Ghdl_Range_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Range_Ptr);
+
+   type Ghdl_Range_Array is array (Ghdl_Index_Type range <>) of Ghdl_Range_Ptr;
+
+   --  Mode of a signal.
+   type Mode_Signal_Type is
+     (Mode_Signal,
+      Mode_Linkage, Mode_Buffer, Mode_Out, Mode_Inout, Mode_In,
+      Mode_Stable, Mode_Quiet, Mode_Delayed, Mode_Transaction, Mode_Guard,
+      Mode_Conv_In, Mode_Conv_Out,
+      Mode_End);
+
+   subtype Mode_Signal_Port is
+     Mode_Signal_Type range Mode_Linkage .. Mode_In;
+
+   --  Not implicit signals.
+   subtype Mode_Signal_User is
+     Mode_Signal_Type range Mode_Signal .. Mode_In;
+
+   --  Implicit signals.
+   subtype Mode_Signal_Implicit is
+     Mode_Signal_Type range Mode_Stable .. Mode_Guard;
+
+   subtype Mode_Signal_Forward is
+     Mode_Signal_Type range Mode_Stable .. Mode_Delayed;
+
+   --  Kind of a signal.
+   type Kind_Signal_Type is
+     (Kind_Signal_No, Kind_Signal_Register, Kind_Signal_Bus);
+
+   --  Note: we could use system.storage_elements, but unfortunatly,
+   --  this doesn't work with pragma no_run_time (gnat 3.15p).
+   type Integer_Address is mod Memory_Size;
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Integer_Address, Target => Address);
+
+   function To_Integer is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Integer_Address);
+
+   --  The NOW value.
+   Current_Time : Std_Time;
+   --  Copy of Current_Time before updating it.
+   --  To be used by hooks.
+   Cycle_Time : Std_Time;
+   --  The current delta cycle number.
+   Current_Delta : Integer;
+private
+   pragma Export (C, Current_Time, "__ghdl_now");
+end Grt.Types;
diff --git a/src/translate/grt/grt-unithread.adb b/src/translate/grt/grt-unithread.adb
new file mode 100644
index 000000000..6acb52169
--- /dev/null
+++ b/src/translate/grt/grt-unithread.adb
@@ -0,0 +1,106 @@
+--  GHDL Run Time (GRT) - mono-thread version.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package body Grt.Unithread is
+   procedure Init is
+   begin
+      null;
+   end Init;
+
+   procedure Finish is
+   begin
+      null;
+   end Finish;
+
+   procedure Run_Parallel (Subprg : Parallel_Subprg_Acc) is
+   begin
+      Subprg.all;
+   end Run_Parallel;
+
+   function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+                          return Ghdl_Signal_Ptr
+   is
+      Prev : Ghdl_Signal_Ptr;
+   begin
+      Prev := List.all;
+      List.all := El;
+      return Prev;
+   end Atomic_Insert;
+
+   function Atomic_Inc (Val : access Natural) return Natural
+   is
+      Res : Natural;
+   begin
+      Res := Val.all;
+      Val.all := Val.all + 1;
+      return Res;
+   end Atomic_Inc;
+
+   Current_Process : Process_Acc;
+
+   --  Called by linux.c
+   function Grt_Get_Current_Process return Process_Acc;
+   pragma Export (C, Grt_Get_Current_Process);
+
+   function Grt_Get_Current_Process return Process_Acc is
+   begin
+      return Current_Process;
+   end Grt_Get_Current_Process;
+
+
+   procedure Set_Current_Process (Proc : Process_Acc) is
+   begin
+      Current_Process := Proc;
+   end Set_Current_Process;
+
+   function Get_Current_Process return Process_Acc is
+   begin
+      return Current_Process;
+   end Get_Current_Process;
+
+   Stack2 : Stack2_Ptr;
+
+   function Get_Stack2 return Stack2_Ptr is
+   begin
+      return Stack2;
+   end Get_Stack2;
+
+   procedure Set_Stack2 (St : Stack2_Ptr) is
+   begin
+      Stack2 := St;
+   end Set_Stack2;
+
+   Main_Stack : Stack_Type;
+
+   function Get_Main_Stack return Stack_Type is
+   begin
+      return Main_Stack;
+   end Get_Main_Stack;
+
+   procedure Set_Main_Stack (St : Stack_Type) is
+   begin
+      Main_Stack := St;
+   end Set_Main_Stack;
+end Grt.Unithread;
diff --git a/src/translate/grt/grt-unithread.ads b/src/translate/grt/grt-unithread.ads
new file mode 100644
index 000000000..b35b7be33
--- /dev/null
+++ b/src/translate/grt/grt-unithread.ads
@@ -0,0 +1,73 @@
+--  GHDL Run Time (GRT) - mono-thread version.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Signals; use Grt.Signals;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Stacks; use Grt.Stacks;
+
+package Grt.Unithread is
+   procedure Init;
+   procedure Finish;
+
+   type Parallel_Subprg_Acc is access procedure;
+   procedure Run_Parallel (Subprg : Parallel_Subprg_Acc);
+
+   --  Return the old value of LIST.all and store EL into LIST.all.
+   function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+                          return Ghdl_Signal_Ptr;
+
+   --  Return the old value.
+   function Atomic_Inc (Val : access Natural) return Natural;
+
+   --  Set and get the current process being executed by the thread.
+   procedure Set_Current_Process (Proc : Process_Acc);
+   function Get_Current_Process return Process_Acc;
+
+   --  The secondary stack for the thread.  In this implementation, there is
+   --  only one secondary stack, shared by all processes. This is allowed,
+   --  because a wait statement cannot appear within a function.  So at a wait
+   --  statement, the secondary stack must be empty.
+   function Get_Stack2 return Stack2_Ptr;
+   procedure Set_Stack2 (St : Stack2_Ptr);
+
+   --  The main stack.  This is initialized by STACK_INIT.
+   --  The return point.
+   function Get_Main_Stack return Stack_Type;
+   procedure Set_Main_Stack (St : Stack_Type);
+private
+   pragma Inline (Run_Parallel);
+   pragma Inline (Atomic_Insert);
+   pragma Inline (Atomic_Inc);
+   pragma Inline (Get_Stack2);
+   pragma Inline (Set_Stack2);
+
+   pragma Inline (Get_Main_Stack);
+   pragma Export (C, Set_Main_Stack, "grt_set_main_stack");
+
+   pragma Inline (Set_Current_Process);
+   pragma Inline (Get_Current_Process);
+
+end Grt.Unithread;
diff --git a/src/translate/grt/grt-values.adb b/src/translate/grt/grt-values.adb
new file mode 100644
index 000000000..3d703bc85
--- /dev/null
+++ b/src/translate/grt/grt-values.adb
@@ -0,0 +1,639 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Errors; use Grt.Errors;
+with Grt.Rtis_Utils;
+
+package body Grt.Values is
+
+   NBSP : constant Character := Character'Val (160);
+   HT : constant Character := Character'Val (9);
+
+   --  Return True IFF C is a whitespace character (as defined in LRM93 14.3)
+   function Is_Whitespace (C : in Character) return Boolean is
+   begin
+      return C = ' ' or C = NBSP or C = HT;
+   end Is_Whitespace;
+
+   --  Increase POS to skip leading whitespace characters, decrease LEN to
+   --  skip trailing whitespaces in string S.
+   procedure Remove_Whitespaces (S     : Std_String_Basep;
+                                 Len   : in out Ghdl_Index_Type;
+                                 Pos   : in out Ghdl_Index_Type) is
+   begin
+      --  GHDL: allow several leading whitespace.
+      while Pos < Len loop
+         exit when not Is_Whitespace (S (Pos));
+         Pos := Pos + 1;
+      end loop;
+
+      --  GHDL: allow several leading whitespace.
+      while Len > Pos loop
+         exit when not Is_Whitespace (S (Len - 1));
+         Len := Len - 1;
+      end loop;
+      if Pos = Len then
+         Error_E ("'value: empty string");
+      end if;
+   end Remove_Whitespaces;
+
+   --  Convert C to lowercase.
+   function To_LC (C : in Character) return Character is
+   begin
+      if C >= 'A' and then C <= 'Z' then
+         return Character'Val
+           (Character'Pos (C) + Character'Pos ('a') - Character'Pos ('A'));
+      else
+         return C;
+      end if;
+   end To_LC;
+
+   --  Return TRUE iff user string S (POS .. LEN - 1) is equal to REF.
+   --  Comparaison is case insensitive, but REF must be lowercase (REF is
+   --  supposed to come from an RTI).
+   function String_Match (S : Std_String_Basep;
+                          Pos : Ghdl_Index_Type;
+                          Len : Ghdl_Index_Type;
+                          Ref : Ghdl_C_String) return Boolean
+   is
+      P : Ghdl_Index_Type;
+      C : Character;
+   begin
+      P := 0;
+      loop
+         C := Ref (Natural (P + 1));
+         if Pos + P = Len then
+            --  End of string.
+            return C = ASCII.NUL;
+         end if;
+         if To_LC (S (Pos + P)) /= C or else C = ASCII.NUL then
+            return False;
+         end if;
+         P := P + 1;
+      end loop;
+   end String_Match;
+
+   --  Return the value of STR for enumerated type RTI.
+   function Ghdl_Value_Enum (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_Index_Type
+   is
+      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
+        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      S     : constant Std_String_Basep := Str.Base;
+      Len   : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Pos   : Ghdl_Index_Type := 0;
+   begin
+      Remove_Whitespaces (S, Len, Pos);
+
+      for I in 0 .. Enum_Rti.Nbr - 1 loop
+         if String_Match (S, Pos, Len, Enum_Rti.Names (I)) then
+            return I;
+         end if;
+      end loop;
+      Error_C ("'value: '");
+      Error_C_Std (S (Pos .. Len));
+      Error_C ("' not in enumeration '");
+      Error_C (Enum_Rti.Name);
+      Error_E ("'");
+   end Ghdl_Value_Enum;
+
+   function Ghdl_Value_B1 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_B1
+   is
+   begin
+      return Ghdl_B1'Val (Ghdl_Value_Enum (Str, Rti));
+   end Ghdl_Value_B1;
+
+   function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_E8
+   is
+   begin
+      return Ghdl_E8'Val (Ghdl_Value_Enum (Str, Rti));
+   end Ghdl_Value_E8;
+
+   function Ghdl_Value_E32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_E32
+   is
+   begin
+      return Ghdl_E32'Val (Ghdl_Value_Enum (Str, Rti));
+   end Ghdl_Value_E32;
+
+   --  Convert S (INIT_POS .. LEN) to a signed integer.
+   function Ghdl_Value_I64 (S : Std_String_Basep;
+                            Len : Ghdl_Index_Type;
+                            Init_Pos : Ghdl_Index_Type)
+                           return Ghdl_I64
+   is
+      Pos : Ghdl_Index_Type := Init_Pos;
+      C : Character;
+      Sep : Character;
+      Val, D, Base : Ghdl_I64;
+      Exp : Integer;
+   begin
+      C := S (Pos);
+
+      --  Be user friendly.
+      --  FIXME: reference.
+      if C = '-' or C = '+' then
+         Error_E ("'value: leading sign +/- not allowed");
+      end if;
+
+      Val := 0;
+      loop
+         if C in '0' .. '9' then
+            Val := Val * 10 + Character'Pos (C) - Character'Pos ('0');
+            Pos := Pos + 1;
+            exit when Pos >= Len;
+            C := S (Pos);
+         else
+            Error_E ("'value: decimal digit expected");
+         end if;
+         case C is
+            when '_' =>
+               Pos := Pos + 1;
+               if Pos >= Len then
+                  Error_E ("'value: trailing underscore");
+               end if;
+               C := S (Pos);
+            when '#'
+              | ':'
+              | 'E'
+              | 'e' =>
+               exit;
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+               exit;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      if Pos >= Len then
+         return Val;
+      end if;
+
+      if C = '#' or C = ':' then
+         Base := Val;
+         Val := 0;
+         Sep := C;
+         Pos := Pos + 1;
+         if Base < 2 or Base > 16 then
+            Error_E ("'value: bad base");
+         end if;
+         if Pos >= Len then
+            Error_E ("'value: missing based integer");
+         end if;
+         C := S (Pos);
+         loop
+            case C is
+               when '0' .. '9' =>
+                  D := Character'Pos (C) - Character'Pos ('0');
+               when 'a' .. 'f' =>
+                  D := Character'Pos (C) - Character'Pos ('a') + 10;
+               when 'A' .. 'F' =>
+                  D := Character'Pos (C) - Character'Pos ('A') + 10;
+               when others =>
+                  Error_E ("'value: digit expected");
+            end case;
+            if D >= Base then
+               Error_E ("'value: digit >= base");
+            end if;
+            Val := Val * Base + D;
+            Pos := Pos + 1;
+            if Pos >= Len then
+               Error_E ("'value: missing end sign number");
+            end if;
+            C := S (Pos);
+            if C = '#' or C = ':' then
+               if C /= Sep then
+                  Error_E ("'value: sign number mismatch");
+               end if;
+               Pos := Pos + 1;
+               exit;
+            elsif C = '_' then
+               Pos := Pos + 1;
+               if Pos >= Len then
+                  Error_E ("'value: no character after underscore");
+               end if;
+               C := S (Pos);
+            end if;
+         end loop;
+      else
+         Base := 10;
+      end if;
+
+      -- Handle exponent.
+      if C = 'e' or C = 'E' then
+         Pos := Pos + 1;
+         if Pos >= Len then
+            Error_E ("'value: no character after exponent");
+         end if;
+         C := S (Pos);
+         if C = '+' then
+            Pos := Pos + 1;
+            if Pos >= Len then
+               Error_E ("'value: no character after sign");
+            end if;
+            C := S (Pos);
+         elsif C = '-' then
+            Error_E ("'value: negativ exponent not allowed");
+         end if;
+         Exp := 0;
+         loop
+            if C in '0' .. '9' then
+               Exp := Exp * 10 + Character'Pos (C) - Character'Pos ('0');
+               Pos := Pos + 1;
+               exit when Pos >= Len;
+               C := S (Pos);
+            else
+               Error_E ("'value: decimal digit expected");
+            end if;
+            case C is
+               when '_' =>
+                  Pos := Pos + 1;
+                  if Pos >= Len then
+                     Error_E ("'value: trailing underscore");
+                  end if;
+                  C := S (Pos);
+               when ' '
+                 | NBSP
+                 | HT =>
+                  Pos := Pos + 1;
+                  exit;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         while Exp > 0 loop
+            if Exp mod 2 = 1 then
+               Val := Val * Base;
+            end if;
+            Exp := Exp / 2;
+            Base := Base * Base;
+         end loop;
+      end if;
+
+      if Pos /= Len then
+         Error_E ("'value: trailing characters after blank");
+      end if;
+
+      return Val;
+   end Ghdl_Value_I64;
+
+   function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64
+   is
+      S : constant Std_String_Basep := Str.Base;
+      Len : Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
+      Pos : Ghdl_Index_Type := 0;
+   begin
+      --  LRM 14.1
+      --  Leading [and trailing] whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      Remove_Whitespaces (S, Len, Pos);
+
+      return Ghdl_Value_I64 (S, Len, Pos);
+   end Ghdl_Value_I64;
+
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
+   is
+   begin
+      return Ghdl_I32 (Ghdl_Value_I64 (Str));
+   end Ghdl_Value_I32;
+
+   -- From patch attached to https://gna.org/bugs/index.php?18352
+   -- thanks to Christophe Curis https://gna.org/users/lobotomy
+   function Ghdl_Value_F64 (S : Std_String_Basep;
+                            Len : Ghdl_Index_Type;
+                            Init_Pos : Ghdl_Index_Type)
+                           return Ghdl_F64
+   is
+      Pos     : Ghdl_Index_Type := Init_Pos;
+      C       : Character;
+      Is_Negative, Is_Neg_Exp : Boolean := False;
+      Base    : Ghdl_F64;
+      Intg    : Ghdl_I32;
+      Val, Df : Ghdl_F64;
+      Sep     : Character;
+      FrcExp  : Ghdl_F64;
+   begin
+      C := S (Pos);
+      if C = '-' then
+         Is_Negative := True;
+         Pos := Pos + 1;
+      elsif C = '+' then
+         Pos := Pos + 1;
+      end if;
+
+      if Pos >= Len then
+         Error_E ("'value: decimal digit expected");
+      end if;
+
+      -- Read Integer-or-Base part (may be optional)
+      Intg := 0;
+      while Pos < Len loop
+         C := S (Pos);
+         if C in '0' .. '9' then
+            Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0');
+         elsif C /= '_' then
+            exit;
+         end if;
+         Pos := Pos + 1;
+      end loop;
+
+      if Pos = Len then
+         return Ghdl_F64 (Intg);
+      end if;
+
+      -- Special case: base was specified
+      if C = '#' or C = ':' then
+         if Intg < 2 or Intg > 16 then
+            Error_E ("'value: bad base");
+         end if;
+         Base := Ghdl_F64 (Intg);
+         Val  := 0.0;
+         Sep  := C;
+         Pos  := Pos + 1;
+         if Pos >= Len then
+            Error_E ("'value: missing based decimal");
+         end if;
+
+         -- Get the Integer part of the Value
+         while Pos < Len loop
+            C := S (Pos);
+            case C is
+               when '0' .. '9' =>
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0') );
+               when 'A' .. 'F' =>
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10);
+               when 'a' .. 'f' =>
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10);
+               when others =>
+                  exit;
+            end case;
+            if C /= '_' then
+               if Df >= Base then
+                  Error_E ("'value: digit greater than base");
+               end if;
+               Val := Val * Base + Df;
+            end if;
+            Pos := Pos + 1;
+         end loop;
+         if Pos >= Len then
+            Error_E ("'value: missing end sign number");
+         end if;
+      else
+         Base := 10.0;
+         Sep  := ' ';
+         Val  := Ghdl_F64 (Intg);
+      end if;
+
+      -- Handle the Fractional part
+      if C = '.' then
+         Pos := Pos + 1;
+         FrcExp := 1.0;
+         while Pos < Len loop
+            C := S (Pos);
+            case C is
+               when '0' .. '9' =>
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0'));
+               when 'A' .. 'F' =>
+                  exit when Sep = ' ';
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10);
+               when 'a' .. 'f' =>
+                  exit when Sep = ' ';
+                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10);
+               when others =>
+                  exit;
+            end case;
+            if C /= '_' then
+               FrcExp := FrcExp / Base;
+               if Df > Base then
+                  Error_E ("'value: digit greater than base");
+               end if;
+               Val := Val + Df * FrcExp;
+            end if;
+            Pos := Pos + 1;
+         end loop;
+      end if;
+
+      -- If base was specified, we must find here the end marker
+      if Sep /= ' ' then
+         if Pos >= Len then
+            Error_E ("'value: missing end sign number");
+         end if;
+         if C /= Sep then
+            Error_E ("'value: sign number mismatch");
+         end if;
+         Pos := Pos + 1;
+      end if;
+
+      -- Handle exponent
+      if Pos < Len then
+         C := S (Pos);
+         if C = 'e' or C = 'E' then
+            Pos := Pos + 1;
+            if Pos >= Len then
+               Error_E ("'value: no character after exponent");
+            end if;
+            C := S (Pos);
+            if C = '-' then
+               Is_Neg_Exp := True;
+               Pos := Pos + 1;
+            elsif C = '+' then
+               Pos := Pos + 1;
+            end if;
+            Intg := 0;
+            while Pos < Len loop
+               C := S (Pos);
+               if C in '0' .. '9' then
+                  Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0');
+               else
+                  exit;
+               end if;
+               Pos := Pos + 1;
+            end loop;
+            -- This Exponentiation method is sub-optimal,
+            -- but it does not depend on any library
+            FrcExp := 1.0;
+            if Is_Neg_Exp then
+               while Intg > 0 loop
+                  FrcExp := FrcExp / 10.0;
+                  Intg := Intg - 1;
+               end loop;
+            else
+               while Intg > 0 loop
+                  FrcExp := FrcExp * 10.0;
+                  Intg := Intg - 1;
+               end loop;
+            end if;
+            Val := Val * FrcExp;
+         end if;
+      end if;
+
+      if Pos /= Len then
+         Error_E ("'value: trailing characters after blank");
+      end if;
+
+      if Is_Negative then
+         Val := -Val;
+      end if;
+
+      return Val;
+   end Ghdl_Value_F64;
+
+   -- From patch attached to https://gna.org/bugs/index.php?18352
+   -- thanks to Christophe Curis https://gna.org/users/lobotomy
+   function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64
+   is
+      S       : constant Std_String_Basep := Str.Base;
+      Len     : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Pos     : Ghdl_Index_Type := 0;
+   begin
+      --  LRM 14.1
+      --  Leading and trailing whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      Remove_Whitespaces (S, Len, Pos);
+
+      return Ghdl_Value_F64 (S, Len, Pos);
+   end Ghdl_Value_F64;
+
+   procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr;
+                                        Is_Real : out Boolean;
+                                        Lit_Pos : out Ghdl_Index_Type;
+                                        Lit_End : out Ghdl_Index_Type;
+                                        Unit_Pos : out Ghdl_Index_Type)
+   is
+      S        : constant Std_String_Basep := Str.Base;
+      Len      : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+   begin
+      --  LRM 14.1
+      --  Leading and trailing whitespace is allowed and ignored.
+      Lit_Pos := 0;
+      Remove_Whitespaces (S, Len, Lit_Pos);
+
+      --  Split between abstract literal (optionnal) and unit name.
+      Lit_End := Lit_Pos;
+      Is_Real := False;
+      while Lit_End < Len loop
+         exit when Is_Whitespace (S (Lit_End));
+         if S (Lit_End) = '.' then
+            Is_Real := True;
+         end if;
+         Lit_End := Lit_End + 1;
+      end loop;
+      if Lit_End = Len then
+         --  No literal
+         Unit_Pos := Lit_Pos;
+         Lit_End := 0;
+      else
+         Unit_Pos := Lit_End + 1;
+         while Unit_Pos < Len loop
+            exit when not Is_Whitespace (S (Unit_Pos));
+            Unit_Pos := Unit_Pos + 1;
+         end loop;
+      end if;
+   end Ghdl_Value_Physical_Split;
+
+   function Ghdl_Value_Physical_Type (Str : Std_String_Ptr;
+                                      Rti : Ghdl_Rti_Access)
+                                     return Ghdl_I64
+   is
+      S        : constant Std_String_Basep := Str.Base;
+      Len      : Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
+      Unit_Pos : Ghdl_Index_Type;
+      Lit_Pos  : Ghdl_Index_Type;
+      Lit_End  : Ghdl_Index_Type;
+
+      Found_Real : Boolean;
+
+      Phys_Rti : constant Ghdl_Rtin_Type_Physical_Acc :=
+        To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit_Name : Ghdl_C_String;
+      Multiple : Ghdl_Rti_Access;
+      Mult     : Ghdl_I64;
+   begin
+      --  Remove trailing whitespaces.  FIXME: also called in physical_split.
+      Lit_Pos := 0;
+      Remove_Whitespaces (S, Len, Lit_Pos);
+
+      --  Extract literal and unit
+      Ghdl_Value_Physical_Split (Str, Found_Real, Lit_Pos, Lit_End, Unit_Pos);
+
+      --  Find unit value
+      Multiple := null;
+      for i in 0 .. Phys_Rti.Nbr - 1 loop
+         Unit_Name :=
+           Rtis_Utils.Get_Physical_Unit_Name (Phys_Rti.Units (i));
+         if String_Match (S, Unit_Pos, Len, Unit_Name) then
+            Multiple := Phys_Rti.Units (i);
+            exit;
+         end if;
+      end loop;
+      if Multiple = null then
+         Error_C ("'value: unit '");
+         Error_C_Std (S (Unit_Pos .. Len - 1));
+         Error_C ("' not in physical type '");
+         Error_C (Phys_Rti.Name);
+         Error_E ("'");
+      end if;
+
+      Mult := Grt.Rtis_Utils.Get_Physical_Unit_Value (Multiple, Rti);
+
+      if Lit_End = 0 then
+         return Mult;
+      else
+         if Found_Real then
+            return Ghdl_I64
+              (Ghdl_Value_F64 (S, Lit_End, Lit_Pos) * Ghdl_F64 (Mult));
+         else
+            return Ghdl_Value_I64 (S, Lit_End, Lit_Pos) * Mult;
+         end if;
+      end if;
+   end Ghdl_Value_Physical_Type;
+
+   function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I64
+   is
+   begin
+      if Rti.Kind /= Ghdl_Rtik_Type_P64 then
+         Error_E ("Physical_Type_64'value: incorrect RTI");
+      end if;
+      return Ghdl_Value_Physical_Type (Str, Rti);
+   end Ghdl_Value_P64;
+
+   function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I32
+   is
+   begin
+      if Rti.Kind /= Ghdl_Rtik_Type_P32 then
+         Error_E ("Physical_Type_32'value: incorrect RTI");
+      end if;
+      return Ghdl_I32 (Ghdl_Value_Physical_Type (Str, Rti));
+   end Ghdl_Value_P32;
+
+end Grt.Values;
diff --git a/src/translate/grt/grt-values.ads b/src/translate/grt/grt-values.ads
new file mode 100644
index 000000000..8df8c3f63
--- /dev/null
+++ b/src/translate/grt/grt-values.ads
@@ -0,0 +1,69 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Values is
+   --  Return True IFF C is a whitespace character (as defined in LRM93 14.3)
+   function Is_Whitespace (C : in Character) return Boolean;
+
+   --  Convert C to lowercase.
+   function To_LC (C : in Character) return Character;
+
+   --  Extract position of numeric literal and unit in string STR.
+   --  Set IS_REAL if the unit is a real number (presence of '.').
+   --  Set UNIT_POS to the position of the first character of the unit name.
+   --  Set LIT_POS to the position of the first character of the numeric
+   --  literal (after whitespaces are skipped).
+   --  Set LIT_END to the position of the next character of the numeric lit.
+   procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr;
+                                        Is_Real : out Boolean;
+                                        Lit_Pos : out Ghdl_Index_Type;
+                                        Lit_End : out Ghdl_Index_Type;
+                                        Unit_Pos : out Ghdl_Index_Type);
+
+   function Ghdl_Value_B1 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_B1;
+   function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_E8;
+   function Ghdl_Value_E32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_E32;
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32;
+   function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64;
+   function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64;
+   function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I64;
+   function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
+      return Ghdl_I32;
+private
+   pragma Export (Ada, Ghdl_Value_B1, "__ghdl_value_b1");
+   pragma Export (C, Ghdl_Value_E8, "__ghdl_value_e8");
+   pragma Export (C, Ghdl_Value_E32, "__ghdl_value_e32");
+   pragma Export (C, Ghdl_Value_I32, "__ghdl_value_i32");
+   pragma Export (C, Ghdl_Value_I64, "__ghdl_value_i64");
+   pragma Export (C, Ghdl_Value_F64, "__ghdl_value_f64");
+   pragma Export (C, Ghdl_Value_P64, "__ghdl_value_p64");
+   pragma Export (C, Ghdl_Value_P32, "__ghdl_value_p32");
+end Grt.Values;
diff --git a/src/translate/grt/grt-vcd.adb b/src/translate/grt/grt-vcd.adb
new file mode 100644
index 000000000..d4a9ea066
--- /dev/null
+++ b/src/translate/grt/grt-vcd.adb
@@ -0,0 +1,845 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Interfaces;
+with Grt.Stdio; use Grt.Stdio;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Errors; use Grt.Errors;
+with Grt.Signals; use Grt.Signals;
+with Grt.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.C; use Grt.C;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+with Grt.Vstrings;
+pragma Elaborate_All (Grt.Table);
+
+package body Grt.Vcd is
+   --  If TRUE, put $date in vcd file.
+   --  Can be set to FALSE to make vcd comparaison easier.
+   Flag_Vcd_Date : Boolean := True;
+
+   Stream : FILEs;
+
+   procedure My_Vcd_Put (Str : String)
+   is
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Stream);
+   end My_Vcd_Put;
+
+   procedure My_Vcd_Putc (C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := fputc (Character'Pos (C), Stream);
+   end My_Vcd_Putc;
+
+   procedure My_Vcd_Close is
+   begin
+      fclose (Stream);
+      Stream := NULL_Stream;
+   end My_Vcd_Close;
+
+   --  VCD filename.
+   --  Stream corresponding to the VCD filename.
+   --Vcd_Stream : FILEs;
+
+   --  Index type of the table of vcd variables to dump.
+   type Vcd_Index_Type is new Integer;
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Vcd_Option (Opt : String) return Boolean
+   is
+      F : constant Natural := Opt'First;
+      Mode : constant String := "wt" & NUL;
+      Vcd_Filename : String_Access;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
+         return False;
+      end if;
+      if Opt'Length = 12 and then Opt (F + 5 .. F + 11) = "-nodate" then
+         Flag_Vcd_Date := False;
+         return True;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         if Vcd_Close /= null then
+            Error ("--vcd: file already set");
+            return True;
+         end if;
+
+         --  Add an extra NUL character.
+         Vcd_Filename := new String (1 .. Opt'Length - 6 + 1);
+         Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
+         Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+         if Vcd_Filename.all = "-" & NUL then
+            Stream := stdout;
+         else
+            Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+            if Stream = NULL_Stream then
+               Error_C ("cannot open ");
+               Error_E (Vcd_Filename (Vcd_Filename'First
+                                      .. Vcd_Filename'Last - 1));
+               return True;
+            end if;
+         end if;
+         Vcd_Putc := My_Vcd_Putc'Access;
+         Vcd_Put := My_Vcd_Put'Access;
+         Vcd_Close := My_Vcd_Close'Access;
+         return True;
+      else
+         return False;
+      end if;
+   end Vcd_Option;
+
+   procedure Vcd_Help is
+   begin
+      Put_Line (" --vcd=FILENAME     dump signal values into a VCD file");
+      Put_Line (" --vcd-nodate       do not write date in VCD file");
+   end Vcd_Help;
+
+   procedure Vcd_Newline is
+   begin
+      Vcd_Putc (Nl);
+   end Vcd_Newline;
+
+   procedure Vcd_Putline (Str : String) is
+   begin
+      Vcd_Put (Str);
+      Vcd_Newline;
+   end Vcd_Putline;
+
+--    procedure Vcd_Put (Str : Ghdl_Str_Len_Type)
+--    is
+--    begin
+--       Put_Str_Len (Vcd_Stream, Str);
+--    end Vcd_Put;
+
+   procedure Vcd_Put_I32 (V : Ghdl_I32)
+   is
+      Str : String (1 .. 11);
+      First : Natural;
+   begin
+      Vstrings.To_String (Str, First, V);
+      Vcd_Put (Str (First .. Str'Last));
+   end Vcd_Put_I32;
+
+   procedure Vcd_Put_Idcode (N : Vcd_Index_Type)
+   is
+      Str : String (1 .. 8);
+      V, R : Vcd_Index_Type;
+      L : Natural;
+   begin
+      L := 0;
+      V := N;
+      loop
+         R := V mod 93;
+         V := V / 93;
+         L := L + 1;
+         Str (L) := Character'Val (33 + R);
+         exit when V = 0;
+      end loop;
+      Vcd_Put (Str (1 .. L));
+   end Vcd_Put_Idcode;
+
+   procedure Vcd_Put_Name (Obj : VhpiHandleT)
+   is
+      Name : String (1 .. 128);
+      Name_Len : Integer;
+   begin
+      Vhpi_Get_Str (VhpiNameP, Obj, Name, Name_Len);
+      if Name_Len <= Name'Last then
+         Vcd_Put (Name (1 .. Name_Len));
+      else
+         --  Truncate.
+         Vcd_Put (Name);
+      end if;
+   end Vcd_Put_Name;
+
+   procedure Vcd_Put_End is
+   begin
+      Vcd_Putline ("$end");
+   end Vcd_Put_End;
+
+   --  Called before elaboration.
+   procedure Vcd_Init
+   is
+   begin
+      if Vcd_Close = null then
+         return;
+      end if;
+      if Flag_Vcd_Date then
+         Vcd_Putline ("$date");
+         Vcd_Put ("  ");
+         declare
+            type time_t is new Interfaces.Integer_64;
+            Cur_Time : time_t;
+
+            function time (Addr : Address) return time_t;
+            pragma Import (C, time);
+
+            function ctime (Timep: Address) return Ghdl_C_String;
+            pragma Import (C, ctime);
+
+            Ct : Ghdl_C_String;
+         begin
+            Cur_Time := time (Null_Address);
+            Ct := ctime (Cur_Time'Address);
+            for I in Positive loop
+               exit when Ct (I) = NUL;
+               Vcd_Putc (Ct (I));
+            end loop;
+            -- Note: ctime already append a LF.
+         end;
+         Vcd_Put_End;
+      end if;
+      Vcd_Putline ("$version");
+      Vcd_Putline ("  GHDL v0");
+      Vcd_Put_End;
+      Vcd_Putline ("$timescale");
+      Vcd_Putline ("  1 fs");
+      Vcd_Put_End;
+   end Vcd_Init;
+
+   package Vcd_Table is new Grt.Table
+     (Table_Component_Type => Verilog_Wire_Info,
+      Table_Index_Type => Vcd_Index_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 32);
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("Vcd.Avhpi_Error!");
+      null;
+   end Avhpi_Error;
+
+   function Rti_To_Vcd_Kind (Rti : Ghdl_Rti_Access) return Vcd_Var_Kind
+   is
+      Rti1 : Ghdl_Rti_Access;
+   begin
+      if Rti.Kind = Ghdl_Rtik_Subtype_Scalar then
+         Rti1 := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype;
+      else
+         Rti1 := Rti;
+      end if;
+
+      if Rti1 = Std_Standard_Boolean_RTI_Ptr then
+         return Vcd_Bool;
+      end if;
+      if Rti1 = Std_Standard_Bit_RTI_Ptr then
+         return Vcd_Bit;
+      end if;
+      if Rti1 = Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr then
+         return Vcd_Stdlogic;
+      end if;
+      if Rti1.Kind = Ghdl_Rtik_Type_I32 then
+         return Vcd_Integer32;
+      end if;
+      if Rti1.Kind = Ghdl_Rtik_Type_F64 then
+         return Vcd_Float64;
+      end if;
+      return Vcd_Bad;
+   end Rti_To_Vcd_Kind;
+
+   function Rti_To_Vcd_Kind (Rti : Ghdl_Rtin_Type_Array_Acc)
+                            return Vcd_Var_Kind
+   is
+      It : Ghdl_Rti_Access;
+   begin
+      if Rti.Nbr_Dim /= 1 then
+         return Vcd_Bad;
+      end if;
+      It := Rti.Indexes (0);
+      if It.Kind /= Ghdl_Rtik_Subtype_Scalar then
+         return Vcd_Bad;
+      end if;
+      if To_Ghdl_Rtin_Subtype_Scalar_Acc (It).Basetype.Kind
+        /= Ghdl_Rtik_Type_I32
+      then
+         return Vcd_Bad;
+      end if;
+      case Rti_To_Vcd_Kind (Rti.Element) is
+         when Vcd_Bit =>
+            return Vcd_Bitvector;
+         when Vcd_Stdlogic =>
+            return Vcd_Stdlogic_Vector;
+         when others =>
+            return Vcd_Bad;
+      end case;
+   end Rti_To_Vcd_Kind;
+
+   procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info)
+   is
+      Sig_Type : VhpiHandleT;
+      Rti : Ghdl_Rti_Access;
+      Error : AvhpiErrorT;
+      Sig_Addr : Address;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      Rti := Avhpi_Get_Rti (Sig_Type);
+      Sig_Addr := Avhpi_Get_Address (Sig);
+      Info.Kind := Vcd_Bad;
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Subtype_Scalar =>
+            Info.Kind := Rti_To_Vcd_Kind (Rti);
+            Info.Addr := Sig_Addr;
+            Info.Irange := null;
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               St := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Info.Kind := Rti_To_Vcd_Kind (St.Basetype);
+               Info.Addr := Sig_Addr;
+               Info.Irange := To_Ghdl_Range_Ptr
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds,
+                               Avhpi_Get_Context (Sig)));
+            end;
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Uc : Ghdl_Uc_Array_Acc;
+            begin
+               Info.Kind := Rti_To_Vcd_Kind
+                 (To_Ghdl_Rtin_Type_Array_Acc (Rti));
+               Uc := To_Ghdl_Uc_Array_Acc (Sig_Addr);
+               Info.Addr := Uc.Base;
+               Info.Irange := To_Ghdl_Range_Ptr (Uc.Bounds);
+            end;
+         when others =>
+            Info.Irange := null;
+      end case;
+
+      --  Do not allow null-array.
+      if Info.Irange /= null and then Info.Irange.I32.Len = 0 then
+         Info.Kind := Vcd_Bad;
+         Info.Irange := null;
+         return;
+      end if;
+
+      if Vhpi_Get_Kind (Sig) = VhpiPortDeclK then
+         case Vhpi_Get_Mode (Sig) is
+            when VhpiInMode
+              | VhpiInoutMode
+              | VhpiBufferMode
+              | VhpiLinkageMode =>
+               Info.Val := Vcd_Effective;
+            when VhpiOutMode =>
+               Info.Val := Vcd_Driving;
+            when VhpiErrorMode =>
+               Info.Kind := Vcd_Bad;
+         end case;
+      else
+         Info.Val := Vcd_Effective;
+      end if;
+   end Get_Verilog_Wire;
+
+   procedure Add_Signal (Sig : VhpiHandleT)
+   is
+      N : Vcd_Index_Type;
+      Vcd_El : Verilog_Wire_Info;
+   begin
+      Get_Verilog_Wire (Sig, Vcd_El);
+
+      if Vcd_El.Kind = Vcd_Bad then
+         Vcd_Put ("$comment ");
+         Vcd_Put_Name (Sig);
+         Vcd_Put (" is not handled");
+         --Vcd_Put (Ghdl_Type_Kind'Image (Desc.Kind));
+         Vcd_Putc (' ');
+         Vcd_Put_End;
+         return;
+      else
+         Vcd_Table.Increment_Last;
+         N := Vcd_Table.Last;
+
+         Vcd_Table.Table (N) := Vcd_El;
+         Vcd_Put ("$var ");
+         case Vcd_El.Kind is
+            when Vcd_Integer32 =>
+               Vcd_Put ("integer 32");
+            when Vcd_Float64 =>
+               Vcd_Put ("real 64");
+            when Vcd_Bool
+              | Vcd_Bit
+              | Vcd_Stdlogic =>
+               Vcd_Put ("reg 1");
+            when Vcd_Bitvector
+              | Vcd_Stdlogic_Vector =>
+               Vcd_Put ("reg ");
+               Vcd_Put_I32 (Ghdl_I32 (Vcd_El.Irange.I32.Len));
+            when Vcd_Bad =>
+               null;
+         end case;
+         Vcd_Putc (' ');
+         Vcd_Put_Idcode (N);
+         Vcd_Putc (' ');
+         Vcd_Put_Name (Sig);
+         if Vcd_El.Irange /= null then
+            Vcd_Putc ('[');
+            Vcd_Put_I32 (Vcd_El.Irange.I32.Left);
+            Vcd_Putc (':');
+            Vcd_Put_I32 (Vcd_El.Irange.I32.Right);
+            Vcd_Putc (']');
+         end if;
+         Vcd_Putc (' ');
+         Vcd_Put_End;
+         if Boolean'(False) then
+            Vcd_Put ("$comment ");
+            Vcd_Put_Name (Sig);
+            Vcd_Put (" is ");
+            case Vcd_El.Val is
+               when Vcd_Effective =>
+                  Vcd_Put ("effective ");
+               when Vcd_Driving =>
+                  Vcd_Put ("driving ");
+            end case;
+            Vcd_Put_End;
+         end if;
+      end if;
+   end Add_Signal;
+
+   procedure Vcd_Put_Hierarchy (Inst : VhpiHandleT)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract signals.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               Add_Signal (Decl);
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      --  Extract sub-scopes.
+      Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiBlockStmtK
+              | VhpiCompInstStmtK =>
+               Vcd_Put ("$scope module ");
+               Vcd_Put_Name (Decl);
+               Vcd_Putc (' ');
+               Vcd_Put_End;
+               Vcd_Put_Hierarchy (Decl);
+               Vcd_Put ("$upscope ");
+               Vcd_Put_End;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+   end Vcd_Put_Hierarchy;
+
+   procedure Vcd_Put_Bit (V : Ghdl_B1)
+   is
+      C : Character;
+   begin
+      if V then
+         C := '1';
+      else
+         C := '0';
+      end if;
+      Vcd_Putc (C);
+   end Vcd_Put_Bit;
+
+   procedure Vcd_Put_Stdlogic (V : Ghdl_E8)
+   is
+      type Map_Type is array (Ghdl_E8 range 0 .. 8) of Character;
+      --                             "UX01ZWLH-"
+   -- Map_Vlg : constant Map_Type := "xx01zz01x";
+      Map_Std : constant Map_Type := "UX01ZWLH-";
+   begin
+      if V not in Map_Type'Range then
+         Vcd_Putc ('?');
+      else
+         Vcd_Putc (Map_Std (V));
+      end if;
+   end Vcd_Put_Stdlogic;
+
+   procedure Vcd_Put_Integer32 (V : Ghdl_U32)
+   is
+      Val : Ghdl_U32;
+      N : Natural;
+   begin
+      Val := V;
+      N := 32;
+      while N > 1 loop
+         exit when (Val and 16#8000_0000#) /= 0;
+         Val := Val * 2;
+         N := N - 1;
+      end loop;
+
+      while N > 0 loop
+         if (Val and 16#8000_0000#) /= 0 then
+            Vcd_Putc ('1');
+         else
+            Vcd_Putc ('0');
+         end if;
+         Val := Val * 2;
+         N := N - 1;
+      end loop;
+   end Vcd_Put_Integer32;
+
+   -- Using the floor attribute of Ghdl_F64 will result on a link error while
+   -- trying to simulate a design. So it was needed to create a floor function
+   function Digit_Floor (V : Ghdl_F64) return Ghdl_I32
+   is
+      Var : Ghdl_I32;
+   begin
+      -- V is always positive here and only of interest when it is a digit
+      if V > 10.0 then
+         return -1;
+      else
+         Var := Ghdl_I32(V-0.5); --Ghdl_I32 rounds to the nearest integer
+         -- The rounding made by Ghdl_I32 is asymetric :
+         -- 0.5 will be rounded to 1, but -0.5 to -1 instead of 0
+         if Var > 0 then
+            return Var;
+         else
+            return 0;
+         end if;
+      end if;
+   end Digit_Floor;
+
+   procedure Vcd_Put_Float64 (V : Ghdl_F64)
+   is
+      Val_tmp, Fact : Ghdl_F64;
+      Digit, Exp, Delta_Exp, N_Exp : Ghdl_I32;
+      --
+   begin
+      Exp := 0;
+      if V /= V then
+         Vcd_Put("NaN");
+         return;
+      end if;
+      if V < 0.0 then
+         Vcd_Putc ('-');
+         Val_tmp := -V;
+      elsif V = 0.0 then
+         Vcd_Put("0.0");
+         return;
+      else
+         Val_tmp := V;
+      end if;
+      if Val_tmp > Ghdl_F64'Last then
+         Vcd_Put("Inf");
+         return;
+      elsif Val_tmp < 1.0 then
+         Fact := 10.0;
+         Delta_Exp := -1;
+      else
+         Fact := 0.1;
+         Delta_Exp := 1;
+      end if;
+
+      -- Seek the first digit
+      loop
+         Digit := Digit_Floor(Val_tmp);
+         if Digit > 0 then
+            exit;
+         end if;
+         Exp := Exp + Delta_Exp;
+         Val_tmp := Val_tmp * Fact;
+      end loop;
+      Vcd_Putc(Character'Val(Digit + 48));
+      Vcd_Putc('.');
+      for i in 0..4 loop -- 5 digits displayed after the point
+         Val_tmp := abs(Val_tmp - Ghdl_F64(Digit))*10.0;
+         Digit := Digit_Floor(Val_tmp);
+         Vcd_Putc(Character'Val(Digit + 48));
+      end loop;
+      Vcd_Putc('E');
+      if Exp < 0 then
+         Vcd_Putc('-');
+         Exp := -Exp;
+      end if;
+      N_Exp := 100;
+      while N_Exp > 0 loop
+         Vcd_Putc(Character'Val(Exp/N_Exp + 48));
+         Exp := Exp mod N_Exp;
+         N_Exp := N_Exp/10;
+      end loop;
+   end Vcd_Put_Float64;
+
+   procedure Vcd_Put_Var (I : Vcd_Index_Type)
+   is
+      Addr : Address;
+      V : Verilog_Wire_Info renames Vcd_Table.Table (I);
+      Len : Ghdl_Index_Type;
+   begin
+      Addr := V.Addr;
+      if V.Irange = null then
+         Len := 1;
+      else
+         Len := V.Irange.I32.Len;
+      end if;
+      case V.Val is
+         when Vcd_Effective =>
+            case V.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool =>
+                  Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B1);
+               when Vcd_Stdlogic =>
+                  Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Value.E8);
+               when Vcd_Integer32 =>
+                  Vcd_Putc ('b');
+                  Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32);
+                  Vcd_Putc (' ');
+               when Vcd_Float64 =>
+                  Vcd_Putc ('r');
+                  Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0).Value.F64);
+                  Vcd_Putc (' ');
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B1);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Stdlogic_Vector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(J).Value.E8);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Bad =>
+                  null;
+            end case;
+         when Vcd_Driving =>
+            case V.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool =>
+                  Vcd_Put_Bit
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B1);
+               when Vcd_Stdlogic =>
+                  Vcd_Put_Stdlogic
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E8);
+               when Vcd_Integer32 =>
+                  Vcd_Putc ('b');
+                  Vcd_Put_Integer32
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32);
+                  Vcd_Putc (' ');
+               when Vcd_Float64 =>
+                  Vcd_Putc ('r');
+                  Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0)
+                                           .Driving_Value.F64);
+                  Vcd_Putc (' ');
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B1);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Stdlogic_Vector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Stdlogic
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.E8);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Bad =>
+                  null;
+            end case;
+      end case;
+      Vcd_Put_Idcode (I);
+      Vcd_Newline;
+   end Vcd_Put_Var;
+
+   function Verilog_Wire_Changed (Info : Verilog_Wire_Info;
+                                  Last : Std_Time)
+                                 return Boolean
+   is
+      Len : Ghdl_Index_Type;
+   begin
+      if Info.Irange = null then
+         Len := 1;
+      else
+         Len := Info.Irange.I32.Len;
+      end if;
+
+      case Info.Val is
+         when Vcd_Effective =>
+            case Info.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Stdlogic
+                 | Vcd_Bitvector
+                 | Vcd_Stdlogic_Vector
+                 | Vcd_Integer32
+                 | Vcd_Float64 =>
+                  for J in 0 .. Len - 1 loop
+                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Event = Last then
+                        return True;
+                     end if;
+                  end loop;
+               when Vcd_Bad =>
+                  null;
+            end case;
+         when Vcd_Driving =>
+            case Info.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Stdlogic
+                 | Vcd_Bitvector
+                 | Vcd_Stdlogic_Vector
+                 | Vcd_Integer32
+                 | Vcd_Float64 =>
+                  for J in 0 .. Len - 1 loop
+                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Active = Last
+                     then
+                        return True;
+                     end if;
+                  end loop;
+               when Vcd_Bad =>
+                  null;
+            end case;
+      end case;
+      return False;
+   end Verilog_Wire_Changed;
+
+   procedure Vcd_Put_Time
+   is
+      Str : String (1 .. 21);
+      First : Natural;
+   begin
+      Vcd_Putc ('#');
+      Vstrings.To_String (Str, First, Ghdl_I64 (Cycle_Time));
+      Vcd_Put (Str (First .. Str'Last));
+      Vcd_Newline;
+   end Vcd_Put_Time;
+
+   procedure Vcd_Cycle;
+
+   --  Called after elaboration.
+   procedure Vcd_Start
+   is
+      Root : VhpiHandleT;
+   begin
+      --  Do nothing if there is no VCD file to generate.
+      if Vcd_Close = null then
+         return;
+      end if;
+
+      --  Be sure the RTI of std_ulogic is set.
+      Search_Types_RTI;
+
+      --  Put hierarchy.
+      Get_Root_Inst (Root);
+      Vcd_Put_Hierarchy (Root);
+
+      --  End of header.
+      Vcd_Put ("$enddefinitions ");
+      Vcd_Put_End;
+
+      Register_Cycle_Hook (Vcd_Cycle'Access);
+   end Vcd_Start;
+
+   --  Called before each non delta cycle.
+   procedure Vcd_Cycle is
+   begin
+      --  Disp values.
+      Vcd_Put_Time;
+      if Cycle_Time = 0 then
+         --  Disp all values.
+         for I in Vcd_Table.First .. Vcd_Table.Last loop
+            Vcd_Put_Var (I);
+         end loop;
+      else
+         --  Disp only values changed.
+         for I in Vcd_Table.First .. Vcd_Table.Last loop
+            if Verilog_Wire_Changed (Vcd_Table.Table (I), Cycle_Time) then
+               Vcd_Put_Var (I);
+            end if;
+         end loop;
+      end if;
+   end Vcd_Cycle;
+
+   --  Called at the end of the simulation.
+   procedure Vcd_End is
+   begin
+      if Vcd_Close /= null then
+         Vcd_Close.all;
+      end if;
+   end Vcd_End;
+
+   Vcd_Hooks : aliased constant Hooks_Type :=
+     (Option => Vcd_Option'Access,
+      Help => Vcd_Help'Access,
+      Init => Vcd_Init'Access,
+      Start => Vcd_Start'Access,
+      Finish => Vcd_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vcd_Hooks'Access);
+   end Register;
+end Grt.Vcd;
diff --git a/src/translate/grt/grt-vcd.ads b/src/translate/grt/grt-vcd.ads
new file mode 100644
index 000000000..ed015af80
--- /dev/null
+++ b/src/translate/grt/grt-vcd.ads
@@ -0,0 +1,65 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package Grt.Vcd is
+   --  Abstract type for IO.
+   type Vcd_Put_Acc is access procedure (Str : String);
+   type Vcd_Putc_Acc is access procedure (C : Character);
+   type Vcd_Close_Acc is access procedure;
+
+   Vcd_Put : Vcd_Put_Acc;
+   Vcd_Putc : Vcd_Putc_Acc;
+   Vcd_Close : Vcd_Close_Acc;
+
+   type Vcd_Var_Kind is (Vcd_Bad,
+                         Vcd_Bool,
+                         Vcd_Integer32,
+                         Vcd_Float64,
+                         Vcd_Bit, Vcd_Stdlogic,
+                         Vcd_Bitvector, Vcd_Stdlogic_Vector);
+
+   --  Which value to be displayed: effective or driving (for out signals).
+   type Vcd_Value_Kind is (Vcd_Effective, Vcd_Driving);
+
+   type Verilog_Wire_Info is record
+      Addr : Address;
+      Irange : Ghdl_Range_Ptr;
+      Kind : Vcd_Var_Kind;
+      Val : Vcd_Value_Kind;
+   end record;
+
+   procedure Get_Verilog_Wire (Sig : VhpiHandleT;
+                               Info : out Verilog_Wire_Info);
+
+   --  Return TRUE if last change time of the wire described by INFO is LAST.
+   function Verilog_Wire_Changed (Info : Verilog_Wire_Info;
+                                  Last : Std_Time)
+                                 return Boolean;
+
+   procedure Register;
+end Grt.Vcd;
diff --git a/src/translate/grt/grt-vcdz.adb b/src/translate/grt/grt-vcdz.adb
new file mode 100644
index 000000000..8e1ceb6f1
--- /dev/null
+++ b/src/translate/grt/grt-vcdz.adb
@@ -0,0 +1,116 @@
+--  GHDL Run Time (GRT) - VCD .gz module.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Vcd; use Grt.Vcd;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Zlib; use Grt.Zlib;
+with Grt.C; use Grt.C;
+
+package body Grt.Vcdz is
+   Stream : gzFile;
+
+   procedure My_Vcd_Put (Str : String)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := gzwrite (Stream, Str'Address, Str'Length);
+   end My_Vcd_Put;
+
+   procedure My_Vcd_Putc (C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := gzputc (Stream, Character'Pos (C));
+   end My_Vcd_Putc;
+
+   procedure My_Vcd_Close is
+   begin
+      gzclose (Stream);
+      Stream := NULL_gzFile;
+   end My_Vcd_Close;
+
+   --  VCD filename.
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Vcdz_Option (Opt : String) return Boolean
+   is
+      F : constant Natural := Opt'First;
+      Vcd_Filename : String_Access := null;
+      Mode : constant String := "wb" & NUL;
+   begin
+      if Opt'Length < 7 or else Opt (F .. F + 6) /= "--vcdgz" then
+         return False;
+      end if;
+      if Opt'Length > 7 and then Opt (F + 7) = '=' then
+         if Vcd_Close /= null then
+            Error ("--vcdgz: file already set");
+            return True;
+         end if;
+
+         --  Add an extra NUL character.
+         Vcd_Filename := new String (1 .. Opt'Length - 8 + 1);
+         Vcd_Filename (1 .. Opt'Length - 8) := Opt (F + 8 .. Opt'Last);
+         Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+         Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
+         if Stream = NULL_gzFile then
+            Error_C ("cannot open ");
+            Error_E (Vcd_Filename (Vcd_Filename'First
+                                   .. Vcd_Filename'Last - 1));
+            return True;
+         end if;
+         Vcd_Putc := My_Vcd_Putc'Access;
+         Vcd_Put := My_Vcd_Put'Access;
+         Vcd_Close := My_Vcd_Close'Access;
+         return True;
+      else
+         return False;
+      end if;
+   end Vcdz_Option;
+
+   procedure Vcdz_Help is
+   begin
+      Put_Line
+        (" --vcdgz=FILENAME   dump signal values into a VCD gzip'ed file");
+   end Vcdz_Help;
+
+   Vcdz_Hooks : aliased constant Hooks_Type :=
+     (Option => Vcdz_Option'Access,
+      Help => Vcdz_Help'Access,
+      Init => Proc_Hook_Nil'Access,
+      Start => Proc_Hook_Nil'Access,
+      Finish => Proc_Hook_Nil'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vcdz_Hooks'Access);
+   end Register;
+end Grt.Vcdz;
diff --git a/src/translate/grt/grt-vcdz.ads b/src/translate/grt/grt-vcdz.ads
new file mode 100644
index 000000000..aba61c222
--- /dev/null
+++ b/src/translate/grt/grt-vcdz.ads
@@ -0,0 +1,28 @@
+--  GHDL Run Time (GRT) - VCD .gz module.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+package Grt.Vcdz is
+   procedure Register;
+end Grt.Vcdz;
diff --git a/src/translate/grt/grt-vital_annotate.adb b/src/translate/grt/grt-vital_annotate.adb
new file mode 100644
index 000000000..93ecb8119
--- /dev/null
+++ b/src/translate/grt/grt-vital_annotate.adb
@@ -0,0 +1,688 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Types; use Grt.Types;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Options;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Vital_Annotate is
+   --  Point of the annotation.
+   Sdf_Top : VhpiHandleT;
+
+   --  Instance being annotated.
+   Sdf_Inst : VhpiHandleT;
+
+   Flag_Dump : Boolean := False;
+   Flag_Verbose : constant Boolean := False;
+
+   function Name_Compare (Handle : VhpiHandleT;
+                          Name : String;
+                          Property : VhpiStrPropertyT := VhpiNameP)
+                         return Boolean
+   is
+      Obj_Name : String (1 .. Name'Length);
+      Len : Natural;
+   begin
+      Vhpi_Get_Str (Property, Handle, Obj_Name, Len);
+      if Len = Name'Length and then Obj_Name = Name then
+         return True;
+      else
+         return False;
+      end if;
+   end Name_Compare;
+
+   --  Note: RES may alias CUR.
+   procedure Find_Instance (Cur : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Name : String;
+                            Ok : out Boolean)
+   is
+      Error : AvhpiErrorT;
+      It : VhpiHandleT;
+   begin
+      Ok := False;
+      Vhpi_Iterator (VhpiInternalRegions, Cur, It, Error);
+      if Error /= AvhpiErrorOk then
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+         if Name_Compare (Res, Name) then
+            Ok := True;
+            return;
+         end if;
+      end loop;
+      return;
+--       Put ("find instance: ");
+--       Put (Name);
+--       New_Line;
+   end Find_Instance;
+
+   procedure Find_Generic (Gen_Name : String;
+                           Gen_Handle : out VhpiHandleT;
+                           Port1_Name : String;
+                           Port1_Handle : out VhpiHandleT;
+                           Port2_Name : String;
+                           Port2_Handle : out VhpiHandleT)
+   is
+      Error : AvhpiErrorT;
+      It : VhpiHandleT;
+      Decl : VhpiHandleT;
+   begin
+      Gen_Handle := Null_Handle;
+      Port1_Handle := Null_Handle;
+      Port2_Handle := Null_Handle;
+
+      Vhpi_Iterator (VhpiDecls, Sdf_Inst, It, Error);
+      if Error /= AvhpiErrorOk then
+         return;
+      end if;
+
+      --  Look for the generic.
+      loop
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
+            return;
+         end if;
+         exit when Vhpi_Get_Kind (Decl) /= VhpiGenericDeclK;
+         if Name_Compare (Decl, Gen_Name) then
+            Gen_Handle := Decl;
+            exit;
+         end if;
+      end loop;
+
+      --  Skip generics.
+      while Vhpi_Get_Kind (Decl) = VhpiGenericDeclK loop
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
+            return;
+         end if;
+      end loop;
+
+      --  Look for ports.
+      loop
+         exit when Vhpi_Get_Kind (Decl) /= VhpiPortDeclK;
+         if Name_Compare (Decl, Port1_Name) then
+            Port1_Handle := Decl;
+            exit when Port2_Name'Length = 0;
+         end if;
+         if Port2_Name'Length > 0
+           and then Name_Compare (Decl, Port2_Name)
+         then
+            Port2_Handle := Decl;
+            exit when Vhpi_Get_Kind (Port1_Handle) /= VhpiUndefined;
+         end if;
+         Vhpi_Scan (It, Decl, Error);
+         if Error /= AvhpiErrorOk then
+            return;
+         end if;
+      end loop;
+
+   end Find_Generic;
+
+   procedure Sdf_Header (Context : Sdf_Context_Type)
+   is
+   begin
+      if Flag_Dump then
+         case Context.Version is
+            when Sdf_2_1 =>
+               Put ("found SDF file version 2.1");
+            when Sdf_Version_Unknown =>
+               Put ("found SDF file without version");
+            when Sdf_Version_Bad =>
+               Put ("found SDF file with unknown version");
+         end case;
+         New_Line;
+      end if;
+   end Sdf_Header;
+
+   procedure Sdf_Celltype (Context : Sdf_Context_Type)
+   is
+   begin
+      if Flag_Dump then
+         Put ("celltype: ");
+         Put (Context.Celltype (1 .. Context.Celltype_Len));
+         New_Line;
+         Put ("instance:");
+         return;
+      end if;
+      Sdf_Inst := Sdf_Top;
+   end Sdf_Celltype;
+
+   procedure Sdf_Instance (Context : in out Sdf_Context_Type;
+                           Instance : String;
+                           Status : out Boolean)
+   is
+      pragma Unreferenced (Context);
+   begin
+      if Flag_Dump then
+         Put (' ');
+         Put (Instance);
+         Status := True;
+         return;
+      end if;
+
+      Find_Instance (Sdf_Inst, Sdf_Inst, Instance, Status);
+   end Sdf_Instance;
+
+   procedure Sdf_Instance_End (Context : Sdf_Context_Type;
+                               Status : out Boolean)
+   is
+   begin
+      if Flag_Dump then
+         Status := True;
+         New_Line;
+         return;
+      end if;
+      case Vhpi_Get_Kind (Sdf_Inst) is
+         when VhpiRootInstK =>
+            declare
+               Hdl : VhpiHandleT;
+               Error : AvhpiErrorT;
+            begin
+               Status := False;
+               Vhpi_Handle (VhpiDesignUnit, Sdf_Inst, Hdl, Error);
+               if Error /= AvhpiErrorOk then
+                  Internal_Error ("VhpiDesignUnit");
+                  return;
+               end if;
+               case Vhpi_Get_Kind (Hdl) is
+                  when VhpiArchBodyK =>
+                     Vhpi_Handle (VhpiPrimaryUnit, Hdl, Hdl, Error);
+                     if Error /= AvhpiErrorOk then
+                        Internal_Error ("VhpiPrimaryUnit");
+                        return;
+                     end if;
+                  when others =>
+                     Internal_Error ("sdf_instance_end");
+               end case;
+               Status := Name_Compare
+                 (Hdl, Context.Celltype (1 .. Context.Celltype_Len));
+            end;
+         when VhpiCompInstStmtK =>
+            Status := Name_Compare
+              (Sdf_Inst,
+               Context.Celltype (1 .. Context.Celltype_Len),
+               VhpiCompNameP);
+         when others =>
+            Status := False;
+      end case;
+   end Sdf_Instance_End;
+
+   VitalDelayType01 : VhpiHandleT;
+   VitalDelayType01Z : VhpiHandleT;
+   VitalDelayType01ZX : VhpiHandleT;
+   VitalDelayArrayType01 : VhpiHandleT;
+   VitalDelayType : VhpiHandleT;
+   VitalDelayArrayType : VhpiHandleT;
+
+   type Map_Type is array (1 .. 12) of Natural;
+   Map_1 : constant Map_Type := (1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0);
+   Map_2 : constant Map_Type := (1, 2, 1, 1, 2, 2, 0, 0, 0, 0, 0, 0);
+   Map_3 : constant Map_Type := (1, 2, 3, 1, 3, 2, 0, 0, 0, 0, 0, 0);
+   Map_6 : constant Map_Type := (1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0);
+   --Map_12 : constant Map_Type := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);
+
+   function Write_Td_Delay_Generic (Context : Sdf_Context_Type;
+                                    Gen : VhpiHandleT;
+                                    Nbr : Natural;
+                                    Map : Map_Type)
+                                   return Boolean
+   is
+      It : VhpiHandleT;
+      El : VhpiHandleT;
+      Error : AvhpiErrorT;
+      N : Natural;
+   begin
+      Vhpi_Iterator (VhpiIndexedNames, Gen, It, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIndexedNames");
+         return False;
+      end if;
+      for I in 1 .. Nbr loop
+         Vhpi_Scan (It, El, Error);
+         if Error /= AvhpiErrorOk then
+            Internal_Error ("scan on vhpiIndexedNames");
+            return False;
+         end if;
+         N := Map (I);
+         if Context.Timing_Set (N) then
+            if Vhpi_Put_Value (El, Context.Timing (N) * 1000) /= AvhpiErrorOk
+            then
+               Internal_Error ("vhpi_put_value");
+               return False;
+            end if;
+         end if;
+      end loop;
+      return True;
+   end Write_Td_Delay_Generic;
+
+   function Write_Td_Delay_Generic (Context : Sdf_Context_Type;
+                                    Gen : VhpiHandleT)
+                                   return Boolean
+   is
+      Gen_Basetype : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("write_td_delay_generic: vhpiBaseType");
+         return False;
+      end if;
+      if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01) then
+         case Context.Timing_Nbr is
+            when 1 =>
+               return Write_Td_Delay_Generic (Context, Gen, 2, Map_1);
+            when 2 =>
+               return Write_Td_Delay_Generic (Context, Gen, 2, Map_2);
+            when others =>
+               Errors.Error
+                 ("timing generic type mismatch SDF timing specification");
+         end case;
+      elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z) then
+         case Context.Timing_Nbr is
+            when 1 =>
+               return Write_Td_Delay_Generic (Context, Gen, 6, Map_1);
+            when 2 =>
+               return Write_Td_Delay_Generic (Context, Gen, 6, Map_2);
+            when 3 =>
+               return Write_Td_Delay_Generic (Context, Gen, 6, Map_3);
+            when 6 =>
+               return Write_Td_Delay_Generic (Context, Gen, 6, Map_6);
+            when others =>
+               Errors.Error
+                 ("timing generic type mismatch SDF timing specification");
+         end case;
+      elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType) then
+         if Vhpi_Put_Value (Gen, Context.Timing (1) * 1000) /= AvhpiErrorOk
+         then
+            Internal_Error ("vhpi_put_value (vitaldelaytype)");
+         else
+            return True;
+         end if;
+      else
+         Internal_Error ("write_td_delay_generic: unhandled generic type");
+      end if;
+   end Write_Td_Delay_Generic;
+
+   procedure Generic_Get_Bounds (Port : VhpiHandleT;
+                                 Left : out Ghdl_I32;
+                                 Len : out Ghdl_Index_Type;
+                                 Up : out Boolean)
+   is
+      Port_Type, Port_Range : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Right : VhpiIntT;
+   begin
+      Vhpi_Handle (VhpiSubtype, Port, Port_Type, Error);
+      Left := 0;
+      Len := 0;
+      Up := True;
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiSubtype - port");
+         return;
+      end if;
+      Vhpi_Handle_By_Index (VhpiConstraints, Port_Type, 1, Port_Range, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIndexConstraints - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiLeftBoundP, Port_Range, Left, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiLeftBoundP - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiRightBoundP, Port_Range, Right, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiRightBoundP - port");
+         return;
+      end if;
+      Vhpi_Get (VhpiIsUpP, Port_Range, Up, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIsUpP - port");
+         return;
+      end if;
+      if Up then
+         Len := Ghdl_Index_Type (Right - Left) + 1;
+      else
+         Len := Ghdl_Index_Type (Left - Right) + 1;
+      end if;
+   end Generic_Get_Bounds;
+
+   procedure Sdf_Generic (Context : in out Sdf_Context_Type;
+                          Name : String;
+                          Ok : out Boolean)
+   is
+      Gen : VhpiHandleT;
+      Gen_Basetype : VhpiHandleT;
+      Port1, Port2 : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      if Flag_Dump then
+         Put ("generic: ");
+         Put (Name);
+         if Context.Timing_Nbr = 0 then
+            Put (' ');
+            Put_I64 (stdout, Context.Timing (1));
+         else
+            for I in 1 .. 12 loop
+               Put (' ');
+               if Context.Timing_Set (I) then
+                  Put_I64 (stdout, Context.Timing (I));
+               else
+                  Put ('?');
+               end if;
+            end loop;
+         end if;
+
+         New_Line;
+         Ok := True;
+         return;
+      end if;
+
+      Ok := False;
+
+      if Context.Port_Num = 1 then
+         Context.Ports (2).Name_Len := 0;
+      end if;
+      Find_Generic
+        (Name, Gen,
+         Context.Ports (1).Name (1 .. Context.Ports (1).Name_Len), Port1,
+         Context.Ports (2).Name (1 .. Context.Ports (2).Name_Len), Port2);
+      if Vhpi_Get_Kind (Gen) = VhpiUndefined
+        or else Vhpi_Get_Kind (Port1) = VhpiUndefined
+        or else (Context.Port_Num = 2
+                 and then Vhpi_Get_Kind (Port2) = VhpiUndefined)
+      then
+         return;
+      end if;
+
+      --  Extract subtype.
+      Vhpi_Handle (VhpiBaseType, Gen, Gen_Basetype, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiBaseType");
+         return;
+      end if;
+      if Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01)
+        or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01Z)
+        or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayType01ZX)
+      then
+         Ok := Write_Td_Delay_Generic (Context, Gen);
+      elsif Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType01)
+        or else Vhpi_Compare_Handles (Gen_Basetype, VitalDelayArrayType)
+      then
+         declare
+            Left_Gen, Left1, Left2 : Ghdl_I32;
+            Len_Gen, Len1, Len2 : Ghdl_Index_Type;
+            Up_Gen, Up1, Up2 : Boolean;
+            Pos : Ghdl_Index_Type;
+            Gen_El : VhpiHandleT;
+         begin
+            Generic_Get_Bounds (Gen, Left_Gen, Len_Gen, Up_Gen);
+            if Context.Port_Num >= 1
+              and then Context.Ports (1).L /= Invalid_Dnumber
+            then
+               Generic_Get_Bounds (Port1, Left1, Len1, Up1);
+               if Up1 then
+                  Pos := Ghdl_Index_Type (Context.Ports (1).L - Left1);
+               else
+                  Pos := Ghdl_Index_Type (Left1 - Context.Ports (1).L);
+               end if;
+            else
+               Pos := 0;
+            end if;
+            if Context.Port_Num >= 2
+              and then Context.Ports (2).L /= Invalid_Dnumber
+            then
+               Generic_Get_Bounds (Port2, Left2, Len2, Up2);
+               Pos := Pos * Len2;
+               if Up2 then
+                  Pos := Pos + Ghdl_Index_Type (Context.Ports (2).L - Left2);
+               else
+                  Pos := Pos + Ghdl_Index_Type (Left2 - Context.Ports (2).L);
+               end if;
+            end if;
+            Vhpi_Handle_By_Index
+              (VhpiIndexedNames, Gen, Integer (Pos), Gen_El, Error);
+            if Error /= AvhpiErrorOk then
+               Internal_Error ("vhpiIndexedNames - gen_el");
+               return;
+            end if;
+            Ok := Write_Td_Delay_Generic (Context, Gen_El);
+         end;
+      else
+         Errors.Error_C ("vital: unhandled generic type for generic ");
+         Errors.Error_E (Name);
+      end if;
+   end Sdf_Generic;
+
+
+   procedure Annotate (Arg : String)
+   is
+      S, E : Natural;
+      Ok : Boolean;
+   begin
+      if Flag_Verbose then
+         Put ("sdf annotate: ");
+         Put (Arg);
+         New_Line;
+      end if;
+
+      --  Find scope by name.
+      Get_Root_Inst (Sdf_Top);
+      E := Arg'First;
+      S := E;
+      L1: loop
+         --  Skip path separator.
+         while Arg (E) = '/' or Arg (E) = '.' loop
+            E := E + 1;
+            exit L1 when E > Arg'Last;
+         end loop;
+
+         exit L1 when E > Arg'Last or else Arg (E) = '=';
+
+         --  Instance element.
+         S := E;
+         while Arg (E) /= '=' and Arg (E) /= '.' and Arg (E) /= '/' loop
+            E := E + 1;
+            exit L1 when E > Arg'Last;
+         end loop;
+
+         --  Path element.
+         if E - 1 >= S then
+            Find_Instance (Sdf_Top, Sdf_Top, Arg (S .. E - 1), Ok);
+            if not Ok then
+               Error_C ("cannot find instance '");
+               Error_C (Arg (S .. E - 1));
+               Error_E ("' for sdf annotation");
+               return;
+            end if;
+         end if;
+      end loop L1;
+
+      --  start annotation.
+      if E >= Arg'Last or else Arg (E) /= '=' then
+         Error_C ("no filename in sdf option '");
+         Error_C (Arg);
+         Error_E ("'");
+         return;
+      end if;
+      if not Sdf.Parse_Sdf_File (Arg (E + 1 .. Arg'Last)) then
+         null;
+      end if;
+   end Annotate;
+
+   procedure Extract_Vital_Delay_Type
+   is
+      It : VhpiHandleT;
+      Pkg : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Basetype : VhpiHandleT;
+      Status : AvhpiErrorT;
+   begin
+      Get_Package_Inst (It);
+      loop
+         Vhpi_Scan (It, Pkg, Status);
+         exit when Status /= AvhpiErrorOk;
+         exit when Name_Compare (Pkg, "vital_timing")
+           and then Name_Compare (Pkg, "ieee", VhpiLibLogicalNameP);
+      end loop;
+      if Status /= AvhpiErrorOk then
+         Error ("package ieee.vital_timing not found, SDF annotation aborted");
+         return;
+      end if;
+      Vhpi_Iterator (VhpiDecls, Pkg, It, Status);
+      if Status /= AvhpiErrorOk then
+         Error ("cannot iterate on vital_timing");
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Decl, Status);
+         exit when Status /= AvhpiErrorOk;
+         if Vhpi_Get_Kind (Decl) = VhpiSubtypeDeclK
+           or else Vhpi_Get_Kind (Decl) = VhpiArrayTypeDeclK
+         then
+            Vhpi_Handle (VhpiBaseType, Decl, Basetype, Status);
+            if Status = AvhpiErrorOk then
+               if Name_Compare (Decl, "vitaldelaytype01") then
+                  VitalDelayType01 := Basetype;
+               elsif Name_Compare (Decl, "vitaldelaytype01z") then
+                  VitalDelayType01Z := Basetype;
+               elsif Name_Compare (Decl, "vitaldelaytype01zx") then
+                  VitalDelayType01ZX := Basetype;
+               elsif Name_Compare (Decl, "vitaldelayarraytype01") then
+                  VitalDelayArrayType01 := Basetype;
+               elsif Name_Compare (Decl, "vitaldelaytype") then
+                  VitalDelayType := Basetype;
+               elsif Name_Compare (Decl, "vitaldelayarraytype") then
+                  VitalDelayArrayType := Basetype;
+               end if;
+            end if;
+         end if;
+      end loop;
+      if Vhpi_Get_Kind (VitalDelayType01) = VhpiUndefined then
+         Error ("cannot find VitalDelayType01 in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayType01Z) = VhpiUndefined then
+         Error ("cannot find VitalDelayType01Z in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayType01ZX) = VhpiUndefined then
+         Error ("cannot find VitalDelayType01ZX in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayArrayType01) = VhpiUndefined then
+         Error ("cannot find VitalDelayArrayType01 in ieee.vital_timing");
+         return;
+      end if;
+      if Vhpi_Get_Kind (VitalDelayType) = VhpiUndefined then
+         Error ("cannot find VitalDelayType in ieee.vital_timing");
+         return;
+      end if;
+   end Extract_Vital_Delay_Type;
+
+   Has_Sdf_Option : Boolean := False;
+
+   procedure Sdf_Start
+   is
+      use Grt.Options;
+      Len : Integer;
+      Beg : Integer;
+      Arg : Ghdl_C_String;
+   begin
+      if not Has_Sdf_Option then
+         --  Nothing to do.
+         return;
+      end if;
+      Flag_Dump := False;
+
+      --  Extract VitalDelayType(s) from VITAL_Timing package.
+      Extract_Vital_Delay_Type;
+
+      --  Annotate.
+      for I in 1 .. Last_Opt loop
+         Arg := Argv (I);
+         Len := strlen (Arg);
+         if Len > 5 and then Arg (1 .. 6) = "--sdf=" then
+            Sdf_Mtm := Typical;
+            Beg := 7;
+            if Len > 10 then
+               if Arg (7 .. 10) = "typ=" then
+                  Beg := 11;
+               elsif Arg (7 .. 10) = "min=" then
+                  Sdf_Mtm := Minimum;
+                  Beg := 11;
+               elsif Arg (7 .. 10) = "max=" then
+                  Sdf_Mtm := Maximum;
+                  Beg := 11;
+               end if;
+            end if;
+            Annotate (Arg (Beg .. Len));
+         end if;
+      end loop;
+   end Sdf_Start;
+
+   function Sdf_Option (Option : String) return Boolean
+   is
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      if Opt'Length > 11 and then Opt (1 .. 11) = "--sdf-dump=" then
+         Flag_Dump := True;
+         if Sdf.Parse_Sdf_File (Opt (12 .. Opt'Last)) then
+            null;
+         end if;
+         return True;
+      end if;
+      if Opt'Length > 5 and then Opt (1 .. 6) = "--sdf=" then
+         Has_Sdf_Option := True;
+         return True;
+      else
+         return False;
+      end if;
+   end Sdf_Option;
+
+   procedure Sdf_Help is
+   begin
+      Put_Line (" --sdf=[min=|typ=|max=]TOP=FILENAME");
+      Put_Line ("    annotate TOP with SDF delay file FILENAME");
+   end Sdf_Help;
+
+   Sdf_Hooks : aliased constant Hooks_Type :=
+     (Option => Sdf_Option'Access,
+      Help => Sdf_Help'Access,
+      Init => Proc_Hook_Nil'Access,
+      Start => Sdf_Start'Access,
+      Finish => Proc_Hook_Nil'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Sdf_Hooks'Access);
+   end Register;
+end Grt.Vital_Annotate;
diff --git a/src/translate/grt/grt-vital_annotate.ads b/src/translate/grt/grt-vital_annotate.ads
new file mode 100644
index 000000000..acf82bba2
--- /dev/null
+++ b/src/translate/grt/grt-vital_annotate.ads
@@ -0,0 +1,42 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Sdf; use Grt.Sdf;
+
+package Grt.Vital_Annotate is
+   pragma Elaborate_Body (Grt.Vital_Annotate);
+
+   procedure Sdf_Header (Context : Sdf_Context_Type);
+   procedure Sdf_Celltype (Context : Sdf_Context_Type);
+   procedure Sdf_Instance (Context : in out Sdf_Context_Type;
+                           Instance : String;
+                           Status : out Boolean);
+   procedure Sdf_Instance_End (Context : Sdf_Context_Type;
+                               Status : out Boolean);
+   procedure Sdf_Generic (Context : in out Sdf_Context_Type;
+                          Name : String;
+                          Ok : out Boolean);
+
+   procedure Register;
+end Grt.Vital_Annotate;
diff --git a/src/translate/grt/grt-vpi.adb b/src/translate/grt/grt-vpi.adb
new file mode 100644
index 000000000..9b77319f1
--- /dev/null
+++ b/src/translate/grt/grt-vpi.adb
@@ -0,0 +1,988 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002 - 2014 Tristan Gingold & Felix Bertram
+--
+--  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.
+
+-- Description: VPI interface for GRT runtime
+--              the main purpose of this code is to interface with the
+--              Icarus Verilog Interactive (IVI) simulator GUI
+
+-------------------------------------------------------------------------------
+-- TODO:
+-------------------------------------------------------------------------------
+-- DONE:
+-- * The GHDL VPI implementation doesn't support time
+--   callbacks (cbReadOnlySynch). This is needed to support
+--   IVI run. Currently, the GHDL simulation runs until
+--   complete once a single 'run' is performed...
+-- * You are loading '_'-prefixed symbols when you
+--   load the vpi plugin. On Linux, there is no leading
+--   '_'. I just added code to try both '_'-prefixed and
+--   non-'_'-prefixed symbols. I have placed the changed
+--   file in the same download dir as the snapshot
+-- * I did find out why restart doesn't work for GHDL.
+--   You are passing back the leaf name of signals when the
+--   FullName is requested.
+-------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
+with Grt.Signals; use Grt.Signals;
+with Grt.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Vcd; use Grt.Vcd;
+with Grt.Errors; use Grt.Errors;
+with Grt.Rtis_Types;
+pragma Elaborate_All (Grt.Table);
+
+package body Grt.Vpi is
+   --  The VPI interface requires libdl (dlopen, dlsym) to be linked in.
+   --  This is now set in Makefile, since this is target dependent.
+   --  pragma Linker_Options ("-ldl");
+
+   --errAnyString:     constant String := "grt-vcd.adb: any string" & NUL;
+   --errNoString:      constant String := "grt-vcd.adb: no string" & NUL;
+
+   type Vpi_Index_Type is new Integer;
+
+-------------------------------------------------------------------------------
+-- * * *   h e l p e r s   * * * * * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   ------------------------------------------------------------------------
+   -- debugging helpers
+   procedure dbgPut (Str : String)
+   is
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stderr);
+   end dbgPut;
+
+   procedure dbgPut (C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := fputc (Character'Pos (C), stderr);
+   end dbgPut;
+
+   procedure dbgNew_Line is
+   begin
+      dbgPut (Nl);
+   end dbgNew_Line;
+
+   procedure dbgPut_Line (Str : String)
+   is
+   begin
+      dbgPut (Str);
+      dbgNew_Line;
+   end dbgPut_Line;
+
+--    procedure dbgPut_Line (Str : Ghdl_Str_Len_Type)
+--    is
+--    begin
+--       Put_Str_Len(stderr, Str);
+--       dbgNew_Line;
+--    end dbgPut_Line;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => vpiHandle, Object => struct_vpiHandle);
+
+   ------------------------------------------------------------------------
+   -- NUL-terminate strings.
+   -- note: there are several buffers
+   -- see IEEE 1364-2001
+--   tmpstring1: string(1..1024);
+--    function NulTerminate1 (Str : Ghdl_Str_Len_Type) return Ghdl_C_String
+--    is
+--    begin
+--       for i in 1..Str.Len loop
+--          tmpstring1(i):= Str.Str(i);
+--       end loop;
+--       tmpstring1(Str.Len+1):= NUL;
+--       return To_Ghdl_C_String (tmpstring1'Address);
+--    end NulTerminate1;
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   f u n c t i o n s   * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
+   -- Obtain an iterator handle to objects with a one-to-many relationship.
+   -- see IEEE 1364-2001, page 685
+   function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle
+   is
+      Res : vpiHandle;
+      Rel : VhpiOneToManyT;
+      Error : AvhpiErrorT;
+   begin
+      --dbgPut_Line ("vpi_iterate");
+
+      case aType is
+         when vpiNet =>
+            Rel := VhpiDecls;
+         when vpiModule =>
+            if Ref = null then
+               Res := new struct_vpiHandle (vpiModule);
+               Get_Root_Inst (Res.Ref);
+               return Res;
+            else
+               Rel := VhpiInternalRegions;
+            end if;
+         when vpiInternalScope =>
+            Rel := VhpiInternalRegions;
+         when others =>
+            return null;
+      end case;
+
+      -- find the proper start object for our scan
+      if Ref = null then
+         return null;
+      end if;
+
+      Res := new struct_vpiHandle (aType);
+      Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error);
+
+      if Error /= AvhpiErrorOk then
+         Free (Res);
+      end if;
+      return Res;
+   end vpi_iterate;
+
+   ------------------------------------------------------------------------
+   -- int vpi_get(int property, vpiHandle ref)
+   -- Get the value of an integer or boolean property of an object.
+   -- see IEEE 1364-2001, chapter 27.6, page 667
+--    function ii_vpi_get_type (aRef: Ghdl_Instance_Name_Acc) return Integer
+--    is
+--    begin
+--       case aRef.Kind is
+--          when Ghdl_Name_Entity
+--            | Ghdl_Name_Architecture
+--            | Ghdl_Name_Block
+--            | Ghdl_Name_Generate_Iterative
+--            | Ghdl_Name_Generate_Conditional
+--            | Ghdl_Name_Instance =>
+--             return vpiModule;
+--          when Ghdl_Name_Signal =>
+--             return vpiNet;
+--          when others =>
+--             return vpiUndefined;
+--       end case;
+--    end ii_vpi_get_type;
+
+   function vpi_get (Property: integer; Ref: vpiHandle) return Integer
+   is
+   begin
+      case Property is
+         when vpiType=>
+            return Ref.mType;
+         when vpiTimePrecision=>
+            return -9; -- is this nano-seconds?
+         when others=>
+            dbgPut_Line ("vpi_get: unknown property");
+            return 0;
+      end case;
+   end vpi_get;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_scan(vpiHandle iter)
+   -- Scan the Verilog HDL hierarchy for objects with a one-to-many
+   -- relationship.
+   -- see IEEE 1364-2001, chapter 27.36, page 709
+   function vpi_scan (Iter: vpiHandle) return vpiHandle
+   is
+      Res : VhpiHandleT;
+      Error : AvhpiErrorT;
+      R : vpiHandle;
+   begin
+      --dbgPut_Line ("vpi_scan");
+      if Iter = null then
+         return null;
+      end if;
+
+      --  There is only one top-level module.
+      if Iter.mType = vpiModule then
+         case Vhpi_Get_Kind (Iter.Ref) is
+            when VhpiRootInstK =>
+               R := new struct_vpiHandle (Iter.mType);
+               R.Ref := Iter.Ref;
+               Iter.Ref := Null_Handle;
+               return R;
+            when VhpiUndefined =>
+               return null;
+            when others =>
+               --  Fall through.
+               null;
+         end case;
+      end if;
+
+      loop
+         Vhpi_Scan (Iter.Ref, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+
+         case Vhpi_Get_Kind (Res) is
+            when VhpiEntityDeclK
+              | VhpiArchBodyK
+              | VhpiBlockStmtK
+              | VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiCompInstStmtK =>
+               case Iter.mType is
+                  when vpiInternalScope
+                    | vpiModule =>
+                     return new struct_vpiHandle'(mType => vpiModule,
+                                                  Ref => Res);
+                  when others =>
+                     null;
+               end case;
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               if Iter.mType = vpiNet then
+                  declare
+                     Info : Verilog_Wire_Info;
+                  begin
+                     Get_Verilog_Wire (Res, Info);
+                     if Info.Kind /= Vcd_Bad then
+                        return new struct_vpiHandle'(mType => vpiNet,
+                                                     Ref => Res);
+                     end if;
+                  end;
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+      return null;
+   end vpi_scan;
+
+   ------------------------------------------------------------------------
+   -- char *vpi_get_str(int property, vpiHandle ref)
+   -- see IEEE 1364-2001, page xxx
+   Tmpstring2 : String (1 .. 1024);
+   function vpi_get_str (Property : Integer; Ref : vpiHandle)
+                        return Ghdl_C_String
+   is
+      Prop : VhpiStrPropertyT;
+      Len : Natural;
+   begin
+      --dbgPut_Line ("vpiGetStr");
+
+      if Ref = null then
+         return null;
+      end if;
+
+      case Property is
+         when vpiFullName=>
+            Prop := VhpiFullNameP;
+         when vpiName=>
+            Prop := VhpiNameP;
+         when others=>
+            dbgPut_Line ("vpi_get_str: undefined property");
+            return null;
+      end case;
+      Vhpi_Get_Str (Prop, Ref.Ref, Tmpstring2, Len);
+      Tmpstring2 (Len + 1) := NUL;
+      if Property = vpiFullName then
+         for I in Tmpstring2'First .. Len loop
+            if Tmpstring2 (I) = ':' then
+               Tmpstring2 (I) := '.';
+            end if;
+         end loop;
+         --  Remove the initial '.'.
+         return To_Ghdl_C_String (Tmpstring2 (2)'Address);
+      else
+         return To_Ghdl_C_String (Tmpstring2'Address);
+      end if;
+   end vpi_get_str;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
+   -- Obtain a handle to an object with a one-to-one relationship.
+   -- see IEEE 1364-2001, chapter 27.16, page 682
+   function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle
+   is
+      Res : vpiHandle;
+   begin
+      --dbgPut_Line ("vpi_handle");
+
+      if Ref = null then
+         return null;
+      end if;
+
+      case aType is
+         when vpiScope =>
+            case Ref.mType is
+               when vpiModule =>
+                  Res := new struct_vpiHandle (vpiScope);
+                  Res.Ref := Ref.Ref;
+                  return Res;
+               when others =>
+                  return null;
+            end case;
+         when vpiRightRange
+           | vpiLeftRange =>
+            case Ref.mType is
+               when vpiNet =>
+                  Res := new struct_vpiHandle (aType);
+                  Res.Ref := Ref.Ref;
+                  return Res;
+               when others =>
+                  return null;
+            end case;
+         when others =>
+            return null;
+      end case;
+   end vpi_handle;
+
+   ------------------------------------------------------------------------
+   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
+   -- Retrieve the simulation value of an object.
+   -- see IEEE 1364-2001, chapter 27.14, page 675
+   Tmpstring3idx : integer;
+   Tmpstring3 : String (1 .. 1024);
+   procedure ii_vpi_get_value_bin_str_B1 (Val : Ghdl_B1)
+   is
+   begin
+      case Val is
+         when True =>
+            Tmpstring3 (Tmpstring3idx) := '1';
+         when False =>
+            Tmpstring3 (Tmpstring3idx) := '0';
+      end case;
+      Tmpstring3idx := Tmpstring3idx + 1;
+   end ii_vpi_get_value_bin_str_B1;
+
+   procedure ii_vpi_get_value_bin_str_E8 (Val : Ghdl_E8)
+   is
+      type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character;
+      Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-";
+   begin
+      if Val not in Map_Type_E8'range then
+         Tmpstring3 (Tmpstring3idx) := '?';
+      else
+         Tmpstring3 (Tmpstring3idx) := Map_Std_E8(Val);
+      end if;
+      Tmpstring3idx := Tmpstring3idx + 1;
+   end ii_vpi_get_value_bin_str_E8;
+
+   function ii_vpi_get_value_bin_str (Obj : VhpiHandleT)
+                                     return Ghdl_C_String
+   is
+      Info : Verilog_Wire_Info;
+      Len : Ghdl_Index_Type;
+   begin
+      case Vhpi_Get_Kind (Obj) is
+         when VhpiPortDeclK
+           | VhpiSigDeclK =>
+            null;
+         when others =>
+            return null;
+      end case;
+
+      --  Get verilog compat info.
+      Get_Verilog_Wire (Obj, Info);
+      if Info.Kind = Vcd_Bad then
+         return null;
+      end if;
+
+      if Info.Irange = null then
+         Len := 1;
+      else
+         Len := Info.Irange.I32.Len;
+      end if;
+
+      Tmpstring3idx := 1; -- reset string buffer
+
+      case Info.Val is
+         when Vcd_Effective =>
+            case Info.Kind is
+               when Vcd_Bad
+                 | Vcd_Integer32
+                 | Vcd_Float64 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B1
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B1);
+                  end loop;
+               when Vcd_Stdlogic
+                 | Vcd_Stdlogic_Vector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_E8
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.E8);
+                  end loop;
+            end case;
+         when Vcd_Driving =>
+            case Info.Kind is
+               when Vcd_Bad
+                 | Vcd_Integer32
+                 | Vcd_Float64 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B1
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B1);
+                  end loop;
+               when Vcd_Stdlogic
+                 | Vcd_Stdlogic_Vector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_E8
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.E8);
+                  end loop;
+            end case;
+      end case;
+      Tmpstring3 (Tmpstring3idx) := NUL;
+      return To_Ghdl_C_String (Tmpstring3'Address);
+   end ii_vpi_get_value_bin_str;
+
+   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value)
+   is
+   begin
+      case Value.Format is
+         when vpiObjTypeVal=>
+            -- fill in the object type and value:
+            -- For an integer, vpiIntVal
+            -- For a real, vpiRealVal
+            -- For a scalar, either vpiScalar or vpiStrength
+            -- For a time variable, vpiTimeVal with vpiSimTime
+            -- For a vector, vpiVectorVal
+            dbgPut_Line ("vpi_get_value: vpiObjTypeVal");
+         when vpiBinStrVal=>
+            Value.Str := ii_vpi_get_value_bin_str (Expr.Ref);
+            --aValue.mStr := NulTerminate2(aExpr.mRef.Name.all);
+         when vpiOctStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiOctStrVal");
+         when vpiDecStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiDecStrVal");
+         when vpiHexStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiHexStrVal");
+         when vpiScalarVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiScalarVal");
+         when vpiIntVal=>
+            case Expr.mType is
+               when vpiLeftRange
+                 | vpiRightRange=>
+                  declare
+                     Info : Verilog_Wire_Info;
+                  begin
+                     Get_Verilog_Wire (Expr.Ref, Info);
+                     if Info.Irange /= null then
+                        if Expr.mType = vpiLeftRange then
+                           Value.Integer_m := Integer (Info.Irange.I32.Left);
+                        else
+                           Value.Integer_m := Integer (Info.Irange.I32.Right);
+                        end if;
+                     else
+                        Value.Integer_m  := 0;
+                     end if;
+                  end;
+               when others=>
+                  dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType");
+            end case;
+         when vpiRealVal=>     dbgPut_Line("vpi_get_value: vpiRealVal");
+         when vpiStringVal=>   dbgPut_Line("vpi_get_value: vpiStringVal");
+         when vpiTimeVal=>     dbgPut_Line("vpi_get_value: vpiTimeVal");
+         when vpiVectorVal=>   dbgPut_Line("vpi_get_value: vpiVectorVal");
+         when vpiStrengthVal=> dbgPut_Line("vpi_get_value: vpiStrengthVal");
+         when others=>         dbgPut_Line("vpi_get_value: unknown mFormat");
+      end case;
+   end vpi_get_value;
+
+   ------------------------------------------------------------------------
+   -- void  vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
+   --                               p_vpi_time when, int flags)
+   -- Alter the simulation value of an object.
+   -- see IEEE 1364-2001, chapter 27.14, page 675
+   -- FIXME
+
+   procedure ii_vpi_put_value_bin_str_B1 (SigPtr : Ghdl_Signal_Ptr;
+                                          Value : Character)
+   is
+      Tempval : Value_Union;
+   begin
+      -- use the Set_Effective_Value procedure to update the signal
+      case Value is
+         when '0' =>
+            Tempval.B1 := false;
+         when '1' =>
+            Tempval.B1 := true;
+         when others =>
+            dbgPut_Line("ii_vpi_put_value_bin_str_B1: "
+                        & "wrong character - signal wont be set");
+            return;
+      end case;
+      SigPtr.Driving_Value := Tempval;
+      Set_Effective_Value (SigPtr, Tempval);
+   end ii_vpi_put_value_bin_str_B1;
+
+   procedure ii_vpi_put_value_bin_str_E8 (SigPtr : Ghdl_Signal_Ptr;
+                                          Value : Character)
+   is
+      Tempval : Value_Union;
+   begin
+      case Value is
+         when 'U' =>
+            Tempval.E8 := 0;
+         when 'X' =>
+            Tempval.E8 := 1;
+         when '0' =>
+            Tempval.E8 := 2;
+         when '1' =>
+            Tempval.E8 := 3;
+         when 'Z' =>
+            Tempval.E8 := 4;
+         when 'W' =>
+            Tempval.E8 := 5;
+         when 'L' =>
+            Tempval.E8 := 6;
+         when 'H' =>
+            Tempval.E8 := 7;
+         when '-' =>
+            Tempval.E8 := 8;
+         when others =>
+            dbgPut_Line("ii_vpi_put_value_bin_str_B8: "
+                        & "wrong character - signal wont be set");
+            return;
+      end case;
+      SigPtr.Driving_Value := Tempval;
+      Set_Effective_Value (SigPtr, Tempval);
+   end ii_vpi_put_value_bin_str_E8;
+
+
+   procedure ii_vpi_put_value_bin_str(Obj : VhpiHandleT;
+                                      ValueStr : Ghdl_C_String)
+   is
+      Info : Verilog_Wire_Info;
+      Len  : Ghdl_Index_Type;
+   begin
+      -- Check the Obj type.
+      -- * The vpiHandle has a reference (field Ref) to a VhpiHandleT
+      --   when it doesnt come from a callback.
+      case Vhpi_Get_Kind(Obj) is
+         when VhpiPortDeclK
+           | VhpiSigDeclK =>
+            null;
+         when others =>
+            return;
+      end case;
+
+      -- The following code segment was copied from the
+      -- ii_vpi_get_value function.
+      --  Get verilog compat info.
+      Get_Verilog_Wire (Obj, Info);
+      if Info.Kind = Vcd_Bad then
+         return;
+      end if;
+
+      if Info.Irange = null then
+         Len := 1;
+      else
+         Len := Info.Irange.I32.Len;
+      end if;
+
+      -- Step 1: convert vpi object to internal format.
+      --         p_vpi_handle -> Ghdl_Signal_Ptr
+      --         To_Signal_Arr_Ptr (Info.Addr) does part of the magic
+
+      -- Step 2: convert datum to appropriate type.
+      --         Ghdl_C_String -> Value_Union
+
+      -- Step 3: assigns value to object using Set_Effective_Value
+      --         call (from grt-signals)
+      -- Set_Effective_Value(sig_ptr, conv_value);
+
+
+      -- Took the skeleton from ii_vpi_get_value function
+      -- This point of the function must convert the string value to the
+      -- native ghdl format.
+      case Info.Kind is
+         when Vcd_Bad =>
+            return;
+         when Vcd_Bit
+           | Vcd_Bool
+           | Vcd_Bitvector =>
+            for J in 0 .. Len - 1 loop
+               ii_vpi_put_value_bin_str_B1(
+                  To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1)));
+            end loop;
+         when Vcd_Stdlogic
+           | Vcd_Stdlogic_Vector =>
+            for J in 0 .. Len - 1 loop
+               ii_vpi_put_value_bin_str_E8(
+                  To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1)));
+            end loop;
+         when Vcd_Integer32
+           | Vcd_Float64 =>
+            null;
+      end case;
+
+      -- Always return null, because this simulation kernel cannot send
+      -- a handle to the event back.
+      return;
+   end ii_vpi_put_value_bin_str;
+
+
+   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
+   --                         p_vpi_time when, int flags)
+   function vpi_put_value (aObj: vpiHandle;
+                           aValue: p_vpi_value;
+                           aWhen: p_vpi_time;
+                           aFlags: integer)
+                         return vpiHandle
+   is
+      pragma Unreferenced (aWhen);
+      pragma Unreferenced (aFlags);
+   begin
+      -- A very simple write procedure for VPI.
+      -- Basically, it accepts bin_str values and converts to appropriate
+      -- types (only std_logic and bit values and vectors).
+
+      -- It'll use Set_Effective_Value procedure to update signals
+
+      -- Ignoring aWhen and aFlags, for now.
+
+      -- Checks the format of aValue. Only vpiBinStrVal will be accepted
+      --  for now.
+      case aValue.Format is
+         when vpiObjTypeVal =>
+            dbgPut_Line ("vpi_put_value: vpiObjTypeVal");
+         when vpiBinStrVal =>
+            ii_vpi_put_value_bin_str(aObj.Ref, aValue.Str);
+            -- dbgPut_Line ("vpi_put_value: vpiBinStrVal");
+         when vpiOctStrVal =>
+            dbgPut_Line ("vpi_put_value: vpiNet, vpiOctStrVal");
+         when vpiDecStrVal =>
+            dbgPut_Line ("vpi_put_value: vpiNet, vpiDecStrVal");
+         when vpiHexStrVal =>
+            dbgPut_Line ("vpi_put_value: vpiNet, vpiHexStrVal");
+         when vpiScalarVal =>
+            dbgPut_Line ("vpi_put_value: vpiNet, vpiScalarVal");
+         when vpiIntVal =>
+            dbgPut_Line ("vpi_put_value: vpiIntVal");
+         when vpiRealVal =>
+            dbgPut_Line("vpi_put_value: vpiRealVal");
+         when vpiStringVal =>
+            dbgPut_Line("vpi_put_value: vpiStringVal");
+         when vpiTimeVal =>
+            dbgPut_Line("vpi_put_value: vpiTimeVal");
+         when vpiVectorVal =>
+            dbgPut_Line("vpi_put_value: vpiVectorVal");
+         when vpiStrengthVal =>
+            dbgPut_Line("vpi_put_value: vpiStrengthVal");
+         when others =>
+            dbgPut_Line("vpi_put_value: unknown mFormat");
+      end case;
+
+      -- Must return a scheduled event caused by vpi_put_value()
+      -- Still dont know how to do it.
+      return null;
+   end vpi_put_value;
+
+   ------------------------------------------------------------------------
+   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
+   -- see IEEE 1364-2001, page xxx
+   Sim_Time : Std_Time;
+   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time)
+   is
+      pragma Unreferenced (Obj);
+   begin
+      --dbgPut_Line ("vpi_get_time");
+      Time.mType := vpiSimTime;
+      Time.mHigh := 0;
+      Time.mLow  := Integer (Sim_Time / 1000000);
+      Time.mReal := 0.0;
+   end vpi_get_time;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle vpi_register_cb(p_cb_data data)
+   g_cbEndOfCompile : p_cb_data;
+   g_cbEndOfSimulation: p_cb_data;
+   --g_cbValueChange:     s_cb_data;
+   g_cbReadOnlySync:    p_cb_data;
+
+   type Vpi_Var_Type is record
+      Info : Verilog_Wire_Info;
+      Cb   : s_cb_data;
+   end record;
+
+   package Vpi_Table is new Grt.Table
+     (Table_Component_Type => Vpi_Var_Type,
+      Table_Index_Type     => Vpi_Index_Type,
+      Table_Low_Bound      => 0,
+      Table_Initial        => 32);
+
+   function vpi_register_cb (Data : p_cb_data) return vpiHandle
+   is
+      Res : p_cb_data := null;
+   begin
+      --dbgPut_Line ("vpi_register_cb");
+      case Data.Reason is
+         when cbEndOfCompile =>
+            Res := new s_cb_data'(Data.all);
+            g_cbEndOfCompile := Res;
+            Sim_Time:= 0;
+         when cbEndOfSimulation =>
+            Res := new s_cb_data'(Data.all);
+            g_cbEndOfSimulation := Res;
+         when cbValueChange =>
+            declare
+               N : Vpi_Index_Type;
+            begin
+               --g_cbValueChange:=     aData.all;
+               Vpi_Table.Increment_Last;
+               N := Vpi_Table.Last;
+               Vpi_Table.Table (N).Cb := Data.all;
+               Get_Verilog_Wire (Data.Obj.Ref, Vpi_Table.Table (N).Info);
+            end;
+         when cbReadOnlySynch=>
+            Res := new s_cb_data'(Data.all);
+            g_cbReadOnlySync := Res;
+         when others=>
+            dbgPut_Line ("vpi_register_cb: unknwon reason");
+      end case;
+      if Res /= null then
+         return new struct_vpiHandle'(mType => vpiCallback,
+                                      Cb => Res);
+      else
+         return null;
+      end if;
+   end vpi_register_cb;
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   -- int vpi_free_object(vpiHandle ref)
+   function vpi_free_object (aRef: vpiHandle) return integer
+   is
+      pragma Unreferenced (aRef);
+   begin
+      return 0;
+   end vpi_free_object;
+
+   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
+   function vpi_get_vlog_info (aVlog_info_p: System.Address) return integer
+   is
+      pragma Unreferenced (aVlog_info_p);
+   begin
+      return 0;
+   end vpi_get_vlog_info;
+
+   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
+   function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer)
+                               return vpiHandle
+   is
+      pragma Unreferenced (aRef);
+      pragma Unreferenced (aIndex);
+   begin
+      return null;
+   end vpi_handle_by_index;
+
+   -- unsigned int vpi_mcd_close(unsigned int mcd)
+   function vpi_mcd_close (Mcd: integer) return integer
+   is
+      pragma Unreferenced (Mcd);
+   begin
+      return 0;
+   end vpi_mcd_close;
+
+   -- char *vpi_mcd_name(unsigned int mcd)
+   function vpi_mcd_name (Mcd: integer) return integer
+   is
+      pragma Unreferenced (Mcd);
+   begin
+      return 0;
+   end vpi_mcd_name;
+
+   -- unsigned int vpi_mcd_open(char *name)
+   function vpi_mcd_open (Name : Ghdl_C_String) return Integer
+   is
+      pragma Unreferenced (Name);
+   begin
+      return 0;
+   end vpi_mcd_open;
+
+   -- void vpi_register_systf(const struct t_vpi_systf_data*ss)
+   procedure vpi_register_systf(aSs: System.Address)
+   is
+      pragma Unreferenced (aSs);
+   begin
+      null;
+   end vpi_register_systf;
+
+   -- int vpi_remove_cb(vpiHandle ref)
+   function vpi_remove_cb (Ref : vpiHandle) return Integer
+   is
+      pragma Unreferenced (Ref);
+   begin
+      return 0;
+   end vpi_remove_cb;
+
+   -- void vpi_vprintf(const char*fmt, va_list ap)
+   procedure vpi_vprintf (Fmt : Address; Ap : Address)
+   is
+      pragma Unreferenced (Fmt);
+      pragma Unreferenced (Ap);
+   begin
+      null;
+   end vpi_vprintf;
+
+   -- missing here, see grt-cvpi.c:
+   --    vpi_mcd_open_x
+   --    vpi_mcd_vprintf
+   --    vpi_mcd_fputc
+   --    vpi_mcd_fgetc
+   --    vpi_sim_vcontrol
+   --    vpi_chk_error
+   --    pi_handle_by_name
+
+------------------------------------------------------------------------------
+-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
+------------------------------------------------------------------------------
+
+   --  VCD filename.
+   Vpi_Filename : String_Access := null;
+
+   ------------------------------------------------------------------------
+   --  Return TRUE if OPT is an option for VPI.
+   function Vpi_Option (Opt : String) return Boolean
+   is
+      F : constant Natural := Opt'First;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         --  Add an extra NUL character.
+         Vpi_Filename := new String (1 .. Opt'Length - 6 + 1);
+         Vpi_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
+         Vpi_Filename (Vpi_Filename'Last) := NUL;
+         return True;
+      else
+         return False;
+      end if;
+   end Vpi_Option;
+
+   ------------------------------------------------------------------------
+   procedure Vpi_Help is
+   begin
+      Put_Line (" --vpi=FILENAME     load VPI module");
+   end Vpi_Help;
+
+   ------------------------------------------------------------------------
+   --  Called before elaboration.
+
+   -- void loadVpiModule(const char* modulename)
+   function LoadVpiModule (Filename: Address) return Integer;
+   pragma Import (C, LoadVpiModule, "loadVpiModule");
+
+
+   procedure Vpi_Init
+   is
+   begin
+      Sim_Time:= 0;
+
+      --g_cbEndOfCompile.mCb_rtn:= null;
+      --g_cbEndOfSimulation.mCb_rtn:= null;
+      --g_cbValueChange.mCb_rtn:= null;
+
+      if Vpi_Filename /= null then
+         if LoadVpiModule (Vpi_Filename.all'Address) /= 0 then
+            Error ("cannot load VPI module");
+         end if;
+      end if;
+   end Vpi_Init;
+
+   procedure Vpi_Cycle;
+
+   ------------------------------------------------------------------------
+   --  Called after elaboration.
+   procedure Vpi_Start
+   is
+      Res : Integer;
+      pragma Unreferenced (Res);
+   begin
+      if Vpi_Filename = null then
+         return;
+      end if;
+
+      Grt.Rtis_Types.Search_Types_RTI;
+      Register_Cycle_Hook (Vpi_Cycle'Access);
+      if g_cbEndOfCompile /= null then
+         Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile);
+      end if;
+   end Vpi_Start;
+
+   ------------------------------------------------------------------------
+   --  Called before each non delta cycle.
+   procedure Vpi_Cycle
+   is
+      Res : Integer;
+      pragma Unreferenced (Res);
+   begin
+      if g_cbReadOnlySync /= null
+        and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000)
+      then
+         Res := g_cbReadOnlySync.Cb_Rtn.all (g_cbReadOnlySync);
+      end if;
+
+      for I in Vpi_Table.First .. Vpi_Table.Last loop
+         if Verilog_Wire_Changed (Vpi_Table.Table (I).Info, Sim_Time) then
+            Res := Vpi_Table.Table (I).Cb.Cb_Rtn.all
+              (To_p_cb_data (Vpi_Table.Table (I).Cb'Address));
+         end if;
+      end loop;
+
+      if Current_Time /= Std_Time'last then
+         Sim_Time:= Current_Time;
+      end if;
+   end Vpi_Cycle;
+
+   ------------------------------------------------------------------------
+   --  Called at the end of the simulation.
+   procedure Vpi_End
+   is
+      Res : Integer;
+      pragma Unreferenced (Res);
+   begin
+      if g_cbEndOfSimulation /= null then
+         Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation);
+      end if;
+   end Vpi_End;
+
+   Vpi_Hooks : aliased constant Hooks_Type :=
+     (Option => Vpi_Option'Access,
+      Help => Vpi_Help'Access,
+      Init => Vpi_Init'Access,
+      Start => Vpi_Start'Access,
+      Finish => Vpi_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vpi_Hooks'Access);
+   end Register;
+end Grt.Vpi;
diff --git a/src/translate/grt/grt-vpi.ads b/src/translate/grt/grt-vpi.ads
new file mode 100644
index 000000000..86fb07374
--- /dev/null
+++ b/src/translate/grt/grt-vpi.ads
@@ -0,0 +1,252 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002 - 2014 Tristan Gingold & Felix Bertram
+--
+--  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.
+
+-- Description: VPI interface for GRT runtime
+--              the main purpose of this code is to interface with the
+--              Icarus Verilog Interactive (IVI) simulator GUI
+
+with System; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package Grt.Vpi is
+
+   -- properties, see vpi_user.h
+   vpiUndefined:     constant integer := -1;
+   vpiType:          constant integer :=  1;
+   vpiName:          constant integer :=  2;
+   vpiFullName:      constant integer :=  3;
+   vpiTimePrecision: constant integer := 12;
+
+   -- object codes, see vpi_user.h
+   vpiModule:        constant integer := 32;
+   vpiNet:           constant integer := 36;
+   vpiScope:         constant integer := 84;
+   vpiInternalScope: constant integer := 92;
+   vpiLeftRange:     constant integer := 79;
+   vpiRightRange:    constant integer := 83;
+
+   --  Additionnal constants.
+   vpiCallback :     constant Integer := 200;
+
+   -- codes for the format tag of the vpi_value structure
+   vpiBinStrVal:     constant integer :=  1;
+   vpiOctStrVal:     constant integer :=  2;
+   vpiDecStrVal:     constant integer :=  3;
+   vpiHexStrVal:     constant integer :=  4;
+   vpiScalarVal:     constant integer :=  5;
+   vpiIntVal:        constant integer :=  6;
+   vpiRealVal:       constant integer :=  7;
+   vpiStringVal:     constant integer :=  8;
+   vpiVectorVal:     constant integer :=  9;
+   vpiStrengthVal:   constant integer := 10;
+   vpiTimeVal:       constant integer := 11;
+   vpiObjTypeVal:    constant integer := 12;
+   vpiSuppressVal:   constant integer := 13;
+
+   -- codes for type tag of vpi_time structure
+   vpiSimTime:       constant integer :=  2;
+
+   -- codes for the reason tag of cb_data structure
+   cbValueChange:    constant integer:= 1;
+   cbReadOnlySynch:  constant integer:= 7;
+   cbEndOfCompile:   constant integer:= 10;
+   cbEndOfSimulation:constant integer:= 12;
+
+   type struct_vpiHandle (mType : Integer := vpiUndefined);
+   type vpiHandle is access struct_vpiHandle;
+
+   -- typedef struct t_vpi_time {
+   --   int type;
+   --   unsigned int high;
+   --   unsigned int low;
+   --   double real;
+   -- } s_vpi_time, *p_vpi_time;
+   type s_vpi_time is record
+      mType : Integer;
+      mHigh : Integer; -- this should be unsigned
+      mLow :  Integer; -- this should be unsigned
+      mReal : Float;   -- this should be double
+   end record;
+   type p_vpi_time is access s_vpi_time;
+
+   -- typedef struct t_vpi_value
+   -- { int format;
+   --   union
+   --   {       char*str;
+   --           int scalar;
+   --           int integer;
+   --           double real;
+   --           struct t_vpi_time *time;
+   --           struct t_vpi_vecval *vector;
+   --           struct t_vpi_strengthval *strength;
+   --           char*misc;
+   --   } value;
+   -- } s_vpi_value, *p_vpi_value;
+   type s_vpi_value (Format : integer) is record
+      case Format is
+         when vpiBinStrVal
+           | vpiOctStrVal
+           | vpiDecStrVal
+           | vpiHexStrVal
+           | vpiStringVal =>
+            Str : Ghdl_C_String;
+         when vpiScalarVal =>
+            Scalar : Integer;
+         when vpiIntVal =>
+            Integer_m : Integer;
+            --when vpiRealVal=>     null; -- what is the equivalent to double?
+            --when vpiTimeVal=>     mTime:     p_vpi_time;
+            --when vpiVectorVal=>   mVector:   p_vpi_vecval;
+            --when vpiStrengthVal=> mStrength: p_vpi_strengthval;
+         when others =>
+            null;
+         end case;
+      end record;
+   type p_vpi_value is access s_vpi_value;
+
+   --typedef struct t_cb_data {
+   --      int reason;
+   --      int (*cb_rtn)(struct t_cb_data*cb);
+   --      vpiHandle obj;
+   --      p_vpi_time time;
+   --      p_vpi_value value;
+   --      int index;
+   --      char*user_data;
+   --} s_cb_data, *p_cb_data;
+   type s_cb_data;
+
+   type p_cb_data is access all s_cb_data;
+   function To_p_cb_data is new Ada.Unchecked_Conversion
+     (Source => Address, Target => p_cb_data);
+
+   type cb_rtn_type is access function (Cb : p_cb_data) return Integer;
+   pragma Convention (C, cb_rtn_type);
+
+   type s_cb_data is record
+      Reason : Integer;
+      Cb_Rtn : cb_rtn_type;
+      Obj : vpiHandle;
+      Time : p_vpi_time;
+      Value : p_vpi_value;
+      Index : Integer;
+      User_Data : Address;
+   end record;
+
+   type struct_vpiHandle (mType : Integer := vpiUndefined) is record
+      case mType is
+         when vpiCallback =>
+            Cb : p_cb_data;
+         when others =>
+            Ref   : VhpiHandleT;
+      end case;
+   end record;
+
+   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
+   function vpi_iterate (aType : Integer; Ref : vpiHandle) return vpiHandle;
+   pragma Export (C, vpi_iterate, "vpi_iterate");
+
+   -- int vpi_get(int property, vpiHandle ref)
+   function vpi_get (Property : Integer; Ref : vpiHandle) return Integer;
+   pragma Export (C, vpi_get, "vpi_get");
+
+   -- vpiHandle  vpi_scan(vpiHandle iter)
+   function vpi_scan (Iter : vpiHandle) return vpiHandle;
+   pragma Export (C, vpi_scan, "vpi_scan");
+
+   -- char *vpi_get_str(int property, vpiHandle ref)
+   function vpi_get_str (Property : Integer; Ref : vpiHandle)
+                       return Ghdl_C_String;
+   pragma Export (C, vpi_get_str, "vpi_get_str");
+
+   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
+   function vpi_handle (aType: integer; Ref: vpiHandle)
+                       return vpiHandle;
+   pragma Export (C, vpi_handle, "vpi_handle");
+
+   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
+   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value);
+   pragma Export (C, vpi_get_value, "vpi_get_value");
+
+   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
+   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time);
+   pragma Export (C, vpi_get_time, "vpi_get_time");
+
+   -- vpiHandle vpi_register_cb(p_cb_data data)
+   function vpi_register_cb (Data : p_cb_data) return vpiHandle;
+   pragma Export (C, vpi_register_cb, "vpi_register_cb");
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   -- int vpi_free_object(vpiHandle ref)
+   function vpi_free_object(aRef: vpiHandle) return integer;
+   pragma Export (C, vpi_free_object, "vpi_free_object");
+
+   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
+   function vpi_get_vlog_info(aVlog_info_p: System.Address) return integer;
+   pragma Export (C, vpi_get_vlog_info, "vpi_get_vlog_info");
+
+   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
+   function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer)
+                               return vpiHandle;
+   pragma Export (C, vpi_handle_by_index, "vpi_handle_by_index");
+
+   -- unsigned int vpi_mcd_close(unsigned int mcd)
+   function vpi_mcd_close (Mcd : Integer) return Integer;
+   pragma Export (C, vpi_mcd_close, "vpi_mcd_close");
+
+   -- char *vpi_mcd_name(unsigned int mcd)
+   function vpi_mcd_name (Mcd : Integer) return Integer;
+   pragma Export (C, vpi_mcd_name, "vpi_mcd_name");
+
+   -- unsigned int vpi_mcd_open(char *name)
+   function vpi_mcd_open (Name : Ghdl_C_String) return Integer;
+   pragma Export (C, vpi_mcd_open, "vpi_mcd_open");
+
+   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
+   --                         p_vpi_time when, int flags)
+   function vpi_put_value (aObj : vpiHandle;
+                           aValue : p_vpi_value;
+                           aWhen : p_vpi_time;
+                           aFlags : integer)
+                          return vpiHandle;
+   pragma Export (C, vpi_put_value, "vpi_put_value");
+
+   -- void vpi_register_systf(const struct t_vpi_systf_data*ss)
+   procedure vpi_register_systf (aSs : Address);
+   pragma Export (C, vpi_register_systf, "vpi_register_systf");
+
+   -- int vpi_remove_cb(vpiHandle ref)
+   function vpi_remove_cb (Ref : vpiHandle) return integer;
+   pragma Export (C, vpi_remove_cb, "vpi_remove_cb");
+
+   -- void vpi_vprintf(const char*fmt, va_list ap)
+   procedure vpi_vprintf (Fmt: Address; Ap: Address);
+   pragma Export (C, vpi_vprintf, "vpi_vprintf");
+
+-------------------------------------------------------------------------------
+-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   procedure Register;
+
+end Grt.Vpi;
+
diff --git a/src/translate/grt/grt-vstrings.adb b/src/translate/grt/grt-vstrings.adb
new file mode 100644
index 000000000..30c58ab41
--- /dev/null
+++ b/src/translate/grt/grt-vstrings.adb
@@ -0,0 +1,422 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Errors; use Grt.Errors;
+with Grt.C; use Grt.C;
+
+package body Grt.Vstrings is
+   procedure Free (Fs : Fat_String_Acc);
+   pragma Import (C, Free);
+
+   function Malloc (Len : Natural) return Fat_String_Acc;
+   pragma Import (C, Malloc);
+
+   function Realloc (Ptr : Fat_String_Acc; Len : Natural)
+                    return Fat_String_Acc;
+   pragma Import (C, Realloc);
+
+
+   procedure Free (Vstr : in out Vstring) is
+   begin
+      Free (Vstr.Str);
+      Vstr := (Str => null,
+               Max => 0,
+               Len => 0);
+   end Free;
+
+   procedure Grow (Vstr : in out Vstring; Sum : Natural)
+   is
+      Nlen : constant Natural := Vstr.Len + Sum;
+      Nmax : Natural;
+   begin
+      Vstr.Len := Nlen;
+      if Nlen <= Vstr.Max then
+         return;
+      end if;
+      if Vstr.Max = 0 then
+         Nmax := 32;
+      else
+         Nmax := Vstr.Max;
+      end if;
+      while Nmax < Nlen loop
+         Nmax := Nmax * 2;
+      end loop;
+      Vstr.Str := Realloc (Vstr.Str, Nmax);
+      if Vstr.Str = null then
+         Internal_Error ("grt.vstrings.grow: memory exhausted");
+      end if;
+      Vstr.Max := Nmax;
+   end Grow;
+
+   procedure Append (Vstr : in out Vstring; C : Character)
+   is
+   begin
+      Grow (Vstr, 1);
+      Vstr.Str (Vstr.Len) := C;
+   end Append;
+
+   procedure Append (Vstr : in out Vstring; Str : String)
+   is
+      S : constant Natural := Vstr.Len;
+   begin
+      Grow (Vstr, Str'Length);
+      Vstr.Str (S + 1 .. S + Str'Length) := Str;
+   end Append;
+
+   procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String)
+   is
+      S : constant Natural := Vstr.Len;
+      L : constant Natural := strlen (Str);
+   begin
+      Grow (Vstr, L);
+      Vstr.Str (S + 1 .. S + L) := Str (1 .. L);
+   end Append;
+
+   function Length (Vstr : Vstring) return Natural is
+   begin
+      return Vstr.Len;
+   end Length;
+
+   procedure Truncate (Vstr : in out Vstring; Len : Natural) is
+   begin
+      if Len > Vstr.Len then
+         Internal_Error ("grt.vstrings.truncate: bad len");
+      end if;
+      Vstr.Len := Len;
+   end Truncate;
+
+   procedure Put (Stream : FILEs; Vstr : Vstring)
+   is
+      S : size_t;
+   begin
+      S := size_t (Vstr.Len);
+      if S > 0 then
+         S := fwrite (Vstr.Str (1)'Address, S, 1, Stream);
+      end if;
+   end Put;
+
+   procedure Free (Rstr : in out Rstring) is
+   begin
+      Free (Rstr.Str);
+      Rstr := (Str => null,
+               Max => 0,
+               First => 0);
+   end Free;
+
+   function Length (Rstr : Rstring) return Natural is
+   begin
+      return Rstr.Max + 1 - Rstr.First;
+   end Length;
+
+   procedure Grow (Rstr : in out Rstring; Min : Natural)
+   is
+      Len : constant Natural := Length (Rstr);
+      Nlen : constant Natural := Len + Min;
+      Nstr : Fat_String_Acc;
+      Nfirst : Natural;
+      Nmax : Natural;
+   begin
+      if Nlen <= Rstr.Max then
+         return;
+      end if;
+      if Rstr.Max = 0 then
+         Nmax := 32;
+      else
+         Nmax := Rstr.Max;
+      end if;
+      while Nmax < Nlen loop
+         Nmax := Nmax * 2;
+      end loop;
+      Nstr := Malloc (Nmax);
+      Nfirst := Nmax + 1 - Len;
+      if Rstr.Str /= null then
+         Nstr (Nfirst .. Nmax) := Rstr.Str (Rstr.First .. Rstr.Max);
+         Free (Rstr.Str);
+      end if;
+      Rstr := (Str => Nstr,
+               Max => Nmax,
+               First => Nfirst);
+   end Grow;
+
+   procedure Prepend (Rstr : in out Rstring; C : Character)
+   is
+   begin
+      Grow (Rstr, 1);
+      Rstr.First := Rstr.First - 1;
+      Rstr.Str (Rstr.First) := C;
+   end Prepend;
+
+   procedure Prepend (Rstr : in out Rstring; Str : String)
+   is
+   begin
+      Grow (Rstr, Str'Length);
+      Rstr.First := Rstr.First - Str'Length;
+      Rstr.Str (Rstr.First .. Rstr.First + Str'Length - 1) := Str;
+   end Prepend;
+
+   procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String)
+   is
+      L : constant Natural := strlen (Str);
+   begin
+      Grow (Rstr, L);
+      Rstr.First := Rstr.First - L;
+      Rstr.Str (Rstr.First .. Rstr.First + L - 1) := Str (1 .. L);
+   end Prepend;
+
+   function Get_Address (Rstr : Rstring) return Address
+   is
+   begin
+      return Rstr.Str (Rstr.First)'Address;
+   end Get_Address;
+
+   procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural)
+   is
+   begin
+      Len := Length (Rstr);
+      if Len > Str'Length then
+         Str := Rstr.Str (Rstr.First .. Rstr.First + Str'Length - 1);
+      else
+         Str (Str'First .. Str'First + Len - 1) :=
+           Rstr.Str (Rstr.First .. Rstr.First + Len - 1);
+      end if;
+   end Copy;
+
+   procedure Put (Stream : FILEs; Rstr : Rstring)
+   is
+      S : size_t;
+      pragma Unreferenced (S);
+   begin
+      S := fwrite (Get_Address (Rstr), size_t (Length (Rstr)), 1, Stream);
+   end Put;
+
+   generic
+      type Ntype is range <>;
+      --Max_Len : Natural;
+   procedure Gen_To_String (Str : out String; First : out Natural; N : Ntype);
+
+   procedure Gen_To_String (Str : out String; First : out Natural; N : Ntype)
+   is
+      subtype R_Type is String (1 .. Str'Length);
+      S : R_Type renames Str;
+      P : Natural := S'Last;
+      V : Ntype;
+   begin
+      if N > 0 then
+         V := -N;
+      else
+         V := N;
+      end if;
+      loop
+         S (P) := Character'Val (48 - (V rem 10));
+         V := V / 10;
+         exit when V = 0;
+         P := P - 1;
+      end loop;
+      if N < 0 then
+         P := P - 1;
+         S (P) := '-';
+      end if;
+      First := P;
+   end Gen_To_String;
+
+   procedure To_String_I32 is new Gen_To_String (Ntype => Ghdl_I32);
+
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32)
+     renames To_String_I32;
+
+   procedure To_String_I64 is new Gen_To_String (Ntype => Ghdl_I64);
+
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64)
+     renames To_String_I64;
+
+   procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64)
+   is
+      function Trunc (V : Ghdl_F64) return Ghdl_F64;
+      pragma Import (C, Trunc);
+
+      P : Natural := Str'First;
+      V : Ghdl_F64;
+      Vmax : Ghdl_F64;
+      Vd : Ghdl_F64;
+      Exp : Integer;
+      D : Integer;
+      B : Boolean;
+   begin
+      --  Handle sign.
+      if N < 0.0 then
+         Str (P) := '-';
+         P := P + 1;
+         V := -N;
+      else
+         V := N;
+      end if;
+
+      --  Compute the mantissa.
+      --  and normalize V in [0 .. 10.0[
+      --  FIXME: should do a dichotomy.
+      if V  = 0.0 then
+         Exp := 0;
+      elsif V < 1.0 then
+         Exp := 0;
+         loop
+            exit when V >= 1.0;
+            Exp := Exp - 1;
+            V := V * 10.0;
+         end loop;
+      else
+         Exp := 0;
+         loop
+            exit when V < 10.0;
+            Exp := Exp + 1;
+            V := V / 10.0;
+         end loop;
+      end if;
+
+      Vmax := 10.0 ** (1 - 15);
+      for I in 0 .. 15 loop
+         --  Vd := Ghdl_F64'Truncation (V);
+         Vd := Trunc (V);
+         Str (P) := Character'Val (48 + Integer (Vd));
+         P := P + 1;
+         V := (V - Vd) * 10.0;
+
+         if I = 0 then
+            Str (P) := '.';
+            P := P + 1;
+         end if;
+         exit when I > 0 and V < Vmax;
+         Vmax := Vmax * 10.0;
+      end loop;
+
+      if Exp /= 0 then
+         --  LRM93 14.3
+         --  if the exponent is present, the `e' is written as a lower case
+         --  character.
+         Str (P) := 'e';
+         P := P + 1;
+
+         if Exp < 0 then
+            Str (P) := '-';
+            P := P + 1;
+            Exp := -Exp;
+         end if;
+         B := False;
+         for I in 0 .. 4 loop
+            D := (Exp / 10000) mod 10;
+            if D /= 0 or B or I = 4 then
+               Str (P) := Character'Val (48 + D);
+               P := P + 1;
+               B := True;
+            end if;
+            Exp := (Exp - D * 10000) * 10;
+         end loop;
+      end if;
+
+      Last := P - 1;
+   end To_String;
+
+   procedure To_String (Str : out String_Real_Digits;
+                        Last : out Natural;
+                        N : Ghdl_F64;
+                        Nbr_Digits : Ghdl_I32)
+   is
+      procedure Snprintf_Nf (Str : in out String;
+                             Len : Natural;
+                             Ndigits : Ghdl_I32;
+                             V : Ghdl_F64);
+      pragma Import (C, Snprintf_Nf, "__ghdl_snprintf_nf");
+   begin
+      Snprintf_Nf (Str, Str'Length, Nbr_Digits, N);
+      Last := strlen (To_Ghdl_C_String (Str'Address));
+   end To_String;
+
+   procedure To_String (Str : out String_Real_Digits;
+                        Last : out Natural;
+                        N : Ghdl_F64;
+                        Format : Ghdl_C_String)
+   is
+      procedure Snprintf_Fmtf (Str : in out String;
+                               Len : Natural;
+                               Format : Ghdl_C_String;
+                               V : Ghdl_F64);
+      pragma Import (C, Snprintf_Fmtf, "__ghdl_snprintf_fmtf");
+   begin
+      --  FIXME: check format ('%', f/g/e/a)
+      Snprintf_Fmtf (Str, Str'Length, Format, N);
+      Last := strlen (To_Ghdl_C_String (Str'Address));
+   end To_String;
+
+   procedure To_String (Str : out String_Time_Unit;
+                        First : out Natural;
+                        Value : Ghdl_I64;
+                        Unit : Ghdl_I64)
+   is
+      V, U : Ghdl_I64;
+      D : Natural;
+      P : Natural := Str'Last;
+      Has_Digits : Boolean;
+   begin
+      --  Always work on negative values.
+      if Value > 0 then
+         V := -Value;
+      else
+         V := Value;
+      end if;
+
+      Has_Digits := False;
+      U := Unit;
+      loop
+         if U = 1 then
+            if Has_Digits then
+               Str (P) := '.';
+               P := P - 1;
+            else
+               Has_Digits := True;
+            end if;
+         end if;
+
+         D := Natural (-(V rem 10));
+         if D /= 0 or else Has_Digits then
+            Str (P) := Character'Val (48 + D);
+            P := P - 1;
+            Has_Digits := True;
+         end if;
+         U := U / 10;
+         V := V / 10;
+         exit when V = 0 and then U = 0;
+      end loop;
+      if not Has_Digits then
+         Str (P) := '0';
+      else
+         P := P + 1;
+      end if;
+      if Value < 0 then
+         P := P - 1;
+         Str (P) := '-';
+      end if;
+      First := P;
+   end To_String;
+end Grt.Vstrings;
diff --git a/src/translate/grt/grt-vstrings.ads b/src/translate/grt/grt-vstrings.ads
new file mode 100644
index 000000000..94967bb0f
--- /dev/null
+++ b/src/translate/grt/grt-vstrings.ads
@@ -0,0 +1,143 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Types; use Grt.Types;
+with System; use System;
+
+package Grt.Vstrings is
+   --  A Vstring (Variable string) is an object which contains an unbounded
+   --  string.
+   type Vstring is limited private;
+
+   --  Deallocate all storage internally allocated.
+   procedure Free (Vstr : in out Vstring);
+
+   --  Append a character.
+   procedure Append (Vstr : in out Vstring; C : Character);
+
+   --  Append a string.
+   procedure Append (Vstr : in out Vstring; Str : String);
+
+   --  Append a C string.
+   procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String);
+
+   --  Get length of VSTR.
+   function Length (Vstr : Vstring) return Natural;
+
+   --  Truncate VSTR to LEN.
+   --  It is an error if LEN is greater than the current length.
+   procedure Truncate (Vstr : in out Vstring; Len : Natural);
+
+   --  Display VSTR.
+   procedure Put (Stream : FILEs; Vstr : Vstring);
+
+
+   --  A Rstring is link a Vstring but characters can only be prepended.
+   type Rstring is limited private;
+
+   --  Deallocate storage associated with Rstr.
+   procedure Free (Rstr : in out Rstring);
+
+   --  Prepend characters or strings.
+   procedure Prepend (Rstr : in out Rstring; C : Character);
+   procedure Prepend (Rstr : in out Rstring; Str : String);
+   procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String);
+
+   --  Get the length of RSTR.
+   function Length (Rstr : Rstring) return Natural;
+
+   --  Return the address of the first character of RSTR.
+   function Get_Address (Rstr : Rstring) return Address;
+
+   --  Display RSTR.
+   procedure Put (Stream : FILEs; Rstr : Rstring);
+
+   --  Copy RSTR to STR, and return length of the string to LEN.
+   procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural);
+
+   --  Write the image of N into STR padded to the right.  FIRST is the index
+   --  of the first character, so the result is in STR (FIRST .. STR'last).
+   --  Requires at least 11 characters.
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32);
+
+   --  Write the image of N into STR padded to the right.  FIRST is the index
+   --  of the first character, so the result is in STR (FIRST .. STR'last).
+   --  Requires at least 21 characters.
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64);
+
+   --  Write the image of N into STR.  LAST is the index of the last character,
+   --  so the result is in STR (STR'first .. LAST).
+   --  Requires at least 24 characters.
+   --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+   --  + exp_digits (4) -> 24.
+   procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64);
+
+   subtype String_Real_Digits is String (1 .. 128);
+
+   --  Write the image of N into STR using NBR_DIGITS digits after the decimal
+   --  point.
+   procedure To_String (Str : out String_Real_Digits;
+                        Last : out Natural;
+                        N : Ghdl_F64;
+                        Nbr_Digits : Ghdl_I32);
+
+   subtype String_Real_Format is String (1 .. 128);
+
+   --  Write the image of N into STR using NBR_DIGITS digits after the decimal
+   --  point.
+   procedure To_String (Str : out String_Real_Digits;
+                        Last : out Natural;
+                        N : Ghdl_F64;
+                        Format : Ghdl_C_String);
+
+   --  Write the image of VALUE to STR using UNIT as unit.  The output is in
+   --  STR (FIRST .. STR'last).
+   subtype String_Time_Unit is String (1 .. 22);
+   procedure To_String (Str : out String_Time_Unit;
+                        First : out Natural;
+                        Value : Ghdl_I64;
+                        Unit : Ghdl_I64);
+
+private
+   subtype Fat_String is String (Positive);
+   type Fat_String_Acc is access Fat_String;
+
+   type Vstring is record
+      Str : Fat_String_Acc := null;
+      Max : Natural := 0;
+      Len : Natural := 0;
+   end record;
+
+   type Rstring is record
+      --  String whose bounds is (1 .. Max).
+      Str : Fat_String_Acc := null;
+
+      --  Last index in STR.
+      Max : Natural := 0;
+
+      --  Index of the first character.
+      First : Natural := 1;
+   end record;
+end Grt.Vstrings;
diff --git a/src/translate/grt/grt-waves.adb b/src/translate/grt/grt-waves.adb
new file mode 100644
index 000000000..63bdb9a54
--- /dev/null
+++ b/src/translate/grt/grt-waves.adb
@@ -0,0 +1,1632 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+with System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
+with Grt.Errors; use Grt.Errors;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Table;
+with Grt.Avls; use Grt.Avls;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils;
+with Grt.Rtis_Types;
+with Grt.Signals; use Grt.Signals;
+with System; use System;
+with Grt.Vstrings; use Grt.Vstrings;
+
+pragma Elaborate_All (Grt.Rtis_Utils);
+pragma Elaborate_All (Grt.Table);
+
+package body Grt.Waves is
+   --  Waves filename.
+   Wave_Filename : String_Access := null;
+   --  Stream corresponding to the GHW filename.
+   Wave_Stream : FILEs;
+
+   Ghw_Hie_Design       : constant Unsigned_8 := 1;
+   Ghw_Hie_Block        : constant Unsigned_8 := 3;
+   Ghw_Hie_Generate_If  : constant Unsigned_8 := 4;
+   Ghw_Hie_Generate_For : constant Unsigned_8 := 5;
+   Ghw_Hie_Instance     : constant Unsigned_8 := 6;
+   Ghw_Hie_Package      : constant Unsigned_8 := 7;
+   Ghw_Hie_Process      : constant Unsigned_8 := 13;
+   Ghw_Hie_Generic      : constant Unsigned_8 := 14;
+   Ghw_Hie_Eos          : constant Unsigned_8 := 15; --  End of scope.
+   Ghw_Hie_Signal       : constant Unsigned_8 := 16; --  Signal.
+   Ghw_Hie_Port_In      : constant Unsigned_8 := 17; --  Port
+   Ghw_Hie_Port_Out     : constant Unsigned_8 := 18; --  Port
+   Ghw_Hie_Port_Inout   : constant Unsigned_8 := 19; --  Port
+   Ghw_Hie_Port_Buffer  : constant Unsigned_8 := 20; --  Port
+   Ghw_Hie_Port_Linkage : constant Unsigned_8 := 21; --  Port
+
+   pragma Unreferenced (Ghw_Hie_Design);
+   pragma Unreferenced (Ghw_Hie_Generic);
+
+   --  Return TRUE if OPT is an option for wave.
+   function Wave_Option (Opt : String) return Boolean
+   is
+      F : constant Natural := Opt'First;
+   begin
+      if Opt'Length < 6 or else Opt (F .. F + 5) /= "--wave" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 6) = '=' then
+         --  Add an extra NUL character.
+         Wave_Filename := new String (1 .. Opt'Length - 7 + 1);
+         Wave_Filename (1 .. Opt'Length - 7) := Opt (F + 7 .. Opt'Last);
+         Wave_Filename (Wave_Filename'Last) := NUL;
+         return True;
+      else
+         return False;
+      end if;
+   end Wave_Option;
+
+   procedure Wave_Help is
+   begin
+      Put_Line (" --wave=FILENAME    dump signal values into a wave file");
+   end Wave_Help;
+
+   procedure Wave_Put (Str : String)
+   is
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Wave_Stream);
+   end Wave_Put;
+
+   procedure Wave_Putc (C : Character)
+   is
+      R : int;
+      pragma Unreferenced (R);
+   begin
+      R := fputc (Character'Pos (C), Wave_Stream);
+   end Wave_Putc;
+
+   procedure Wave_Newline is
+   begin
+      Wave_Putc (Nl);
+   end Wave_Newline;
+
+   procedure Wave_Put_Byte (B : Unsigned_8)
+   is
+      V : Unsigned_8 := B;
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (V'Address, 1, 1, Wave_Stream);
+   end Wave_Put_Byte;
+
+   procedure Wave_Put_ULEB128 (Val : Ghdl_E32)
+   is
+      V : Ghdl_E32;
+      R : Ghdl_E32;
+   begin
+      V := Val;
+      loop
+         R := V mod 128;
+         V := V / 128;
+         if V = 0 then
+            Wave_Put_Byte (Unsigned_8 (R));
+            exit;
+         else
+            Wave_Put_Byte (Unsigned_8 (128 + R));
+         end if;
+      end loop;
+   end Wave_Put_ULEB128;
+
+   procedure Wave_Put_SLEB128 (Val : Ghdl_I32)
+   is
+      function To_Ghdl_U32 is new Ada.Unchecked_Conversion
+        (Ghdl_I32, Ghdl_U32);
+      V : Ghdl_U32 := To_Ghdl_U32 (Val);
+
+--        function Shift_Right_Arithmetic (Value : Ghdl_U32; Amount : Natural)
+--                                        return Ghdl_U32;
+--        pragma Import (Intrinsic, Shift_Right_Arithmetic);
+      R : Unsigned_8;
+   begin
+      loop
+         R := Unsigned_8 (V mod 128);
+         V := Shift_Right_Arithmetic (V, 7);
+         if (V = 0 and (R and 16#40#) = 0) or (V = -1 and (R and 16#40#) /= 0)
+         then
+            Wave_Put_Byte (R);
+            exit;
+         else
+            Wave_Put_Byte (R or 16#80#);
+         end if;
+      end loop;
+   end Wave_Put_SLEB128;
+
+   procedure Wave_Put_LSLEB128 (Val : Ghdl_I64)
+   is
+      function To_Ghdl_U64 is new Ada.Unchecked_Conversion
+        (Ghdl_I64, Ghdl_U64);
+      V : Ghdl_U64 := To_Ghdl_U64 (Val);
+
+      R : Unsigned_8;
+   begin
+      loop
+         R := Unsigned_8 (V mod 128);
+         V := Shift_Right_Arithmetic (V, 7);
+         if (V = 0 and (R and 16#40#) = 0) or (V = -1 and (R and 16#40#) /= 0)
+         then
+            Wave_Put_Byte (R);
+            exit;
+         else
+            Wave_Put_Byte (R or 16#80#);
+         end if;
+      end loop;
+   end Wave_Put_LSLEB128;
+
+   procedure Wave_Put_I32 (Val : Ghdl_I32)
+   is
+      V : Ghdl_I32 := Val;
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (V'Address, 4, 1, Wave_Stream);
+   end Wave_Put_I32;
+
+   procedure Wave_Put_I64 (Val : Ghdl_I64)
+   is
+      V : Ghdl_I64 := Val;
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (V'Address, 8, 1, Wave_Stream);
+   end Wave_Put_I64;
+
+   procedure Wave_Put_F64 (F64 : Ghdl_F64)
+   is
+      V : Ghdl_F64 := F64;
+      R : size_t;
+      pragma Unreferenced (R);
+   begin
+      R := fwrite (V'Address, Ghdl_F64'Size / Storage_Unit, 1, Wave_Stream);
+   end Wave_Put_F64;
+
+   procedure Wave_Puts (Str : Ghdl_C_String) is
+   begin
+      Put (Wave_Stream, Str);
+   end Wave_Puts;
+
+   procedure Write_Value (Value : Value_Union; Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_B1 =>
+            Wave_Put_Byte (Ghdl_B1'Pos (Value.B1));
+         when Mode_E8 =>
+            Wave_Put_Byte (Ghdl_E8'Pos (Value.E8));
+         when Mode_E32 =>
+            Wave_Put_ULEB128 (Value.E32);
+         when Mode_I32 =>
+            Wave_Put_SLEB128 (Value.I32);
+         when Mode_I64 =>
+            Wave_Put_LSLEB128 (Value.I64);
+         when Mode_F64 =>
+            Wave_Put_F64 (Value.F64);
+      end case;
+   end Write_Value;
+
+   subtype Section_Name is String (1 .. 4);
+   type Header_Type is record
+      Name : Section_Name;
+      Pos : long;
+   end record;
+
+   package Section_Table is new Grt.Table
+     (Table_Component_Type => Header_Type,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16);
+
+   --  Create a new section.
+   --  Write the header in the file.
+   --  Save the location for the directory.
+   procedure Wave_Section (Name : Section_Name) is
+   begin
+      Section_Table.Append (Header_Type'(Name => Name,
+                                         Pos => ftell (Wave_Stream)));
+      Wave_Put (Name);
+   end Wave_Section;
+
+   procedure Wave_Write_Size_Order is
+   begin
+      --  Byte order, 1 byte.
+      --  0: bad, 1 : little-endian, 2 : big endian.
+      declare
+         type Byte_Arr is array (0 .. 3) of Unsigned_8;
+         function To_Byte_Arr is new Ada.Unchecked_Conversion
+           (Source => Unsigned_32, Target => Byte_Arr);
+         B4 : constant Byte_Arr := To_Byte_Arr (16#11_22_33_44#);
+         V : Unsigned_8;
+      begin
+         if B4 (0) = 16#11# then
+            --  Big endian.
+            V := 2;
+         elsif B4 (0) = 16#44# then
+            --  Little endian.
+            V := 1;
+         else
+            --  Unknown endian.
+            V := 0;
+         end if;
+         Wave_Put_Byte (V);
+      end;
+      --  Word size, 1 byte.
+      Wave_Put_Byte (Integer'Size / 8);
+      --  File offset size, 1 byte
+      Wave_Put_Byte (1);
+      --  Unused, must be zero (MBZ).
+      Wave_Put_Byte (0);
+   end Wave_Write_Size_Order;
+
+   procedure Wave_Write_Directory
+   is
+      Pos : long;
+   begin
+      Pos := ftell (Wave_Stream);
+      Wave_Section ("DIR" & NUL);
+      Wave_Write_Size_Order;
+      Wave_Put_I32 (Ghdl_I32 (Section_Table.Last));
+      for I in Section_Table.First .. Section_Table.Last loop
+         Wave_Put (Section_Table.Table (I).Name);
+         Wave_Put_I32 (Ghdl_I32 (Section_Table.Table (I).Pos));
+      end loop;
+      Wave_Put ("EOD" & NUL);
+
+      Wave_Section ("TAI" & NUL);
+      Wave_Write_Size_Order;
+      Wave_Put_I32 (Ghdl_I32 (Pos));
+   end Wave_Write_Directory;
+
+   --  Called before elaboration.
+   procedure Wave_Init
+   is
+      Mode : constant String := "wb" & NUL;
+   begin
+      if Wave_Filename = null then
+         Wave_Stream := NULL_Stream;
+         return;
+      end if;
+      if Wave_Filename.all = "-" & NUL then
+         Wave_Stream := stdout;
+      else
+         Wave_Stream := fopen (Wave_Filename.all'Address, Mode'Address);
+         if Wave_Stream = NULL_Stream then
+            Error_C ("cannot open ");
+            Error_E (Wave_Filename (Wave_Filename'First
+                                   .. Wave_Filename'Last - 1));
+            return;
+         end if;
+      end if;
+   end Wave_Init;
+
+   procedure Write_File_Header
+   is
+   begin
+      --  Magic, 9 bytes.
+      Wave_Put ("GHDLwave" & Nl);
+      --  Header length.
+      Wave_Put_Byte (16);
+      --  Version-major, 1 byte.
+      Wave_Put_Byte (0);
+      --  Version-minor, 1 byte.
+      Wave_Put_Byte (1);
+
+      Wave_Write_Size_Order;
+   end Write_File_Header;
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("Waves.Avhpi_Error!");
+      null;
+   end Avhpi_Error;
+
+   package Str_Table is new Grt.Table
+     (Table_Component_Type => Ghdl_C_String,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16);
+
+   package Str_AVL is new Grt.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16);
+
+   Strings_Len : Natural := 0;
+
+   function Str_Compare (L, R : AVL_Value) return Integer
+   is
+      Ls, Rs : Ghdl_C_String;
+   begin
+      Ls := Str_Table.Table (L);
+      Rs := Str_Table.Table (R);
+      if L = R then
+         return 0;
+      end if;
+      return Strcmp (Ls, Rs);
+   end Str_Compare;
+
+   procedure Disp_Str_Avl (N : AVL_Nid) is
+   begin
+      Put (stdout, "node: ");
+      Put_I32 (stdout, Ghdl_I32 (N));
+      New_Line (stdout);
+      Put (stdout, " left: ");
+      Put_I32 (stdout, Ghdl_I32 (Str_AVL.Table (N).Left));
+      New_Line (stdout);
+      Put (stdout, " right: ");
+      Put_I32 (stdout, Ghdl_I32 (Str_AVL.Table (N).Right));
+      New_Line (stdout);
+      Put (stdout, " height: ");
+      Put_I32 (stdout, Str_AVL.Table (N).Height);
+      New_Line (stdout);
+      Put (stdout, " str: ");
+      --Put (stdout, Str_AVL.Table (N).Val);
+      New_Line (stdout);
+   end Disp_Str_Avl;
+
+   pragma Unreferenced (Disp_Str_Avl);
+
+   function Create_Str_Index (Str : Ghdl_C_String) return AVL_Value
+   is
+      Res : AVL_Nid;
+   begin
+      Str_Table.Append (Str);
+      Str_AVL.Append (AVL_Node'(Val => Str_Table.Last,
+                                Left | Right => AVL_Nil,
+                                Height => 1));
+      Get_Node (AVL_Tree (Str_AVL.Table (Str_AVL.First .. Str_AVL.Last)),
+                Str_Compare'Access,
+                Str_AVL.Last, Res);
+      if Res /= Str_AVL.Last then
+         Str_AVL.Decrement_Last;
+         Str_Table.Decrement_Last;
+      else
+         Strings_Len := Strings_Len + strlen (Str);
+      end if;
+      return Str_AVL.Table (Res).Val;
+   end Create_Str_Index;
+
+   pragma Unreferenced (Create_Str_Index);
+
+   procedure Create_String_Id (Str : Ghdl_C_String)
+   is
+      Res : AVL_Nid;
+   begin
+      if Str = null then
+         return;
+      end if;
+      Str_Table.Append (Str);
+      Str_AVL.Append (AVL_Node'(Val => Str_Table.Last,
+                                Left | Right => AVL_Nil,
+                                Height => 1));
+      Get_Node (AVL_Tree (Str_AVL.Table (Str_AVL.First .. Str_AVL.Last)),
+                Str_Compare'Access,
+                Str_AVL.Last, Res);
+      if Res /= Str_AVL.Last then
+         Str_AVL.Decrement_Last;
+         Str_Table.Decrement_Last;
+      else
+         Strings_Len := Strings_Len + strlen (Str);
+      end if;
+   end Create_String_Id;
+
+   function Get_String (Str : Ghdl_C_String) return AVL_Value
+   is
+      H, L, M : AVL_Value;
+      Diff : Integer;
+   begin
+      L := Str_Table.First;
+      H := Str_Table.Last;
+      loop
+         M := (L + H) / 2;
+         Diff := Strcmp (Str, Str_Table.Table (M));
+         if Diff = 0 then
+            return M;
+         elsif Diff < 0 then
+            H := M - 1;
+         else
+            L := M + 1;
+         end if;
+         exit when L > H;
+      end loop;
+      return 0;
+   end Get_String;
+
+   procedure Write_String_Id (Str : Ghdl_C_String) is
+   begin
+      if Str = null then
+         Wave_Put_Byte (0);
+      else
+         Wave_Put_ULEB128 (Ghdl_E32 (Get_String (Str)));
+      end if;
+   end Write_String_Id;
+
+   type Type_Node is record
+      Type_Rti : Ghdl_Rti_Access;
+      Context : Rti_Context;
+   end record;
+
+   package Types_Table is new Grt.Table
+     (Table_Component_Type => Type_Node,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16);
+
+   package Types_AVL is new Grt.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16);
+
+   function Type_Compare (L, R : AVL_Value) return Integer
+   is
+      function To_Ia is new
+        Ada.Unchecked_Conversion (Ghdl_Rti_Access, Integer_Address);
+
+      function "<" (L, R : Ghdl_Rti_Access) return Boolean is
+      begin
+         return To_Ia (L) < To_Ia (R);
+      end "<";
+
+      Ls : Type_Node renames Types_Table.Table (L);
+      Rs : Type_Node renames Types_Table.Table (R);
+   begin
+      if Ls.Type_Rti /= Rs.Type_Rti then
+         if Ls.Type_Rti < Rs.Type_Rti then
+            return -1;
+         else
+            return 1;
+         end if;
+      end if;
+      if Ls.Context.Block /= Rs.Context.Block then
+         if Ls.Context.Block < Rs.Context.Block then
+            return -1;
+         else
+            return +1;
+         end if;
+      end if;
+      if Ls.Context.Base /= Rs.Context.Base then
+         if Ls.Context.Base < Rs.Context.Base then
+            return -1;
+         else
+            return +1;
+         end if;
+      end if;
+      return 0;
+   end Type_Compare;
+
+   --  Try to find type (RTI, CTXT) in the types_AVL table.
+   --  The first step is to canonicalize CTXT, so that it is the CTXT of
+   --   the type (and not a sub-scope of it).
+   procedure Find_Type (Rti : Ghdl_Rti_Access;
+                        Ctxt : Rti_Context;
+                        N_Ctxt : out Rti_Context;
+                        Id : out AVL_Nid)
+   is
+      Depth : Ghdl_Rti_Depth;
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8 =>
+            N_Ctxt := Null_Context;
+         when Ghdl_Rtik_Port
+           | Ghdl_Rtik_Signal =>
+            N_Ctxt := Ctxt;
+         when others =>
+            --  Compute the canonical context.
+            if Rti.Max_Depth < Rti.Depth then
+               Internal_Error ("grt.waves.find_type");
+            end if;
+            Depth := Rti.Max_Depth;
+            if Depth = 0 or else Ctxt.Block = null then
+               N_Ctxt := Null_Context;
+            else
+               N_Ctxt := Ctxt;
+               while N_Ctxt.Block.Depth > Depth loop
+                  N_Ctxt := Get_Parent_Context (N_Ctxt);
+               end loop;
+            end if;
+      end case;
+
+      --  If the type is already known, return now.
+      --  Otherwise, ID is set to AVL_Nil.
+      Types_Table.Append (Type_Node'(Type_Rti => Rti, Context => N_Ctxt));
+      Id := Find_Node
+        (AVL_Tree (Types_AVL.Table (Types_AVL.First .. Types_AVL.Last)),
+         Type_Compare'Access,
+         Types_Table.Last);
+      Types_Table.Decrement_Last;
+   end Find_Type;
+
+   procedure Write_Type_Id (Tid : AVL_Nid) is
+   begin
+      Wave_Put_ULEB128 (Ghdl_E32 (Types_AVL.Table (Tid).Val));
+   end Write_Type_Id;
+
+   procedure Write_Type_Id (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+      N_Ctxt : Rti_Context;
+      Res : AVL_Nid;
+   begin
+      Find_Type (Rti, Ctxt, N_Ctxt, Res);
+      if Res = AVL_Nil then
+         -- raise Program_Error;
+         Internal_Error ("write_type_id");
+      end if;
+      Write_Type_Id (Res);
+   end Write_Type_Id;
+
+   procedure Add_Type (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+      Res : AVL_Nid;
+   begin
+      --  Then, create the type.
+      Types_Table.Append (Type_Node'(Type_Rti => Rti, Context => Ctxt));
+      Types_AVL.Append (AVL_Node'(Val => Types_Table.Last,
+                                  Left | Right => AVL_Nil,
+                                  Height => 1));
+
+      Get_Node
+        (AVL_Tree (Types_AVL.Table (Types_AVL.First .. Types_AVL.Last)),
+         Type_Compare'Access,
+         Types_AVL.Last, Res);
+      if Res /= Types_AVL.Last then
+         --raise Program_Error;
+         Internal_Error ("wave.create_type(2)");
+      end if;
+   end Add_Type;
+
+   procedure Create_Type (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+      N_Ctxt : Rti_Context;
+      Res : AVL_Nid;
+   begin
+      Find_Type (Rti, Ctxt, N_Ctxt, Res);
+      if Res /= AVL_Nil then
+         return;
+      end if;
+
+      --  First, create all the types it depends on.
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B1
+           | Ghdl_Rtik_Type_E8 =>
+            declare
+               Enum : Ghdl_Rtin_Type_Enum_Acc;
+            begin
+               Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+               Create_String_Id (Enum.Name);
+               for I in 1 .. Enum.Nbr loop
+                  Create_String_Id (Enum.Names (I - 1));
+               end loop;
+            end;
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               Arr : Ghdl_Rtin_Subtype_Array_Acc;
+               B_Ctxt : Rti_Context;
+            begin
+               Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Create_String_Id (Arr.Name);
+               if Rti_Complex_Type (Rti) then
+                  B_Ctxt := Ctxt;
+               else
+                  B_Ctxt := N_Ctxt;
+               end if;
+               Create_Type (To_Ghdl_Rti_Access (Arr.Basetype), B_Ctxt);
+            end;
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Arr : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
+               Create_String_Id (Arr.Name);
+               Create_Type (Arr.Element, N_Ctxt);
+               for I in 1 .. Arr.Nbr_Dim loop
+                  Create_Type (Arr.Indexes (I - 1), N_Ctxt);
+               end loop;
+            end;
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
+               Create_String_Id (Sub.Name);
+               Create_Type (Sub.Basetype, N_Ctxt);
+            end;
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64
+           | Ghdl_Rtik_Type_F64 =>
+            declare
+               Base : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
+               Create_String_Id (Base.Name);
+            end;
+         when Ghdl_Rtik_Type_P32
+           | Ghdl_Rtik_Type_P64 =>
+            declare
+               Base : Ghdl_Rtin_Type_Physical_Acc;
+               Unit_Name : Ghdl_C_String;
+            begin
+               Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+               Create_String_Id (Base.Name);
+               for I in 1 .. Base.Nbr loop
+                  Unit_Name :=
+                    Rtis_Utils.Get_Physical_Unit_Name (Base.Units (I - 1));
+                  Create_String_Id (Unit_Name);
+               end loop;
+            end;
+         when Ghdl_Rtik_Type_Record =>
+            declare
+               Rec : Ghdl_Rtin_Type_Record_Acc;
+               El : Ghdl_Rtin_Element_Acc;
+            begin
+               Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti);
+               Create_String_Id (Rec.Name);
+               for I in 1 .. Rec.Nbrel loop
+                  El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1));
+                  Create_String_Id (El.Name);
+                  Create_Type (El.Eltype, N_Ctxt);
+               end loop;
+            end;
+         when others =>
+            Internal_Error ("wave.create_type");
+--              Internal_Error ("wave.create_type: does not handle " &
+--                             Ghdl_Rtik'Image (Rti.Kind));
+      end case;
+
+      --  Then, create the type.
+      Add_Type (Rti, N_Ctxt);
+   end Create_Type;
+
+   procedure Create_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Rti : Ghdl_Rti_Access;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Rti := Avhpi_Get_Rti (Obj_Type);
+      Create_Type (Rti, Avhpi_Get_Context (Obj_Type));
+
+      --  The the signal type is an unconstrained array, also put the object
+      --  in the type AVL.
+      --  The real type will be written to the file.
+      if Rti.Kind = Ghdl_Rtik_Type_Array then
+         Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj));
+      end if;
+   end Create_Object_Type;
+
+   procedure Write_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Rti : Ghdl_Rti_Access;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Rti := Avhpi_Get_Rti (Obj_Type);
+      if Rti.Kind = Ghdl_Rtik_Type_Array then
+         Write_Type_Id (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj));
+      else
+         Write_Type_Id (Rti, Avhpi_Get_Context (Obj_Type));
+      end if;
+   end Write_Object_Type;
+
+   procedure Create_Generate_Type (Gen : VhpiHandleT)
+   is
+      Iterator : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract the iterator.
+      Vhpi_Handle (VhpiIterScheme, Gen, Iterator, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Create_Object_Type (Iterator);
+   end Create_Generate_Type;
+
+   procedure Write_Generate_Type_And_Value (Gen : VhpiHandleT)
+   is
+      Iter : VhpiHandleT;
+      Iter_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Addr : Address;
+      Mode : Mode_Type;
+      Rti : Ghdl_Rti_Access;
+   begin
+      --  Extract the iterator.
+      Vhpi_Handle (VhpiIterScheme, Gen, Iter, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Write_Object_Type (Iter);
+
+      Vhpi_Handle (VhpiSubtype, Iter, Iter_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Rti := Avhpi_Get_Rti (Iter_Type);
+      Addr := Avhpi_Get_Address (Iter);
+
+      case Get_Base_Type (Rti).Kind is
+         when Ghdl_Rtik_Type_B1 =>
+            Mode := Mode_B1;
+         when Ghdl_Rtik_Type_E8 =>
+            Mode := Mode_E8;
+         when Ghdl_Rtik_Type_E32 =>
+            Mode := Mode_E32;
+         when Ghdl_Rtik_Type_I32 =>
+            Mode := Mode_I32;
+         when Ghdl_Rtik_Type_I64 =>
+            Mode := Mode_I64;
+         when Ghdl_Rtik_Type_F64 =>
+            Mode := Mode_F64;
+         when others =>
+            Internal_Error ("bad iterator type");
+      end case;
+      Write_Value (To_Ghdl_Value_Ptr (Addr).all, Mode);
+   end Write_Generate_Type_And_Value;
+
+   type Step_Type is (Step_Name, Step_Hierarchy);
+
+   Nbr_Scopes : Natural := 0;
+   Nbr_Scope_Signals : Natural := 0;
+   Nbr_Dumped_Signals : Natural := 0;
+
+   --  This is only valid during write_hierarchy.
+   function Get_Signal_Number (Sig : Ghdl_Signal_Ptr) return Natural
+   is
+      function To_Integer_Address is new Ada.Unchecked_Conversion
+        (Ghdl_Signal_Ptr, Integer_Address);
+   begin
+      return Natural (To_Integer_Address (Sig.Alink));
+   end Get_Signal_Number;
+
+   procedure Write_Signal_Number (Val_Addr : Address;
+                                  Val_Name : Vstring;
+                                  Val_Type : Ghdl_Rti_Access;
+                                  Param_Type : Natural)
+   is
+      pragma Unreferenced (Val_Name);
+      pragma Unreferenced (Val_Type);
+      pragma Unreferenced (Param_Type);
+
+      Num : Natural;
+
+      function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+        (Source => Integer_Address, Target => Ghdl_Signal_Ptr);
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      --  Convert to signal.
+      Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+
+      --  Get signal number.
+      Num := Get_Signal_Number (Sig);
+
+      --  If the signal number is 0, then assign a valid signal number.
+      if Num = 0 then
+         Nbr_Dumped_Signals := Nbr_Dumped_Signals + 1;
+         Sig.Alink := To_Ghdl_Signal_Ptr
+           (Integer_Address (Nbr_Dumped_Signals));
+         Num := Nbr_Dumped_Signals;
+      end if;
+
+      --  Do the real job: write the signal number.
+      Wave_Put_ULEB128 (Ghdl_E32 (Num));
+   end Write_Signal_Number;
+
+   procedure Foreach_Scalar_Signal_Number is new
+     Grt.Rtis_Utils.Foreach_Scalar (Param_Type => Natural,
+                                    Process => Write_Signal_Number);
+
+   procedure Write_Signal_Numbers (Decl : VhpiHandleT)
+   is
+      Ctxt : Rti_Context;
+      Sig : Ghdl_Rtin_Object_Acc;
+   begin
+      Ctxt := Avhpi_Get_Context (Decl);
+      Sig := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Decl));
+      Foreach_Scalar_Signal_Number
+        (Ctxt, Sig.Obj_Type,
+         Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True, 0);
+   end Write_Signal_Numbers;
+
+   procedure Write_Hierarchy_El (Decl : VhpiHandleT)
+   is
+      Mode2hie : constant array (VhpiModeT) of Unsigned_8 :=
+        (VhpiErrorMode => Ghw_Hie_Signal,
+         VhpiInMode => Ghw_Hie_Port_In,
+         VhpiOutMode => Ghw_Hie_Port_Out,
+         VhpiInoutMode => Ghw_Hie_Port_Inout,
+         VhpiBufferMode => Ghw_Hie_Port_Buffer,
+         VhpiLinkageMode => Ghw_Hie_Port_Linkage);
+      V : Unsigned_8;
+   begin
+      case Vhpi_Get_Kind (Decl) is
+         when VhpiPortDeclK =>
+            V := Mode2hie (Vhpi_Get_Mode (Decl));
+         when VhpiSigDeclK =>
+            V := Ghw_Hie_Signal;
+         when VhpiForGenerateK =>
+            V := Ghw_Hie_Generate_For;
+         when VhpiIfGenerateK =>
+            V := Ghw_Hie_Generate_If;
+         when VhpiBlockStmtK =>
+            V := Ghw_Hie_Block;
+         when VhpiCompInstStmtK =>
+            V := Ghw_Hie_Instance;
+         when VhpiProcessStmtK =>
+            V := Ghw_Hie_Process;
+         when VhpiPackInstK =>
+            V := Ghw_Hie_Package;
+         when VhpiRootInstK =>
+            V := Ghw_Hie_Instance;
+         when others =>
+            --raise Program_Error;
+            Internal_Error ("write_hierarchy_el");
+      end case;
+      Wave_Put_Byte (V);
+      Write_String_Id (Avhpi_Get_Base_Name (Decl));
+      case Vhpi_Get_Kind (Decl) is
+         when VhpiPortDeclK
+           | VhpiSigDeclK =>
+            Write_Object_Type (Decl);
+            Write_Signal_Numbers (Decl);
+         when VhpiForGenerateK =>
+            Write_Generate_Type_And_Value (Decl);
+         when others =>
+            null;
+      end case;
+   end Write_Hierarchy_El;
+
+   --  Create a hierarchy block.
+   procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type);
+
+   procedure Wave_Put_Hierarchy_1 (Inst : VhpiHandleT; Step : Step_Type)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract signals.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                     Nbr_Scope_Signals := Nbr_Scope_Signals + 1;
+                     Create_Object_Type (Decl);
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+               --Wave_Put_Name (Decl);
+               --Wave_Newline;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      --  No sub-scopes for packages.
+      if Vhpi_Get_Kind (Inst) = VhpiPackInstK then
+         return;
+      end if;
+
+      --  Extract sub-scopes.
+      Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Nbr_Scopes := Nbr_Scopes + 1;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiBlockStmtK
+              | VhpiCompInstStmtK =>
+               Wave_Put_Hierarchy_Block (Decl, Step);
+            when VhpiProcessStmtK =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+            when others =>
+               Internal_Error ("wave_put_hierarchy_1");
+--                 Wave_Put ("unknown ");
+--                 Wave_Put (VhpiClassKindT'Image (Vhpi_Get_Kind (Decl)));
+--                 Wave_Newline;
+         end case;
+      end loop;
+   end Wave_Put_Hierarchy_1;
+
+   procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type)
+   is
+   begin
+      case Step is
+         when Step_Name =>
+            Create_String_Id (Avhpi_Get_Base_Name (Inst));
+            if Vhpi_Get_Kind (Inst) = VhpiForGenerateK then
+               Create_Generate_Type (Inst);
+            end if;
+         when Step_Hierarchy =>
+            Write_Hierarchy_El (Inst);
+      end case;
+
+      Wave_Put_Hierarchy_1 (Inst, Step);
+
+      if Step = Step_Hierarchy then
+         Wave_Put_Byte (Ghw_Hie_Eos);
+      end if;
+   end Wave_Put_Hierarchy_Block;
+
+   procedure Wave_Put_Hierarchy (Root : VhpiHandleT; Step : Step_Type)
+   is
+      Pack_It : VhpiHandleT;
+      Pack : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  First packages.
+      Get_Package_Inst (Pack_It);
+      loop
+         Vhpi_Scan (Pack_It, Pack, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Wave_Put_Hierarchy_Block (Pack, Step);
+      end loop;
+
+      --  Then top entity.
+      Wave_Put_Hierarchy_Block (Root, Step);
+   end Wave_Put_Hierarchy;
+
+   procedure Disp_Str_AVL (Str : AVL_Nid; Indent : Natural)
+   is
+   begin
+      if Str = AVL_Nil then
+         return;
+      end if;
+      Disp_Str_AVL (Str_AVL.Table (Str).Left, Indent + 1);
+      for I in 1 .. Indent loop
+         Wave_Putc (' ');
+      end loop;
+      Wave_Puts (Str_Table.Table (Str_AVL.Table (Str).Val));
+--        Wave_Putc ('(');
+--        Put_I32 (Wave_Stream, Ghdl_I32 (Str));
+--        Wave_Putc (')');
+--        Put_I32 (Wave_Stream, Get_Height (Str));
+      Wave_Newline;
+      Disp_Str_AVL (Str_AVL.Table (Str).Right, Indent + 1);
+   end Disp_Str_AVL;
+
+   procedure Write_Strings
+   is
+   begin
+--        Wave_Put ("AVL height: ");
+--        Put_I32 (Wave_Stream, Ghdl_I32 (Check_AVL (Str_Root)));
+--        Wave_Newline;
+      Wave_Put ("strings length: ");
+      Put_I32 (Wave_Stream, Ghdl_I32 (Strings_Len));
+      Wave_Newline;
+      Disp_Str_AVL (AVL_Root, 0);
+      fflush (Wave_Stream);
+   end Write_Strings;
+
+   pragma Unreferenced (Write_Strings);
+
+   procedure Freeze_Strings
+   is
+      type Str_Table1_Type is array (1 .. Str_Table.Last) of Ghdl_C_String;
+      type Str_Table1_Acc is access Str_Table1_Type;
+      Idx : AVL_Value;
+      Table1 : Str_Table1_Acc;
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Str_Table1_Type, Str_Table1_Acc);
+
+      procedure Store_Strings (N : AVL_Nid) is
+      begin
+         if N = AVL_Nil then
+            return;
+         end if;
+         Store_Strings (Str_AVL.Table (N).Left);
+         Table1 (Idx) := Str_Table.Table (Str_AVL.Table (N).Val);
+         Idx := Idx + 1;
+         Store_Strings (Str_AVL.Table (N).Right);
+      end Store_Strings;
+   begin
+      Table1 := new Str_Table1_Type;
+      Idx := 1;
+      Store_Strings (AVL_Root);
+      Str_Table.Release;
+      Str_AVL.Free;
+      for I in Table1.all'Range loop
+         Str_Table.Table (I) := Table1 (I);
+      end loop;
+      Free (Table1);
+   end Freeze_Strings;
+
+   procedure Write_Strings_Compress
+   is
+      Last : Ghdl_C_String;
+      V : Ghdl_C_String;
+      L : Natural;
+      L1 : Natural;
+   begin
+      Wave_Section ("STR" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Str_Table.Last));
+      Wave_Put_I32 (Ghdl_I32 (Strings_Len));
+      for I in Str_Table.First .. Str_Table.Last loop
+         V := Str_Table.Table (I);
+         if I = Str_Table.First then
+            L := 1;
+         else
+            Last := Str_Table.Table (I - 1);
+
+            for I in Positive loop
+               if V (I) /= Last (I) then
+                  L := I;
+                  exit;
+               end if;
+            end loop;
+            L1 := L - 1;
+            loop
+               if L1 >= 32 then
+                  Wave_Put_Byte (Unsigned_8 (L1 mod 32) + 16#80#);
+               else
+                  Wave_Put_Byte (Unsigned_8 (L1 mod 32));
+               end if;
+               L1 := L1 / 32;
+               exit when L1 = 0;
+            end loop;
+         end if;
+
+         if Boolean'(False) then
+            Put ("string ");
+            Put_I32 (stdout, Ghdl_I32 (I));
+            Put (": ");
+            Put (V);
+            New_Line;
+         end if;
+
+         loop
+            exit when V (L) = NUL;
+            Wave_Putc (V (L));
+            L := L + 1;
+         end loop;
+      end loop;
+      --  Last string length.
+      Wave_Put_Byte (0);
+      --  End marker.
+      Wave_Put ("EOS" & NUL);
+   end Write_Strings_Compress;
+
+   procedure Write_Range (Rti : Ghdl_Rti_Access; Rng : Ghdl_Range_Ptr)
+   is
+      Kind : Ghdl_Rtik;
+   begin
+      Kind := Rti.Kind;
+      if Kind = Ghdl_Rtik_Subtype_Scalar then
+         Kind := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype.Kind;
+      end if;
+      case Kind is
+         when Ghdl_Rtik_Type_B1 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.B1.Dir) * 16#80#);
+            Wave_Put_Byte (Ghdl_B1'Pos (Rng.B1.Left));
+            Wave_Put_Byte (Ghdl_B1'Pos (Rng.B1.Right));
+         when Ghdl_Rtik_Type_E8 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.E8.Dir) * 16#80#);
+            Wave_Put_Byte (Unsigned_8 (Rng.E8.Left));
+            Wave_Put_Byte (Unsigned_8 (Rng.E8.Right));
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_P32 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.I32.Dir) * 16#80#);
+            Wave_Put_SLEB128 (Rng.I32.Left);
+            Wave_Put_SLEB128 (Rng.I32.Right);
+         when Ghdl_Rtik_Type_P64
+           | Ghdl_Rtik_Type_I64 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.P64.Dir) * 16#80#);
+            Wave_Put_LSLEB128 (Rng.P64.Left);
+            Wave_Put_LSLEB128 (Rng.P64.Right);
+         when Ghdl_Rtik_Type_F64 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.F64.Dir) * 16#80#);
+            Wave_Put_F64 (Rng.F64.Left);
+            Wave_Put_F64 (Rng.F64.Right);
+         when others =>
+            Internal_Error ("waves.write_range: unhandled kind");
+            --Internal_Error ("waves.write_range: unhandled kind "
+            --                & Ghdl_Rtik'Image (Kind));
+      end case;
+   end Write_Range;
+
+   procedure Write_Types
+   is
+      Rti : Ghdl_Rti_Access;
+      Ctxt : Rti_Context;
+   begin
+      Wave_Section ("TYP" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Types_Table.Last));
+      for I in Types_Table.First .. Types_Table.Last loop
+         Rti := Types_Table.Table (I).Type_Rti;
+         Ctxt := Types_Table.Table (I).Context;
+
+         if Rti.Kind = Ghdl_Rtik_Signal or Rti.Kind = Ghdl_Rtik_Port then
+            declare
+               Obj_Rti : constant Ghdl_Rtin_Object_Acc :=
+                 To_Ghdl_Rtin_Object_Acc (Rti);
+               Arr : constant Ghdl_Rtin_Type_Array_Acc :=
+                 To_Ghdl_Rtin_Type_Array_Acc (Obj_Rti.Obj_Type);
+               Addr : Ghdl_Uc_Array_Acc;
+            begin
+               Wave_Put_Byte (Ghdl_Rtik'Pos (Ghdl_Rtik_Subtype_Array));
+               Write_String_Id (null);
+               Write_Type_Id (Obj_Rti.Obj_Type, Ctxt);
+               Addr := To_Ghdl_Uc_Array_Acc
+                 (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt));
+               declare
+                  Rngs : Ghdl_Range_Array (0 .. Arr.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range (Addr.Bounds, Arr, Rngs);
+                  for I in Rngs'Range loop
+                     Write_Range (Arr.Indexes (I), Rngs (I));
+                  end loop;
+               end;
+            end;
+         else
+            --  Kind.
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Rti.Kind));
+            case Rti.Kind is
+               when Ghdl_Rtik_Type_B1
+                 | Ghdl_Rtik_Type_E8 =>
+                  declare
+                     Enum : Ghdl_Rtin_Type_Enum_Acc;
+                  begin
+                     Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+                     Write_String_Id (Enum.Name);
+                     Wave_Put_ULEB128 (Ghdl_E32 (Enum.Nbr));
+                     for I in 1 .. Enum.Nbr loop
+                        Write_String_Id (Enum.Names (I - 1));
+                     end loop;
+                  end;
+               when Ghdl_Rtik_Subtype_Array =>
+                  declare
+                     Arr : Ghdl_Rtin_Subtype_Array_Acc;
+                  begin
+                     Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                     Write_String_Id (Arr.Name);
+                     Write_Type_Id (To_Ghdl_Rti_Access (Arr.Basetype), Ctxt);
+                     declare
+                        Rngs : Ghdl_Range_Array
+                          (0 .. Arr.Basetype.Nbr_Dim - 1);
+                     begin
+                        Bound_To_Range
+                          (Loc_To_Addr (Rti.Depth, Arr.Bounds, Ctxt),
+                           Arr.Basetype, Rngs);
+                        for I in Rngs'Range loop
+                           Write_Range (Arr.Basetype.Indexes (I), Rngs (I));
+                        end loop;
+                     end;
+                  end;
+               when Ghdl_Rtik_Type_Array =>
+                  declare
+                     Arr : Ghdl_Rtin_Type_Array_Acc;
+                  begin
+                     Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
+                     Write_String_Id (Arr.Name);
+                     Write_Type_Id (Arr.Element, Ctxt);
+                     Wave_Put_ULEB128 (Ghdl_E32 (Arr.Nbr_Dim));
+                     for I in 1 .. Arr.Nbr_Dim loop
+                        Write_Type_Id (Arr.Indexes (I - 1), Ctxt);
+                     end loop;
+                  end;
+               when Ghdl_Rtik_Type_Record =>
+                  declare
+                     Rec : Ghdl_Rtin_Type_Record_Acc;
+                     El : Ghdl_Rtin_Element_Acc;
+                  begin
+                     Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti);
+                     Write_String_Id (Rec.Name);
+                     Wave_Put_ULEB128 (Ghdl_E32 (Rec.Nbrel));
+                     for I in 1 .. Rec.Nbrel loop
+                        El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1));
+                        Write_String_Id (El.Name);
+                        Write_Type_Id (El.Eltype, Ctxt);
+                     end loop;
+                  end;
+               when Ghdl_Rtik_Subtype_Scalar =>
+                  declare
+                     Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+                  begin
+                     Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
+                     Write_String_Id (Sub.Name);
+                     Write_Type_Id (Sub.Basetype, Ctxt);
+                     Write_Range
+                       (Sub.Basetype,
+                        To_Ghdl_Range_Ptr (Loc_To_Addr (Rti.Depth,
+                                                        Sub.Range_Loc,
+                                                        Ctxt)));
+                  end;
+               when Ghdl_Rtik_Type_I32
+                 | Ghdl_Rtik_Type_I64
+                 | Ghdl_Rtik_Type_F64 =>
+                  declare
+                     Base : Ghdl_Rtin_Type_Scalar_Acc;
+                  begin
+                     Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
+                     Write_String_Id (Base.Name);
+                  end;
+               when Ghdl_Rtik_Type_P32
+                 | Ghdl_Rtik_Type_P64 =>
+                  declare
+                     Base : Ghdl_Rtin_Type_Physical_Acc;
+                     Unit : Ghdl_Rti_Access;
+                  begin
+                     Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+                     Write_String_Id (Base.Name);
+                     Wave_Put_ULEB128 (Ghdl_U32 (Base.Nbr));
+                     for I in 1 .. Base.Nbr loop
+                        Unit := Base.Units (I - 1);
+                        Write_String_Id
+                          (Rtis_Utils.Get_Physical_Unit_Name (Unit));
+                        case Unit.Kind is
+                           when Ghdl_Rtik_Unit64 =>
+                              Wave_Put_LSLEB128
+                                (To_Ghdl_Rtin_Unit64_Acc (Unit).Value);
+                           when Ghdl_Rtik_Unitptr =>
+                              case Rti.Kind is
+                                 when Ghdl_Rtik_Type_P64 =>
+                                    Wave_Put_LSLEB128
+                                      (To_Ghdl_Rtin_Unitptr_Acc (Unit).
+                                         Addr.I64);
+                                 when Ghdl_Rtik_Type_P32 =>
+                                    Wave_Put_SLEB128
+                                      (To_Ghdl_Rtin_Unitptr_Acc (Unit).
+                                         Addr.I32);
+                                 when others =>
+                                    Internal_Error
+                                      ("wave.write_types(P32/P64-1)");
+                              end case;
+                           when others =>
+                              Internal_Error
+                                ("wave.write_types(P32/P64-2)");
+                        end case;
+                     end loop;
+                  end;
+               when others =>
+                  Internal_Error ("wave.write_types");
+                  --   Internal_Error ("wave.write_types: does not handle " &
+                  --                   Ghdl_Rtik'Image (Rti.Kind));
+            end case;
+         end if;
+      end loop;
+      Wave_Put_Byte (0);
+   end Write_Types;
+
+   procedure Write_Known_Types
+   is
+      use Grt.Rtis_Types;
+
+      Boolean_Type_Id : AVL_Nid;
+      Bit_Type_Id : AVL_Nid;
+      Std_Ulogic_Type_Id : AVL_Nid;
+
+      function Search_Type_Id (Rti : Ghdl_Rti_Access) return AVL_Nid
+      is
+         Ctxt : Rti_Context;
+         Tid : AVL_Nid;
+      begin
+         Find_Type (Rti, Null_Context, Ctxt, Tid);
+         return Tid;
+      end Search_Type_Id;
+   begin
+      Search_Types_RTI;
+
+      Boolean_Type_Id := Search_Type_Id (Std_Standard_Boolean_RTI_Ptr);
+
+      Bit_Type_Id := Search_Type_Id (Std_Standard_Bit_RTI_Ptr);
+
+      if Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr /= null then
+         Std_Ulogic_Type_Id := Search_Type_Id
+           (Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr);
+      else
+         Std_Ulogic_Type_Id := AVL_Nil;
+      end if;
+
+      Wave_Section ("WKT" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+
+      if Boolean_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (1);
+         Write_Type_Id (Boolean_Type_Id);
+      end if;
+
+      if Bit_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (2);
+         Write_Type_Id (Bit_Type_Id);
+      end if;
+
+      if Std_Ulogic_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (3);
+         Write_Type_Id (Std_Ulogic_Type_Id);
+      end if;
+
+      Wave_Put_Byte (0);
+   end Write_Known_Types;
+
+   --  Table of signals to be dumped.
+   package Dump_Table is new Grt.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 32);
+
+   function Get_Dump_Entry (N : Natural) return Ghdl_Signal_Ptr is
+   begin
+      return Dump_Table.Table (N);
+   end Get_Dump_Entry;
+
+   pragma Unreferenced (Get_Dump_Entry);
+
+   procedure Write_Hierarchy (Root : VhpiHandleT)
+   is
+      N : Natural;
+   begin
+      --  Check Alink is 0.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I).Alink /= null then
+            Internal_Error ("wave.write_hierarchy");
+         end if;
+      end loop;
+
+      Wave_Section ("HIE" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Nbr_Scopes));
+      Wave_Put_I32 (Ghdl_I32 (Nbr_Scope_Signals));
+      Wave_Put_I32 (Ghdl_I32 (Sig_Table.Last - Sig_Table.First + 1));
+      Wave_Put_Hierarchy (Root, Step_Hierarchy);
+      Wave_Put_Byte (0);
+
+      Dump_Table.Set_Last (Nbr_Dumped_Signals);
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Dump_Table.Table (I) := null;
+      end loop;
+
+      --  Save and clear.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         N := Get_Signal_Number (Sig_Table.Table (I));
+         if N /= 0 then
+            if Dump_Table.Table (N) /= null then
+               Internal_Error ("wave.write_hierarchy(2)");
+            end if;
+            Dump_Table.Table (N) := Sig_Table.Table (I);
+            Sig_Table.Table (I).Alink := null;
+         end if;
+      end loop;
+   end Write_Hierarchy;
+
+   procedure Write_Signal_Value (Sig : Ghdl_Signal_Ptr) is
+   begin
+      --  FIXME: for some signals, the significant value is the driving value!
+      Write_Value (Sig.Value, Sig.Mode);
+   end Write_Signal_Value;
+
+   procedure Write_Snapshot is
+   begin
+      Wave_Section ("SNP" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I64 (Ghdl_I64 (Cycle_Time));
+
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Write_Signal_Value (Dump_Table.Table (I));
+      end loop;
+      Wave_Put ("ESN" & NUL);
+   end Write_Snapshot;
+
+   procedure Wave_Cycle;
+
+   --  Called after elaboration.
+   procedure Wave_Start
+   is
+      Root : VhpiHandleT;
+   begin
+      --  Do nothing if there is no VCD file to generate.
+      if Wave_Stream = NULL_Stream then
+         return;
+      end if;
+
+      Write_File_Header;
+
+      --  FIXME: write infos
+      --  * date
+      --  * timescale
+      --  * design name ?
+      --  ...
+
+      --  Put hierarchy.
+      Get_Root_Inst (Root);
+      -- Vcd_Search_Packages;
+      Wave_Put_Hierarchy (Root, Step_Name);
+
+      Freeze_Strings;
+
+      -- Register_Cycle_Hook (Vcd_Cycle'Access);
+      Write_Strings_Compress;
+      Write_Types;
+      Write_Known_Types;
+      Write_Hierarchy (Root);
+
+      --  End of header mark.
+      Wave_Section ("EOH" & NUL);
+
+      Write_Snapshot;
+
+      Register_Cycle_Hook (Wave_Cycle'Access);
+
+      fflush (Wave_Stream);
+   end Wave_Start;
+
+   Wave_Time : Std_Time := 0;
+   In_Cyc : Boolean := False;
+
+   procedure Wave_Close_Cyc
+   is
+   begin
+      Wave_Put_LSLEB128 (-1);
+      Wave_Put ("ECY" & NUL);
+      In_Cyc := False;
+   end Wave_Close_Cyc;
+
+   procedure Wave_Cycle
+   is
+      Diff : Std_Time;
+      Sig : Ghdl_Signal_Ptr;
+      Last : Natural;
+   begin
+      if not In_Cyc then
+         Wave_Section ("CYC" & NUL);
+         Wave_Put_I64 (Ghdl_I64 (Cycle_Time));
+         In_Cyc := True;
+      else
+         Diff := Cycle_Time - Wave_Time;
+         Wave_Put_LSLEB128 (Ghdl_I64 (Diff));
+      end if;
+      Wave_Time := Cycle_Time;
+
+      --  Dump signals.
+      Last := 0;
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Sig := Dump_Table.Table (I);
+         if Sig.Flags.Cyc_Event then
+            Wave_Put_ULEB128 (Ghdl_U32 (I - Last));
+            Last := I;
+            Write_Signal_Value (Sig);
+            Sig.Flags.Cyc_Event := False;
+         end if;
+      end loop;
+      Wave_Put_Byte (0);
+   end Wave_Cycle;
+
+   --  Called at the end of the simulation.
+   procedure Wave_End is
+   begin
+      if Wave_Stream = NULL_Stream then
+         return;
+      end if;
+      if In_Cyc then
+         Wave_Close_Cyc;
+      end if;
+      Wave_Write_Directory;
+      fflush (Wave_Stream);
+   end Wave_End;
+
+   Wave_Hooks : aliased constant Hooks_Type :=
+     (Option => Wave_Option'Access,
+      Help => Wave_Help'Access,
+      Init => Wave_Init'Access,
+      Start => Wave_Start'Access,
+      Finish => Wave_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Wave_Hooks'Access);
+   end Register;
+end Grt.Waves;
diff --git a/src/translate/grt/grt-waves.ads b/src/translate/grt/grt-waves.ads
new file mode 100644
index 000000000..72d7ea6e1
--- /dev/null
+++ b/src/translate/grt/grt-waves.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+package Grt.Waves is
+   procedure Register;
+end Grt.Waves;
diff --git a/src/translate/grt/grt-zlib.ads b/src/translate/grt/grt-zlib.ads
new file mode 100644
index 000000000..9dfee3665
--- /dev/null
+++ b/src/translate/grt/grt-zlib.ads
@@ -0,0 +1,47 @@
+--  GHDL Run Time (GRT) - Zlib binding.
+--  Copyright (C) 2005 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with System; use System;
+with Grt.C; use Grt.C;
+
+package Grt.Zlib is
+   pragma Linker_Options ("-lz");
+
+   type gzFile is new System.Address;
+
+   NULL_gzFile : constant gzFile := gzFile (System'To_Address (0));
+
+   function gzputc (File : gzFile; C : int) return int;
+   pragma Import (C, gzputc);
+
+   function gzwrite (File : gzFile; Buf : voids; Len : int) return int;
+   pragma Import (C, gzwrite);
+
+   function gzopen (Path : chars; Mode : chars) return gzFile;
+   pragma Import (C, gzopen);
+
+   procedure gzclose (File : gzFile);
+   pragma Import (C, gzclose);
+end Grt.Zlib;
diff --git a/src/translate/grt/grt.adc b/src/translate/grt/grt.adc
new file mode 100644
index 000000000..f2284997d
--- /dev/null
+++ b/src/translate/grt/grt.adc
@@ -0,0 +1,46 @@
+--  GHDL Run Time (GRT) - Configuration pragmas.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+--  The GRT library is built with a lot of restrictions.
+--  The purpose of these restrictions (mainly No_Run_Time) is not to link with
+--  the GNAT run time library.  The user does not need to download or compile
+--  it.
+--
+--  However, GRT works without these restrictions.  If you want to use GRT
+--  in Ada, you may compile GRT without these restrictions (remove the -gnatec
+--  flag).
+--
+--  This files is *not* names gnat.adc, in order to ease the possibility of
+--  not using it.
+pragma Restrictions (No_Exception_Handlers);
+--pragma restrictions (No_Exceptions);
+pragma Restrictions (No_Secondary_Stack);
+--pragma Restrictions (No_Elaboration_Code);
+pragma Restrictions (No_Io);
+pragma restrictions (no_dependence => Ada.Tags);
+pragma restrictions (no_dependence => GNAT);
+pragma Restrictions (Max_Tasks => 0);
+pragma Restrictions (No_Implicit_Heap_Allocations);
+pragma No_Run_Time;
diff --git a/src/translate/grt/grt.ads b/src/translate/grt/grt.ads
new file mode 100644
index 000000000..9727d0430
--- /dev/null
+++ b/src/translate/grt/grt.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - Top of hierarchy.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+package Grt is
+   pragma Pure (Grt);
+end Grt;
diff --git a/src/translate/grt/grt.ver b/src/translate/grt/grt.ver
new file mode 100644
index 000000000..031c20761
--- /dev/null
+++ b/src/translate/grt/grt.ver
@@ -0,0 +1,25 @@
+{
+  global:
+vpi_free_object;
+vpi_get;
+vpi_get_str;
+vpi_get_time;
+vpi_get_value;
+vpi_get_vlog_info;
+vpi_handle;
+vpi_handle_by_index;
+vpi_iterate;
+vpi_mcd_close;
+vpi_mcd_name;
+vpi_mcd_open;
+vpi_put_value;
+vpi_register_cb;
+vpi_register_systf;
+vpi_remove_cb;
+vpi_scan;
+vpi_vprintf;
+vpi_printf;
+  local:
+	*;
+};
+
diff --git a/src/translate/grt/main.adb b/src/translate/grt/main.adb
new file mode 100644
index 000000000..5de379449
--- /dev/null
+++ b/src/translate/grt/main.adb
@@ -0,0 +1,32 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+with Ghdl_Main;
+
+function Main (Argc : Integer; Argv : System.Address)
+   return Integer
+is
+begin
+   return Ghdl_Main (Argc, Argv);
+end Main;
diff --git a/src/translate/grt/main.ads b/src/translate/grt/main.ads
new file mode 100644
index 000000000..f7c414274
--- /dev/null
+++ b/src/translate/grt/main.ads
@@ -0,0 +1,34 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  Copyright (C) 2002 - 2014 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.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+--  In the usual case of a standalone executable, this file defines the
+--  standard entry point, ie the main() function.
+--
+--  However, as explained in the manual, the user can use its own main()
+--  function, and calls the ghdl entry point ghdl_main.
+with System;
+
+function Main (Argc : Integer; Argv : System.Address) return Integer;
+pragma Export (C, Main, "main");
diff --git a/src/translate/mcode/Makefile.in b/src/translate/mcode/Makefile.in
new file mode 100644
index 000000000..beb450a08
--- /dev/null
+++ b/src/translate/mcode/Makefile.in
@@ -0,0 +1,54 @@
+PREFIX=/usr/local
+target=i686-pc-linux-gnu
+
+CFLAGS=-O
+GNATFLAGS=$(CFLAGS) -gnatn
+
+GRT_FLAGS=$(CFLAGS)
+
+all: ghdl_mcode std.v93 std.v87 ieee.v93 ieee.v87 synopsys.v93 synopsys.v87 mentor.v93
+
+
+GRTSRCDIR=grt
+
+####grt Makefile.inc
+
+ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) mmap_binding.o force 
+	gnatmake -aIghdldrv -aIghdl -aIortho -aIgrt $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) -Wl,--version-script=$(GRTSRCDIR)/grt.ver -Wl,--export-dynamic
+
+mmap_binding.o: ortho/mmap_binding.c
+	$(CC) -c -g -o $@ $<
+
+default_pathes.ads: Makefile
+	echo "--  DO NOT EDIT" > tmp-dpathes.ads
+	echo "--  This file is created by Makefile" >> tmp-dpathes.ads
+	echo "package Default_Pathes is" >> tmp-dpathes.ads
+	echo "   Prefix : constant String :=">> tmp-dpathes.ads
+	echo "     \"$(PREFIX)/lib/ghdl/\";" >> tmp-dpathes.ads
+	echo "end Default_Pathes;" >> tmp-dpathes.ads
+	if test -r $@ && cmp tmp-dpathes.ads $@; then \
+	  echo "$@ unchanged"; \
+        else \
+	  mv tmp-dpathes.ads $@; \
+        fi
+	$(RM) tmp-dpathes.ads
+
+force:
+
+LIB93_DIR:=./lib/v93
+LIB87_DIR:=./lib/v87
+LIBSRC_DIR:=./libraries
+ANALYZE=../../../ghdl_mcode -a --ieee=none
+REL_DIR=../../..
+VHDLLIBS_COPY_OBJS:=no
+CP=cp
+LN=ln -s
+
+./lib:
+	mkdir $@
+
+$(LIB93_DIR) $(LIB87_DIR): ./lib
+	mkdir $@
+
+
+####libraries Makefile.inc
diff --git a/src/translate/mcode/README b/src/translate/mcode/README
new file mode 100644
index 000000000..a10cd6efc
--- /dev/null
+++ b/src/translate/mcode/README
@@ -0,0 +1,47 @@
+This is the README from the source distribution of GHDL.
+
+To get the binary distribution or more information, go to http://ghdl.free.fr
+
+Copyright:
+**********
+GHDL is copyright (c) 2002, 2003, 2004, 2005 Tristan Gingold.
+See the GHDL manual for more details.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.
+
+
+Building GHDL from sources for Windows:
+***************************************
+
+Note: this was tested with Windows XP SP2 familly edition.
+
+Note: If you want to create the installer, GHDL should be built on a
+FAT partition.  NSIS rounds files date to be FAT compliant (seconds are always
+even) and because GHDL stores dates, the files date must not be modified.
+
+Required:
+* the Ada95 GNAT compiler (GNAT GPL 2005 is known to work).
+* NSIS to create the installer.
+
+Unzip,
+edit winbuild to use correct path for makensis,
+run winbuild.
+
+The installer is in the windows directory.
+
+Send bugs and comments on http://gna.org/project/ghdl
+
+Tristan Gingold.
diff --git a/src/translate/mcode/dist.sh b/src/translate/mcode/dist.sh
new file mode 100755
index 000000000..cf24141de
--- /dev/null
+++ b/src/translate/mcode/dist.sh
@@ -0,0 +1,506 @@
+#!/bin/sh
+
+#  Script used to create tar balls.
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+# Building a distribution:
+# * update the 'version' variable in ../../Makefile
+# * Regenerate version.ads: make -f ../../Makefile version.ads
+# * Check NEWS, README and INSTALL files.
+# * Check version and copyright years in doc/ghdl.texi, ghdlmain.adb
+# * Check GCCVERSION below.
+# * Check lists of exported files in this file.
+# * Create source tar and build binaries: ./dist.sh dist_phase1
+# * su root
+# * Build binary tar: ./dist.sh dist_phase2
+# * Run the testsuites: GHDL=ghdl ./testsuite.sh
+# * Update website/index.html (./dist.sh website helps, rename .new)
+# * upload (./dist upload)
+# * CVS commit, tag + cd image.
+# * remove previous version in /usr/local
+
+## DO NOT MODIFY this file while it is running...
+
+set -e
+
+# GTKWave version.
+GTKWAVE_VERSION=1.3.72
+
+# GHDL version (extracted from version.ads)
+VERSION=`sed -n -e 's/.*GHDL \([0-9.a-z]*\) (.*/\1/p' ../../version.ads`
+
+CWD=`pwd`
+
+distdir=ghdl-$VERSION
+tarfile=$distdir.tar
+zipfile=$distdir.zip
+
+PREFIX=/usr/local
+bindirname=ghdl-$VERSION-i686-pc-linux
+TARINSTALL=$DISTDIR/$bindirname.tar.bz2
+VHDLDIR=$distdir/vhdl
+DOWNLOAD_HTML=../../website/download.html
+DESTDIR=$CWD/
+UNSTRIPDIR=${distdir}-unstripped
+
+PATH=/usr/gnat/bin:$PATH
+
+do_clean ()
+{
+  rm -rf $distdir
+  mkdir $distdir
+  mkdir $distdir/ghdl
+  mkdir $distdir/ghdldrv
+  mkdir $distdir/libraries
+  mkdir $distdir/libraries/std $distdir/libraries/ieee
+  mkdir $distdir/libraries/vital95 $distdir/libraries/vital2000
+  mkdir $distdir/libraries/synopsys $distdir/libraries/mentor
+  mkdir $distdir/grt
+  mkdir $distdir/grt/config
+  mkdir $distdir/ortho
+  mkdir $distdir/windows
+}
+
+# Build Makefile
+do_Makefile ()
+{
+  sed -e "/^####libraries Makefile.inc/r ../../libraries/Makefile.inc" \
+      -e "/^####grt Makefile.inc/r ../grt/Makefile.inc" \
+     < Makefile.in > $distdir/Makefile
+}
+
+# Copy (or link) sources files into $distdir
+do_files ()
+{
+. ../gcc/dist-common.sh
+
+ortho_mcode_files="
+binary_file-elf.adb
+binary_file-elf.ads
+binary_file-memory.adb
+binary_file-memory.ads
+binary_file.adb
+binary_file.ads
+disa_x86.adb
+disa_x86.ads
+disassemble.ads
+dwarf.ads
+elf32.adb
+elf32.ads
+elf64.ads
+elf_common.adb
+elf_common.ads
+elf_arch32.ads
+elf_arch.ads
+hex_images.adb
+hex_images.ads
+memsegs.ads
+memsegs_mmap.ads
+memsegs_mmap.adb
+memsegs_c.c
+ortho_code-abi.ads
+ortho_code-binary.adb
+ortho_code-binary.ads
+ortho_code-consts.adb
+ortho_code-consts.ads
+ortho_code-debug.adb
+ortho_code-debug.ads
+ortho_code-decls.adb
+ortho_code-decls.ads
+ortho_code-disps.adb
+ortho_code-disps.ads
+ortho_code-dwarf.adb
+ortho_code-dwarf.ads
+ortho_code-exprs.adb
+ortho_code-exprs.ads
+ortho_code-flags.ads
+ortho_code-opts.adb
+ortho_code-opts.ads
+ortho_code-types.adb
+ortho_code-types.ads
+ortho_code-sysdeps.adb
+ortho_code-sysdeps.ads
+ortho_code-x86-emits.adb
+ortho_code-x86-emits.ads
+ortho_code-x86-insns.adb
+ortho_code-x86-insns.ads
+ortho_code-x86-abi.adb
+ortho_code-x86-abi.ads
+ortho_code-x86-flags.ads
+ortho_code-x86.adb
+ortho_code-x86.ads
+ortho_code.ads
+ortho_code_main.adb
+ortho_ident.adb
+ortho_ident.ads
+ortho_mcode.adb
+ortho_mcode.ads
+ortho_nodes.ads
+"
+
+windows_files="
+compile.bat
+complib.bat
+default_pathes.ads
+ghdl.nsi
+windows_default_path.adb
+windows_default_path.ads
+ghdlfilter.adb
+ortho_code-sysdeps.adb
+grt-modules.adb
+"
+
+drv_files="
+ghdlcomp.ads
+ghdlcomp.adb
+foreigns.ads
+foreigns.adb
+ghdlrun.adb
+ghdlrun.ads
+ghdl_mcode.adb
+"
+
+for i in $cfiles; do ln -sf $CWD/../../$i $distdir/ghdl/$i; done
+for i in $tfiles; do ln -sf $CWD/../$i $distdir/ghdl/$i; done
+
+ln -sf $CWD/../../doc/ghdl.texi $distdir/ghdl.texi
+
+for i in $ortho_files; do ln -sf $CWD/../../ortho/$i $distdir/ortho/$i; done
+
+for i in $ortho_mcode_files; do
+  ln -sf $CWD/../../ortho/mcode/$i $distdir/ortho/$i
+done
+
+for i in $ghdl_files $drv_files; do
+  ln -sf $CWD/../ghdldrv/$i $distdir/ghdldrv/$i
+done
+
+for i in $libraries_files; do
+    ln -sf $CWD/../../libraries/$i $distdir/libraries/$i
+done
+
+for i in $grt_files; do
+    ln -sf $CWD/../grt/$i $distdir/grt/$i
+done
+
+for i in $grt_config_files; do
+    ln -sf $CWD/../grt/config/$i $distdir/grt/config/$i
+done
+
+for i in $windows_files; do
+    ln -sf $CWD/windows/$i $distdir/windows/$i
+done
+    echo "!define VERSION \"$VERSION\"" > $distdir/windows/version.nsi
+
+
+    ln -sf $CWD/winbuild.bat $distdir/winbuild.bat
+
+makeinfo --html --no-split -o $distdir/windows/ghdl.htm $CWD/../../doc/ghdl.texi 
+}
+
+do_sources_dir ()
+{
+    \rm -rf $distdir
+    mkdir $distdir
+    do_clean
+    do_Makefile
+    do_files
+    ln -sf ../../../COPYING $distdir
+}
+
+# Create the tar of sources.
+do_tar ()
+{
+    do_sources_dir
+    tar cvhf $tarfile $distdir
+    bzip2 -f $tarfile
+    rm -rf $distdir
+}
+
+# Create the zip of sources.
+do_zip ()
+{
+    do_sources_dir
+    zip -r $zipfile $distdir
+    rm -rf $distdir
+}
+
+# Extract the source, configure and make.
+do_compile ()
+{
+  set -x
+
+  do_update_gcc_sources;
+
+  rm -rf $GCCDISTOBJ
+  mkdir $GCCDISTOBJ
+  cd $GCCDISTOBJ
+  ../gcc-$GCCVERSION/configure --enable-languages=vhdl --prefix=$PREFIX
+  make CFLAGS="-O -g"
+  make -C gcc vhdl.info
+  cd $CWD
+}
+
+check_root ()
+{
+  if [ $UID -ne 0 ]; then
+    echo "$0: you must be root";
+    exit 1;
+  fi
+}
+
+#  Do a make install
+do_compile2 ()
+{
+  set -x
+  cd $GCCDISTOBJ
+  # Check the info file is not empty.
+  if [ -s gcc/doc/ghdl.info ]; then
+    echo "info file found"
+  else
+    echo "Error: ghdl.info not found".
+    exit 1;
+  fi
+  mkdir -p $DESTDIR/usr/local || true
+  make DESTDIR=$DESTDIR install
+  cd $CWD
+  if [ -d $UNSTRIPDIR ]; then
+     rm -rf $UNSTRIPDIR
+  fi
+  mkdir $UNSTRIPDIR
+  cp ${DESTDIR}${GCCLIBEXECDIR}/ghdl1 ${DESTDIR}${PREFIX}/bin/ghdl $UNSTRIPDIR
+  chmod -w $UNSTRIPDIR/*
+  strip ${DESTDIR}${GCCLIBEXECDIR}/ghdl1 ${DESTDIR}${PREFIX}/bin/ghdl
+}
+
+# Create the tar file from the current installation.
+do_tar_install ()
+{
+  tar -C $DESTDIR -jcvf $TARINSTALL \
+    ./$PREFIX/bin/ghdl ./$PREFIX/info/ghdl.info \
+    ./$GCCLIBDIR/vhdl \
+    ./$GCCLIBEXECDIR/ghdl1
+}
+
+do_extract_tar_install ()
+{
+  check_root;
+  cd /
+  tar jxvf $TARINSTALL
+  cd $CWD
+}
+
+# Create the tar file to be distributed.
+do_tar_dist ()
+{
+  rm -rf $bindirname
+  mkdir $bindirname
+  sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL
+  ln ../../COPYING $bindirname
+  ln $TARINSTALL $bindirname
+  tar cvf $bindirname.tar $bindirname
+}
+
+# Remove the non-ghdl files of gcc in the current installation.
+do_distclean_gcc ()
+{
+  set -x
+  rm -f ${DESTDIR}${PREFIX}/bin/cpp ${DESTDIR}${PREFIX}/bin/gcc
+  rm -f ${DESTDIR}${PREFIX}/bin/gccbug ${DESTDIR}${PREFIX}/bin/gcov
+  rm -f ${DESTDIR}${PREFIX}/bin/${MACHINE}-gcc*
+  rm -f ${DESTDIR}${PREFIX}/info/cpp.info*
+  rm -f ${DESTDIR}${PREFIX}/info/cppinternals.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gcc.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gccinstall.info*
+  rm -f ${DESTDIR}${PREFIX}/info/gccint.info*
+  rm -f ${DESTDIR}${PREFIX}/lib/*.a ${DESTDIR}${PREFIX}/lib/*.so*
+  rm -rf ${DESTDIR}${PREFIX}/share
+  rm -rf ${DESTDIR}${PREFIX}/man
+  rm -rf ${DESTDIR}${PREFIX}/include
+  rm -f ${DESTDIR}${GCCLIBEXECDIR}/cc1 ${DESTDIR}${GCCLIBEXECDIR}/collect2
+  rm -f ${DESTDIR}${GCCLIBEXECDIR}/cpp0 ${DESTDIR}${GCCLIBEXECDIR}/tradcpp0
+  rm -f ${DESTDIR}${GCCLIBDIR}/*.o ${DESTDIR}$GCCLIBDIR/*.a
+  rm -f ${DESTDIR}${GCCLIBDIR}/specs
+  rm -rf ${DESTDIR}${GCCLIBDIR}/include
+  rm -rf ${DESTDIR}${GCCLIBDIR}/install-tools
+  rm -rf ${DESTDIR}${GCCLIBEXECDIR}/install-tools
+}
+
+# Remove ghdl files in the current installation.
+do_distclean_ghdl ()
+{
+  check_root;
+  set -x
+  rm -f $PREFIX/bin/ghdl
+  rm -f $PREFIX/info/ghdl.info*
+  rm -f $GCCLIBEXECDIR/ghdl1
+  rm -rf $GCCLIBDIR/vhdl
+}
+
+# Build the source tar, and build the binaries.
+do_dist_phase1 ()
+{
+  do_sources;
+  do_compile;
+  do_compile2;
+  do_distclean_gcc;
+  do_tar_install;
+  do_tar_dist;
+  rm -rf ./$PREFIX
+}
+
+# Install the binaries and create the binary tar.
+do_dist_phase2 ()
+{
+  check_root;
+  do_distclean_ghdl;
+  do_extract_tar_install;
+  echo "dist_phase2 success"
+}
+
+# Create gtkwave patch
+do_gtkwave_patch ()
+{
+#  rm -rf gtkwave-patch
+  mkdir gtkwave-patch
+  diff -rc -x Makefile.in $GTKWAVE_BASE.orig $GTKWAVE_BASE | \
+    sed -e "/^Only in/d" \
+    > gtkwave-patch/gtkwave-$GTKWAVE_VERSION.diffs
+  cp ../grt/ghwlib.c ../grt/ghwlib.h $GTKWAVE_BASE/src/ghw.c gtkwave-patch
+  sed -e "s/VERSION/$GTKWAVE_VERSION/g" < README.gtkwave > gtkwave-patch/README
+  tar zcvf ../../website/gtkwave-patch.tgz gtkwave-patch
+  rm -rf gtkwave-patch
+}
+
+# Update the index.html
+# Update the doc
+do_website ()
+{
+  sed -e "
+/SRC-HREF/ s/href=\".*\"/href=\"$tarfile.bz2\"/
+/BIN-HREF/ s/href=\".*\"/href=\"$bindirname.tar\"/
+/HISTORY/ a \\
+      <tr>\\
+	<td>$VERSION</td>\\
+        <td>`date +'%b %e %Y'`</td>\\
+        <td>$GCCVERSION</td>\\
+	<td><a href=\"$tarfile.bz2\">$tarfile.bz2</a></td>\\
+	<td><a href=\"$bindirname.tar\">\\
+	    $bindirname.tar</a></td>\\
+      </tr>
+" < $DOWNLOAD_HTML > "$DOWNLOAD_HTML".new
+  dir=../../website/ghdl
+  echo "Updating $dir"
+  rm -rf $dir
+  makeinfo --html -o $dir ../../doc/ghdl.texi
+}
+
+# Do ftp commands to upload
+do_upload ()
+{
+if tty -s; then
+  echo -n "Please, enter password: "
+  stty -echo
+  read pass
+  stty echo
+  echo
+else
+  echo "$0: upload must be done from a tty"
+  exit 1;
+fi
+ftp -n <<EOF
+open ftpperso.free.fr
+user ghdl $pass
+prompt
+hash
+bin
+passive
+put $tarfile.bz2
+put $bindirname.tar
+put INSTALL
+lcd ../../website
+put NEWS
+put index.html
+put download.html
+put features.html
+put roadmap.html
+put manual.html
+put more.html
+put links.html
+put bug.html
+put waveviewer.html
+put gtkwave-patch.tgz
+put favicon.ico
+lcd ghdl
+cd ghdl
+mput \*
+bye
+EOF
+}
+
+if [ $# -eq 0 ]; then
+  do_zip;
+else
+  for i ; do
+    case $i in
+      clean)
+        do_clean ;;
+      Makefile|makefile)
+	do_Makefile ;;
+      files)
+        do_files ;;
+      sources)
+        do_sources_dir ;;
+      tar)
+        do_tar ;;
+      zip)
+        do_zip ;;
+      compile)
+        do_compile;;
+      update_gcc)
+        do_update_gcc_sources;;
+      compile2)
+        do_compile2;;
+      tar_install)
+        do_tar_install;;
+      tar_dist)
+        do_tar_dist;;
+      -v | --version | version)
+        echo $VERSION
+        exit 0
+        ;;
+      website)
+        do_website;;
+      upload)
+        do_upload;;
+      distclean_gcc)
+        do_distclean_gcc;;
+      distclean_ghdl)
+        do_distclean_ghdl;;
+      dist_phase1)
+        do_dist_phase1;;
+      dist_phase2)
+        do_dist_phase2;;
+      gtkwave_patch)
+        do_gtkwave_patch;;
+      *)
+	echo "usage: $0 clean|Makefile|files|all"
+	exit 1 ;;
+     esac
+   done
+fi
diff --git a/src/translate/mcode/winbuild.bat b/src/translate/mcode/winbuild.bat
new file mode 100644
index 000000000..8c2826852
--- /dev/null
+++ b/src/translate/mcode/winbuild.bat
@@ -0,0 +1,18 @@
+call windows\compile

+if errorlevel 1 goto end

+

+call windows\complib

+if errorlevel 1 goto end

+

+gnatmake windows/ghdlversion -o windows/ghdlversion.exe

+windows\ghdlversion < ../../version.ads > windows/version.nsi

+

+"c:\Program Files\NSIS\makensis" windows\ghdl.nsi

+if errorlevel 1 goto end

+

+exit /b 0

+

+:end

+echo "Error during compilation"

+exit /b 1

+

diff --git a/src/translate/mcode/windows/compile.bat b/src/translate/mcode/windows/compile.bat
new file mode 100644
index 000000000..c668ef0e2
--- /dev/null
+++ b/src/translate/mcode/windows/compile.bat
@@ -0,0 +1,24 @@
+mkdir build

+cd build

+

+rem Do the compilation

+set CFLAGS=-O -g

+gcc -c %CFLAGS% ../../grt/grt-cbinding.c

+gcc -c %CFLAGS% ../../grt/grt-cvpi.c

+gcc -c %CFLAGS% ../../grt/config/clock.c

+gcc -c %CFLAGS% ../../../ortho/mcode/memsegs_c.c

+gcc -c %CFLAGS% -DWITH_GNAT_RUN_TIME ../../grt/config/win32.c

+gnatmake %CFLAGS% -gnatn -aI../windows -aI../../.. -aI../.. -aI../../ghdldrv -aI../../../psl -aI../../grt -aI../../../ortho/mcode ghdl_mcode -aI../../../ortho -o ghdl.exe -largs grt-cbinding.o clock.o grt-cvpi.o memsegs_c.o win32.o -largs -Wl,--stack,8404992

+

+if errorlevel 1 goto failed

+

+strip ghdl.exe

+

+cd ..

+exit /b 0

+

+:failed

+echo "Compilation failed"

+cd ..

+exit /b 1

+


diff --git a/src/translate/mcode/windows/complib.bat b/src/translate/mcode/windows/complib.bat
new file mode 100644
index 000000000..88a43ce60
--- /dev/null
+++ b/src/translate/mcode/windows/complib.bat
@@ -0,0 +1,68 @@
+set GHDL=ghdl

+

+cd build

+gnatmake -aI..\windows ghdlfilter

+cd ..

+

+set REL=..\..\..

+set LIBSRC=%REL%\..\..\libraries

+set STD_SRCS=textio textio_body

+set IEEE_SRCS=std_logic_1164 std_logic_1164_body numeric_std numeric_std-body numeric_bit numeric_bit-body

+set VITAL95_SRCS=vital_timing vital_timing_body vital_primitives vital_primitives_body

+set VITAL2000_SRCS=timing_p timing_b prmtvs_p prmtvs_b memory_p memory_b

+

+set SYNOPSYS_SRCS=std_logic_arith std_logic_textio std_logic_unsigned std_logic_signed std_logic_misc std_logic_misc-body

+

+mkdir lib

+cd lib

+

+mkdir v87

+cd v87

+

+mkdir std

+cd std

+for %%F in (%STD_SRCS%) do %REL%\build\ghdlfilter -v87 < %LIBSRC%\std\%%F.vhdl > %%F.v87 && %REL%\build\%GHDL% -a --std=87 --bootstrap --work=std %%F.v87

+cd ..

+

+mkdir ieee

+cd ieee

+rem Base ieee

+for %%F in (%IEEE_SRCS%) do %REL%\build\ghdlfilter -v87 < %LIBSRC%\ieee\%%F.vhdl > %%F.v87 && %REL%\build\%GHDL% -a --std=87 -P..\std --work=ieee %%F.v87

+rem Vital 95

+for %%F in (%VITAL95_SRCS%) do copy %LIBSRC%\vital95\%%F.vhdl %%F.vhd && %REL%\build\%GHDL% -a --std=87 -P..\std --work=ieee %%F.vhd

+cd ..

+

+mkdir synopsys

+cd synopsys

+for %%F in (%IEEE_SRCS%) do %REL%\build\%GHDL% -a --std=87 -P..\std --work=ieee ..\ieee\%%F.v87

+for %%F in (%VITAL95_SRCS%) do %REL%\build\%GHDL% -a --std=87 -P..\std --work=ieee ..\ieee\%%F.vhd

+for %%F in (%SYNOPSYS_SRCS%) do copy %LIBSRC%\synopsys\%%F.vhdl %%F.vhd && %REL%\build\%GHDL% -a --std=87 -P..\std --work=ieee %%F.vhd

+cd ..

+

+cd ..

+mkdir v93

+cd v93

+

+mkdir std

+cd std

+for %%F in (%STD_SRCS%) do %REL%\build\ghdlfilter -v93 < %LIBSRC%\std\%%F.vhdl > %%F.v93 && %REL%\build\%GHDL% -a --std=93 --bootstrap --work=std %%F.v93

+cd ..

+

+mkdir ieee

+cd ieee

+echo Base ieee

+for %%F in (%IEEE_SRCS%) do %REL%\build\ghdlfilter -v93 < %LIBSRC%\ieee\%%F.vhdl > %%F.v93 && %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee %%F.v93

+echo Vital 2000

+for %%F in (%VITAL2000_SRCS%) do copy %LIBSRC%\vital2000\%%F.vhdl %%F.vhd && %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee %%F.vhd

+cd ..

+

+mkdir synopsys

+cd synopsys

+for %%F in (%IEEE_SRCS%) do %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee ..\ieee\%%F.v93

+for %%F in (%VITAL2000_SRCS%) do %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee ..\ieee\%%F.vhd

+for %%F in (%SYNOPSYS_SRCS%) do %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee ..\..\v87\synopsys\%%F.vhd

+cd ..

+

+cd ..

+

+cd ..

diff --git a/src/translate/mcode/windows/default_pathes.ads b/src/translate/mcode/windows/default_pathes.ads
new file mode 100644
index 000000000..51b350f4e
--- /dev/null
+++ b/src/translate/mcode/windows/default_pathes.ads
@@ -0,0 +1,8 @@
+with Windows_Default_Path;

+pragma Elaborate_All (Windows_Default_Path);

+

+package Default_Pathes is

+   Install_Prefix : constant String :=

+     Windows_Default_Path.Get_Windows_Exec_Path;

+   Lib_Prefix : constant String := "lib";

+end Default_Pathes;

diff --git a/src/translate/mcode/windows/ghdl.nsi b/src/translate/mcode/windows/ghdl.nsi
new file mode 100644
index 000000000..aa4d559aa
--- /dev/null
+++ b/src/translate/mcode/windows/ghdl.nsi
@@ -0,0 +1,455 @@
+; ghdl.nsi

+;

+; This script is based on example2.nsi.

+;  remember the directory, 

+;  Check if administrator

+;  uninstall support

+; TODO:

+;  * allow multiple version

+;  * command line installation

+;  * Allow user install

+

+;--------------------------------

+!include version.nsi

+;--------------------------------

+

+; The name of the installer

+Name "Ghdl"

+

+; The file to write

+OutFile "ghdl-installer-${VERSION}.exe"

+

+SetDateSave on

+

+; The default installation directory

+InstallDir $PROGRAMFILES\Ghdl

+

+; Registry key to check for directory (so if you install again, it will 

+; overwrite the old one automatically)

+InstallDirRegKey HKLM "Software\Ghdl" "Install_Dir"

+

+LicenseData ..\..\..\COPYING

+; LicenseForceSelection

+

+;--------------------------------

+

+; Pages

+

+Page license

+Page components

+Page directory

+Page instfiles

+

+UninstPage uninstConfirm

+UninstPage instfiles

+

+;--------------------------------

+Function .onInit

+  Call IsNT

+  pop $R0

+  StrCmp $R0 1 nt_ok

+  MessageBox MB_OK|MB_ICONEXCLAMATION "You must use Windows NT (XP/2000/Me...)"

+  Quit

+

+nt_ok:

+  Call IsUserAdmin

+  Pop $R0

+  StrCmp $R0 "true" Admin

+  MessageBox MB_OK|MB_ICONEXCLAMATION "You must have Admin rights"

+  Quit

+

+Admin:

+

+  ;;;  Check if already installed.

+  ReadRegStr $0 HKLM "Software\Ghdl" "Install_Dir"

+  IfErrors not_installed

+  ReadRegStr $0 HKLM "Software\Ghdl" "Version"

+  IfErrors unknown_prev_version

+  Goto known_version

+unknown_prev_version:

+  StrCpy $0 "(unknown)"

+known_version:

+  MessageBox MB_OKCANCEL|MB_ICONEXCLAMATION "You already have GHDL version $0 installed.  Deinstall ?" IDCANCEL install_abort IDOK deinstall

+install_abort:

+  Abort "Installation aborted"

+deinstall:

+  ReadRegStr $0 HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl" "UninstallString"

+  IfErrors deinstall_failed

+

+  ; First version of the GHDL installer adds quotes

+  StrCpy $1 $0 1

+  StrCmp $1 '"' 0 str_ok

+  StrCpy $1 $0 "" 1

+  StrCpy $0 $1 -1

+str_ok:

+

+  ; Read install dir

+  ReadRegStr $1 HKLM "Software\Ghdl" "Install_Dir"

+  IfErrors deinstall_failed

+

+;  MessageBox MB_OK 'copy $0 to $TEMP'

+

+  ClearErrors

+;  MessageBox MB_OK 'copy $0 to $TEMP'

+  CopyFiles $0 $TEMP

+  IfErrors deinstall_failed

+  ExecWait '"$TEMP\uninst-ghdl.exe" /S _?=$1'

+  IfErrors deinstall_failed

+  Delete "$TEMP\uninst-ghdl.exe"

+  Return

+deinstall_failed:

+  Delete $TEMP\uninst-ghdl.exe

+  MessageBox MB_YESNO|MB_ICONSTOP "Can't deinstall GHDL: de-installer not found or failed.  Continue installation ?" IDNO install_abort

+not_installed:

+  Return

+FunctionEnd

+

+;--------------------------------

+

+; The stuff to install

+Section "Ghdl Compiler (required)"

+

+  SectionIn RO

+  

+  ; Set output path to the installation directory.

+  SetOutPath $INSTDIR\bin

+  File /oname=ghdl.exe ..\build\ghdl.exe

+  

+  SetOutPath $INSTDIR

+  File /oname=COPYING.txt ..\..\..\COPYING

+

+  ; Write the installation path into the registry

+  WriteRegStr HKLM "Software\Ghdl" "Install_Dir" $INSTDIR

+  ; Write te version

+  WriteRegStr HKLM "Software\Ghdl" "Version" ${VERSION}

+  

+  ; Write the uninstall keys for Windows

+  WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl" "DisplayName" "Ghdl"

+  WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl" "UninstallString" $INSTDIR\uninst-ghdl.exe

+  WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl" "NoModify" 1

+  WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl" "NoRepair" 1

+  WriteUninstaller $INSTDIR\uninst-ghdl.exe"

+  

+SectionEnd

+

+Section "VHDL standard and ieee libraries"

+  SectionIn RO

+  SetOutPath $INSTDIR\lib\v87

+  File /r ..\lib\v87\std ..\lib\v87\ieee

+  SetOutPath $INSTDIR\lib\v93

+  File /r ..\lib\v93\std ..\lib\v93\ieee

+SectionEnd

+

+Section "Synopsys libraries (Recommended)"

+  SetOutPath $INSTDIR\lib\v87

+  File /r ..\lib\v87\synopsys

+  SetOutPath $INSTDIR\lib\v93

+  File /r ..\lib\v93\synopsys

+SectionEnd

+

+Section "Documentation (Recommended)"

+  SetOutPath $INSTDIR

+  File /oname=ghdl.htm ..\..\..\doc\ghdl.html

+SectionEnd

+

+Section "Add in PATH (Recommended)"

+  WriteRegDWORD HKLM "Software\Ghdl" "PathSet" 1

+  Push $INSTDIR\Bin

+  Call AddToPath

+SectionEnd

+

+; Optional section (can be disabled by the user)

+;Section "Start Menu Shortcuts"

+;

+;  CreateDirectory "$SMPROGRAMS\Ghdl"

+;  CreateShortCut "$SMPROGRAMS\Ghdl\Uninstall.lnk" "$INSTDIR\uninstall.exe" "" "$INSTDIR\uninstall.exe" 0

+;  CreateShortCut "$SMPROGRAMS\Ghdl\Ghdl.lnk" "$INSTDIR\example2.nsi" "" "$INSTDIR\example2.nsi" 0

+;  

+;SectionEnd

+;

+

+;--------------------------------

+

+; Uninstaller

+

+Section "Uninstall"

+

+  ReadRegDWORD $0 HKLM "Software\Ghdl" "PathSet"

+  StrCmp $0 "1" "" path_not_set

+  Push $INSTDIR\Bin

+  Call un.RemoveFromPath

+

+path_not_set:

+

+  ; Remove registry keys

+  DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Ghdl"

+  DeleteRegKey HKLM Software\Ghdl

+

+  ; Remove files and uninstaller

+  Delete $INSTDIR\bin\ghdl.exe

+  Delete $INSTDIR\uninst-ghdl.exe

+  Delete $INSTDIR\COPYING.txt

+  RMDir $INSTDIR\bin

+  RMDir /r $INSTDIR\lib

+

+

+  ; Remove shortcuts, if any

+  ; Delete "$SMPROGRAMS\Ghdl\*.*"

+

+  ; Remove directories used

+  ; RMDir "$SMPROGRAMS\Ghdl"

+  RMDir "$INSTDIR"

+

+SectionEnd

+

+;;;;;;;; Misc functions

+

+; Author: Lilla (lilla@earthlink.net) 2003-06-13

+; function IsUserAdmin uses plugin \NSIS\PlusgIns\UserInfo.dll

+; This function is based upon code in \NSIS\Contrib\UserInfo\UserInfo.nsi

+; This function was tested under NSIS 2 beta 4 (latest CVS as of this writing).

+;

+; Usage:

+;   Call IsUserAdmin

+;   Pop $R0   ; at this point $R0 is "true" or "false"

+;

+Function IsUserAdmin

+Push $R0

+Push $R1

+Push $R2

+ 

+ClearErrors

+UserInfo::GetName

+IfErrors Win9x

+Pop $R1

+UserInfo::GetAccountType

+Pop $R2

+ 

+StrCmp $R2 "Admin" 0 Continue

+; Observation: I get here when running Win98SE. (Lilla)

+; The functions UserInfo.dll looks for are there on Win98 too, 

+; but just don't work. So UserInfo.dll, knowing that admin isn't required

+; on Win98, returns admin anyway. (per kichik)

+; MessageBox MB_OK 'User "$R1" is in the Administrators group'

+StrCpy $R0 "true"

+Goto Done

+ 

+Continue:

+; You should still check for an empty string because the functions

+; UserInfo.dll looks for may not be present on Windows 95. (per kichik)

+StrCmp $R2 "" Win9x

+StrCpy $R0 "false"

+;MessageBox MB_OK 'User "$R1" is in the "$R2" group'

+Goto Done

+ 

+Win9x:

+; comment/message below is by UserInfo.nsi author:

+; This one means you don't need to care about admin or

+; not admin because Windows 9x doesn't either

+;MessageBox MB_OK "Error! This DLL can't run under Windows 9x!"

+StrCpy $R0 "true"

+ 

+Done:

+;MessageBox MB_OK 'User= "$R1"  AccountType= "$R2"  IsUserAdmin= "$R0"'

+ 

+Pop $R2

+Pop $R1

+Exch $R0

+FunctionEnd

+

+

+!define ALL_USERS

+ 

+!ifndef WriteEnvStr_RegKey

+  !ifdef ALL_USERS

+    !define WriteEnvStr_RegKey \

+       'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"'

+  !else

+    !define WriteEnvStr_RegKey 'HKCU "Environment"'

+  !endif

+!endif

+

+!verbose 3

+!include "WinMessages.NSH"

+!verbose 4

+

+; AddToPath - Adds the given dir to the search path.

+;        Input - head of the stack

+;        Note - Win9x systems requires reboot

+ 

+Function AddToPath

+  Exch $0

+  Push $1

+  Push $2

+  Push $3

+ 

+  # don't add if the path doesn't exist

+  IfFileExists "$0\*.*" "" AddToPath_done

+ 

+  ReadEnvStr $1 PATH

+  Push "$1;"

+  Push "$0;"

+  Call StrStr

+  Pop $2

+  StrCmp $2 "" "" AddToPath_done

+  Push "$1;"

+  Push "$0\;"

+  Call StrStr

+  Pop $2

+  StrCmp $2 "" "" AddToPath_done

+  GetFullPathName /SHORT $3 $0

+  Push "$1;"

+  Push "$3;"

+  Call StrStr

+  Pop $2

+  StrCmp $2 "" "" AddToPath_done

+  Push "$1;"

+  Push "$3\;"

+  Call StrStr

+  Pop $2

+  StrCmp $2 "" "" AddToPath_done

+ 

+  ReadRegStr $1 ${WriteEnvStr_RegKey} "PATH"

+  StrCpy $2 $1 1 -1 # copy last char

+  StrCmp $2 ";" 0 +2 # if last char == ;

+    StrCpy $1 $1 -1 # remove last char

+  StrCmp $1 "" AddToPath_NTdoIt

+    StrCpy $0 "$1;$0"

+ AddToPath_NTdoIt:

+   WriteRegExpandStr ${WriteEnvStr_RegKey} "PATH" $0

+   SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000

+ 

+  AddToPath_done:

+    Pop $3

+    Pop $2

+    Pop $1

+    Pop $0

+FunctionEnd

+ 

+; RemoveFromPath - Remove a given dir from the path

+;     Input: head of the stack

+ 

+Function un.RemoveFromPath

+  Exch $0

+  Push $1

+  Push $2

+  Push $3

+  Push $4

+  Push $5

+  Push $6

+ 

+  IntFmt $6 "%c" 26 # DOS EOF

+ 

+  ReadRegStr $1 ${WriteEnvStr_RegKey} "PATH"

+  StrCpy $5 $1 1 -1 # copy last char

+  StrCmp $5 ";" +2 # if last char != ;

+    StrCpy $1 "$1;" # append ;

+  Push $1

+  Push "$0;"

+  Call un.StrStr ; Find `$0;` in $1

+  Pop $2 ; pos of our dir

+  StrCmp $2 "" unRemoveFromPath_done

+    ; else, it is in path

+    # $0 - path to add

+    # $1 - path var

+    StrLen $3 "$0;"

+    StrLen $4 $2

+    StrCpy $5 $1 -$4 # $5 is now the part before the path to remove

+    StrCpy $6 $2 "" $3 # $6 is now the part after the path to remove

+    StrCpy $3 $5$6

+ 

+    StrCpy $5 $3 1 -1 # copy last char

+    StrCmp $5 ";" 0 +2 # if last char == ;

+      StrCpy $3 $3 -1 # remove last char

+ 

+    WriteRegExpandStr ${WriteEnvStr_RegKey} "PATH" $3

+    SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000

+ 

+  unRemoveFromPath_done:

+    Pop $6

+    Pop $5

+    Pop $4

+    Pop $3

+    Pop $2

+    Pop $1

+    Pop $0

+FunctionEnd

+

+###########################################

+#            Utility Functions            #

+###########################################

+ 

+; IsNT

+; no input

+; output, top of the stack = 1 if NT or 0 if not

+;

+; Usage:

+;   Call IsNT

+;   Pop $R0

+;  ($R0 at this point is 1 or 0)

+ 

+!macro IsNT un

+Function ${un}IsNT

+  Push $0

+  ReadRegStr $0 HKLM "SOFTWARE\Microsoft\Windows NT\CurrentVersion" CurrentVersion

+  StrCmp $0 "" 0 IsNT_yes

+  ; we are not NT.

+  Pop $0

+  Push 0

+  Return

+ 

+  IsNT_yes:

+    ; NT!!!

+    Pop $0

+    Push 1

+FunctionEnd

+!macroend

+!insertmacro IsNT ""

+;!insertmacro IsNT "un."

+ 

+; StrStr

+; input, top of stack = string to search for

+;        top of stack-1 = string to search in

+; output, top of stack (replaces with the portion of the string remaining)

+; modifies no other variables.

+;

+; Usage:

+;   Push "this is a long ass string"

+;   Push "ass"

+;   Call StrStr

+;   Pop $R0

+;  ($R0 at this point is "ass string")

+ 

+!macro StrStr un

+Function ${un}StrStr

+Exch $R1 ; st=haystack,old$R1, $R1=needle

+  Exch    ; st=old$R1,haystack

+  Exch $R2 ; st=old$R1,old$R2, $R2=haystack

+  Push $R3

+  Push $R4

+  Push $R5

+  StrLen $R3 $R1

+  StrCpy $R4 0

+  ; $R1=needle

+  ; $R2=haystack

+  ; $R3=len(needle)

+  ; $R4=cnt

+  ; $R5=tmp

+  loop:

+    StrCpy $R5 $R2 $R3 $R4

+    StrCmp $R5 $R1 done

+    StrCmp $R5 "" done

+    IntOp $R4 $R4 + 1

+    Goto loop

+done:

+  StrCpy $R1 $R2 "" $R4

+  Pop $R5

+  Pop $R4

+  Pop $R3

+  Pop $R2

+  Exch $R1

+FunctionEnd

+!macroend

+!insertmacro StrStr ""

+!insertmacro StrStr "un."

+ 

diff --git a/src/translate/mcode/windows/ghdlfilter.adb b/src/translate/mcode/windows/ghdlfilter.adb
new file mode 100644
index 000000000..d37c2db23
--- /dev/null
+++ b/src/translate/mcode/windows/ghdlfilter.adb
@@ -0,0 +1,58 @@
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Ghdlfilter is
+   type Mode_Kind is (Mode_93, Mode_87);
+   Mode : Mode_Kind;
+
+   Line : String (1 .. 128);
+   Len : Natural;
+
+   Comment : Boolean;
+   Block_Comment : Boolean;
+begin
+   if Argument_Count /= 1 then
+      Put_Line (Standard_Error, "usage: " & Command_Name & " -v93|-v87");
+      return;
+   end if;
+
+   if Argument (1) = "-v93" then
+      Mode := Mode_93;
+   elsif Argument (1) = "-v87" then
+      Mode := Mode_87;
+   else
+      Put_Line (Standard_Error, "bad mode");
+      return;
+   end if;
+
+   Block_Comment := False;
+
+   loop
+      exit when End_Of_File;
+      Get_Line (Line, Len);
+
+      Comment := Block_Comment;
+
+      if Len > 5 then
+         if Mode = Mode_87 and Line (Len - 4 .. Len) = "--V93" then
+            Comment := True;
+         elsif Mode = Mode_93 and Line (Len - 4 .. Len) = "--V87" then
+            Comment := True;
+         end if;
+      end if;
+      if Len = 11
+        and then Mode = Mode_87
+        and then Line (1 .. 11) = "--START-V93" then
+         Block_Comment := True;
+      end if;
+
+      if Len = 9 and then Line (1 .. 9) = "--END-V93" then
+         Block_Comment := False;
+      end if;
+
+      if Comment then
+         Put ("-- ");
+      end if;
+      Put_Line (Line (1 .. Len));
+   end loop;
+end Ghdlfilter;
diff --git a/src/translate/mcode/windows/ghdlversion.adb b/src/translate/mcode/windows/ghdlversion.adb
new file mode 100755
index 000000000..d2f1c28be
--- /dev/null
+++ b/src/translate/mcode/windows/ghdlversion.adb
@@ -0,0 +1,30 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+
+procedure Ghdlversion is
+   Line : String (1 .. 128);
+   Len : Natural;
+   Pos : Natural;
+   E : Natural;
+begin
+   loop
+      exit when End_Of_File;
+      Get_Line (Line, Len);
+      
+      --  Search GHDL
+      Pos := Index (Line (1 .. Len), "GHDL ");
+      if Pos /= 0 then
+	 Pos := Pos + 5;
+	 E := Pos;
+	 while Line (E) in '0' .. '9'
+	   or Line (E) in 'a' .. 'z'
+	   or Line (E) = '.'
+	 loop
+	    exit when E = Len;
+	    E := E + 1;
+	 end loop;
+	 Put_Line ("!define VERSION """ & Line (Pos .. E - 1) & """");
+	 return;
+      end if;
+   end loop;
+end Ghdlversion;
diff --git a/src/translate/mcode/windows/grt-modules.adb b/src/translate/mcode/windows/grt-modules.adb
new file mode 100644
index 000000000..35b27c345
--- /dev/null
+++ b/src/translate/mcode/windows/grt-modules.adb
@@ -0,0 +1,37 @@
+--  GHDL Run Time (GRT) -  Modules.
+--  Copyright (C) 2005 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.Storage_Elements; --  Work around GNAT bug.
+with Grt.Vcd;
+with Grt.Vpi;
+with Grt.Waves;
+with Grt.Vital_Annotate;
+with Grt.Disp_Tree;
+with Grt.Disp_Rti;
+
+package body Grt.Modules is
+   procedure Register_Modules is
+   begin
+      --  List of modules to be registered.
+      Grt.Disp_Tree.Register;
+      Grt.Vcd.Register;
+      Grt.Waves.Register;
+      Grt.Vpi.Register;
+      Grt.Vital_Annotate.Register;
+      Grt.Disp_Rti.Register;
+   end Register_Modules;
+end Grt.Modules;
diff --git a/src/translate/mcode/windows/ortho_code-x86-flags.ads b/src/translate/mcode/windows/ortho_code-x86-flags.ads
new file mode 100644
index 000000000..8915f3122
--- /dev/null
+++ b/src/translate/mcode/windows/ortho_code-x86-flags.ads
@@ -0,0 +1,2 @@
+with Ortho_Code.X86.Flags_Windows;
+package Ortho_Code.X86.Flags renames Ortho_Code.X86.Flags_Windows;
diff --git a/src/translate/mcode/windows/windows_default_path.adb b/src/translate/mcode/windows/windows_default_path.adb
new file mode 100644
index 000000000..23aa2f6e0
--- /dev/null
+++ b/src/translate/mcode/windows/windows_default_path.adb
@@ -0,0 +1,45 @@
+with Interfaces.C; use Interfaces.C;
+with System; use System;
+
+package body Windows_Default_Path is
+
+   subtype DWORD is Interfaces.C.Unsigned_Long;
+   subtype LPWSTR is String;
+   subtype HINSTANCE is Address;
+   function GetModuleFileName (Inst : HINSTANCE; Buf : Address; Size : DWORD)
+                              return DWORD;
+   pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
+
+   function Get_Windows_Exec_Path return String
+   is
+      File : String (1 .. 256);
+      Size : DWORD;
+      P : Natural;
+   begin
+      --  Get exe file path.
+      Size := GetModuleFileName (Null_Address, File'Address, File'Length);
+      if Size = 0 or Size = File'Length then
+         return "{cannot find install path}\lib";
+      end if;
+
+      --  Remove Program file.
+      P := Natural (Size);
+      while P > 0 loop
+         exit when File (P) = '\';
+         exit when File (P) = ':' and P = 2;
+         P := P - 1;
+      end loop;
+      if File (P) = '\' and P > 1 then
+         --  Remove directory
+         P := P - 1;
+         while P > 0 loop
+            exit when File (P) = '\';
+            exit when File (P) = ':' and P = 2;
+            P := P - 1;
+         end loop;
+      end if;
+
+      return File (1 .. P);
+   end Get_Windows_Exec_Path;
+end Windows_Default_Path;
+
diff --git a/src/translate/mcode/windows/windows_default_path.ads b/src/translate/mcode/windows/windows_default_path.ads
new file mode 100644
index 000000000..8e6303446
--- /dev/null
+++ b/src/translate/mcode/windows/windows_default_path.ads
@@ -0,0 +1,5 @@
+package Windows_Default_Path is

+   --  Get the default path from executable name.

+   --  This function is called during elaboration!

+   function Get_Windows_Exec_Path return String;

+end Windows_Default_Path;

diff --git a/src/translate/ortho_front.adb b/src/translate/ortho_front.adb
new file mode 100644
index 000000000..56c7e61dd
--- /dev/null
+++ b/src/translate/ortho_front.adb
@@ -0,0 +1,445 @@
+--  Ortho entry point for translation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Types; use Types;
+with Name_Table;
+with Std_Package;
+with Back_End;
+with Flags;
+with Translation;
+with Iirs; use Iirs;
+with Libraries; use Libraries;
+with Sem;
+with Errorout; use Errorout;
+with GNAT.OS_Lib;
+with Canon;
+with Disp_Vhdl;
+with Bug;
+with Trans_Be;
+with Options;
+
+package body Ortho_Front is
+   --  The action to be performed by the compiler.
+   type Action_Type is
+     (
+      --  Normal mode: compile a design file.
+      Action_Compile,
+
+      --  Elaborate a design unit.
+      Action_Elaborate,
+
+      --  Analyze files and elaborate unit.
+      Action_Anaelab,
+
+      --  Generate code for std.package.
+      Action_Compile_Std_Package
+      );
+   Action : Action_Type := Action_Compile;
+
+   --  Name of the entity to elaborate.
+   Elab_Entity : String_Acc;
+   --  Name of the architecture to elaborate.
+   Elab_Architecture : String_Acc;
+   --  Filename for the list of files to link.
+   Elab_Filelist : String_Acc;
+
+   Flag_Expect_Failure : Boolean;
+
+   type Id_Link;
+   type Id_Link_Acc is access Id_Link;
+   type Id_Link is record
+      Id : Name_Id;
+      Link : Id_Link_Acc;
+   end record;
+   Anaelab_Files : Id_Link_Acc := null;
+   Anaelab_Files_Last : Id_Link_Acc := null;
+
+   procedure Init is
+   begin
+      -- Initialize.
+      Trans_Be.Register_Translation_Back_End;
+
+      Options.Initialize;
+
+      Elab_Filelist := null;
+      Elab_Entity := null;
+      Elab_Architecture := null;
+      Flag_Expect_Failure := False;
+   end Init;
+
+   function Decode_Elab_Option (Arg : String_Acc) return Natural
+   is
+   begin
+      Elab_Architecture := null;
+      --  Entity (+ architecture) to elaborate
+      if Arg = null then
+         Error_Msg_Option
+           ("entity or configuration name required after --elab");
+         return 0;
+      end if;
+      if Arg (Arg.all'Last) = ')' then
+         --  Name is ENTITY(ARCH).
+         --  Split.
+         declare
+            P : Natural;
+            Len : Natural;
+            Is_Ext : Boolean;
+         begin
+            P := Arg.all'Last - 1;
+            Len := P - Arg.all'First + 1;
+            --  Must be at least 'e(a)'.
+            if Len < 4 then
+               Error_Msg_Option ("ill-formed name after --elab");
+               return 0;
+            end if;
+            --  Handle extended name.
+            if Arg (P) = '\' then
+               P := P - 1;
+               Is_Ext := True;
+            else
+               Is_Ext := False;
+            end if;
+            loop
+               if P = Arg.all'First then
+                  Error_Msg_Option ("ill-formed name after --elab");
+                  return 0;
+               end if;
+               exit when Arg (P) = '(' and Is_Ext = False;
+               if Arg (P) = '\' then
+                  if Arg (P - 1) = '\' then
+                     P := P - 2;
+                  elsif Arg (P - 1) = '(' then
+                     P := P - 1;
+                     exit;
+                  else
+                     Error_Msg_Option ("ill-formed name after --elab");
+                     return 0;
+                  end if;
+               else
+                  P := P - 1;
+               end if;
+            end loop;
+            Elab_Architecture := new String'(Arg (P + 1 .. Arg'Last - 1));
+            Elab_Entity := new String'(Arg (Arg'First .. P - 1));
+         end;
+      else
+         Elab_Entity := new String'(Arg.all);
+         Elab_Architecture := new String'("");
+      end if;
+      return 2;
+   end Decode_Elab_Option;
+
+   function Decode_Option (Opt : String_Acc; Arg: String_Acc) return Natural
+   is
+   begin
+      if Opt.all = "--compile-standard" then
+         Action := Action_Compile_Std_Package;
+         Flags.Bootstrap := True;
+         return 1;
+      elsif Opt.all = "--elab" then
+         if Action /= Action_Compile then
+            Error_Msg_Option ("several --elab options");
+            return 0;
+         end if;
+         Action := Action_Elaborate;
+         return Decode_Elab_Option (Arg);
+      elsif Opt.all = "--anaelab" then
+         if Action /= Action_Compile then
+            Error_Msg_Option ("several --anaelab options");
+            return 0;
+         end if;
+         Action := Action_Anaelab;
+         return Decode_Elab_Option (Arg);
+      elsif Opt'Length > 14
+        and then Opt (Opt'First .. Opt'First + 13) = "--ghdl-source="
+      then
+         if Action /= Action_Anaelab then
+            Error_Msg_Option
+              ("--ghdl-source option allowed only after --anaelab options");
+            return 0;
+         end if;
+         if Arg /= null then
+            Error_Msg_Option ("no argument allowed after --ghdl-source");
+            return 0;
+         end if;
+         declare
+            L : Id_Link_Acc;
+         begin
+            L := new Id_Link'(Id => Name_Table.Get_Identifier
+                                (Opt (Opt'First + 14 .. Opt'Last)),
+                              Link => null);
+            if Anaelab_Files = null then
+               Anaelab_Files := L;
+            else
+               Anaelab_Files_Last.Link := L;
+            end if;
+            Anaelab_Files_Last := L;
+         end;
+         return 2;
+      elsif Opt.all = "-l" then
+         if Arg = null then
+            Error_Msg_Option ("filename required after -l");
+         end if;
+         if Elab_Filelist /= null then
+            Error_Msg_Option ("several -l options");
+         else
+            Elab_Filelist := new String'(Arg.all);
+         end if;
+         return 2;
+      elsif Opt.all = "--help" then
+         Options.Disp_Options_Help;
+         return 1;
+      elsif Opt.all = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         return 1;
+      elsif Opt'Length > 7 and then Opt (1 .. 7) = "--ghdl-" then
+         if Options.Parse_Option (Opt (7 .. Opt'Last)) then
+            return 1;
+         else
+            return 0;
+         end if;
+      elsif Options.Parse_Option (Opt.all) then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Decode_Option;
+
+
+   --  Lighter version of libraries.is_obselete, since DESIGN_UNIT must be in
+   --  the currently analyzed design file.
+   function Is_Obsolete (Design_Unit : Iir_Design_Unit)
+     return Boolean
+   is
+      List : Iir_List;
+      El : Iir;
+   begin
+      if Get_Date (Design_Unit) = Date_Obsolete then
+         return True;
+      end if;
+      List := Get_Dependence_List (Design_Unit);
+      if Is_Null_List (List) then
+         return False;
+      end if;
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when Is_Null (El);
+         --  FIXME: there may be entity_aspect_entity...
+         if Get_Kind (El) = Iir_Kind_Design_Unit
+           and then Get_Date (El) = Date_Obsolete
+         then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Is_Obsolete;
+
+   Nbr_Parse : Natural := 0;
+
+   function Parse (Filename : String_Acc) return Boolean
+   is
+      Res : Iir_Design_File;
+      New_Design_File : Iir_Design_File;
+      Design : Iir_Design_Unit;
+      Next_Design : Iir_Design_Unit;
+
+      --  The vhdl filename to compile.
+      Vhdl_File : Name_Id;
+   begin
+      if Nbr_Parse = 0 then
+         --  Initialize only once...
+         Libraries.Load_Std_Library;
+
+         -- Here, time_base can be set.
+         Translation.Initialize;
+         Canon.Canon_Flag_Add_Labels := True;
+
+         if Flags.List_All and then Flags.List_Annotate then
+            Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit);
+         end if;
+
+         if Action = Action_Anaelab and then Anaelab_Files /= null
+         then
+            Libraries.Load_Work_Library (True);
+         else
+            Libraries.Load_Work_Library (False);
+         end if;
+      end if;
+      Nbr_Parse := Nbr_Parse + 1;
+
+      case Action is
+         when Action_Elaborate =>
+            Flags.Flag_Elaborate := True;
+            Flags.Flag_Only_Elab_Warnings := True;
+            Translation.Chap12.Elaborate
+              (Elab_Entity.all, Elab_Architecture.all,
+               Elab_Filelist.all, False);
+
+            if Errorout.Nbr_Errors > 0 then
+               --  This may happen (bad entity for example).
+               raise Compilation_Error;
+            end if;
+         when Action_Anaelab =>
+            --  Parse files.
+            if Anaelab_Files = null then
+               Flags.Flag_Elaborate_With_Outdated := False;
+            else
+               Flags.Flag_Elaborate_With_Outdated := True;
+               declare
+                  L : Id_Link_Acc;
+               begin
+                  L := Anaelab_Files;
+                  while L /= null loop
+                     Res := Libraries.Load_File (L.Id);
+                     if Errorout.Nbr_Errors > 0 then
+                        raise Compilation_Error;
+                     end if;
+
+                     --  Put units into library.
+                     Design := Get_First_Design_Unit (Res);
+                     while not Is_Null (Design) loop
+                        Next_Design := Get_Chain (Design);
+                        Set_Chain (Design, Null_Iir);
+                        Libraries.Add_Design_Unit_Into_Library (Design);
+                        Design := Next_Design;
+                     end loop;
+                     L := L.Link;
+                  end loop;
+               end;
+            end if;
+
+            Flags.Flag_Elaborate := True;
+            Flags.Flag_Only_Elab_Warnings := False;
+            Translation.Chap12.Elaborate
+              (Elab_Entity.all, Elab_Architecture.all, "", True);
+
+            if Errorout.Nbr_Errors > 0 then
+               --  This may happen (bad entity for example).
+               raise Compilation_Error;
+            end if;
+         when Action_Compile_Std_Package =>
+            if Filename /= null then
+               Error_Msg_Option
+                 ("--compile-standard is not compatible with a filename");
+               return False;
+            end if;
+            Translation.Translate_Standard (True);
+
+         when Action_Compile =>
+            if Filename = null then
+               Error_Msg_Option ("no input file");
+               return False;
+            end if;
+            if Nbr_Parse > 1 then
+               Error_Msg_Option ("can compile only one file (file """ &
+                                 Filename.all & """ ignored)");
+               return False;
+            end if;
+            Vhdl_File := Name_Table.Get_Identifier (Filename.all);
+
+            Translation.Translate_Standard (False);
+
+            Flags.Flag_Elaborate := False;
+            Res := Libraries.Load_File (Vhdl_File);
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+
+            -- Semantize all design units.
+            --  FIXME: outdate the design file?
+            New_Design_File := Null_Iir;
+            Design := Get_First_Design_Unit (Res);
+            while not Is_Null (Design) loop
+               -- Sem, canon, annotate a design unit.
+               Back_End.Finish_Compilation (Design, True);
+
+               Next_Design := Get_Chain (Design);
+               if Errorout.Nbr_Errors = 0 then
+                  Set_Chain (Design, Null_Iir);
+                  Libraries.Add_Design_Unit_Into_Library (Design);
+                  New_Design_File := Get_Design_File (Design);
+               end if;
+
+               Design := Next_Design;
+            end loop;
+
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+
+            --  Do late analysis checks.
+            Design := Get_First_Design_Unit (New_Design_File);
+            while not Is_Null (Design) loop
+               Sem.Sem_Analysis_Checks_List
+                 (Design, Flags.Warn_Delayed_Checks);
+               Design := Get_Chain (Design);
+            end loop;
+
+            --  Compile only now.
+            if not Is_Null (New_Design_File) then
+               --  Note: the order of design unit is kept.
+               Design := Get_First_Design_Unit (New_Design_File);
+               while not Is_Null (Design) loop
+                  if not Is_Obsolete (Design) then
+
+                     if Get_Kind (Get_Library_Unit (Design))
+                       = Iir_Kind_Configuration_Declaration
+                     then
+                        --  Defer code generation of configuration declaration.
+                        --  (default binding may change between analysis and
+                        --   elaboration).
+                        Translation.Translate (Design, False);
+                     else
+                        Translation.Translate (Design, True);
+                     end if;
+
+                     if Errorout.Nbr_Errors > 0 then
+                        --  This can happen (foreign attribute).
+                        raise Compilation_Error;
+                     end if;
+                  end if;
+
+                  Design := Get_Chain (Design);
+               end loop;
+            end if;
+
+            -- Save the working library.
+            Libraries.Save_Work_Library;
+      end case;
+      if Flag_Expect_Failure then
+         return False;
+      else
+         return True;
+      end if;
+   exception
+      --when File_Error =>
+      --   Error_Msg_Option ("cannot open file '" & Filename.all & "'");
+      --   return False;
+      when Compilation_Error
+        | Parse_Error =>
+         if Flag_Expect_Failure then
+            --  Very brutal...
+            GNAT.OS_Lib.OS_Exit (0);
+         end if;
+         return False;
+      when Option_Error =>
+         return False;
+      when E: others =>
+         Bug.Disp_Bug_Box (E);
+         raise;
+   end Parse;
+end Ortho_Front;
diff --git a/src/translate/trans_analyzes.adb b/src/translate/trans_analyzes.adb
new file mode 100644
index 000000000..8147e93bd
--- /dev/null
+++ b/src/translate/trans_analyzes.adb
@@ -0,0 +1,182 @@
+--  Analysis for translation.
+--  Copyright (C) 2009 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 Iirs_Utils; use Iirs_Utils;
+with Iirs_Walk; use Iirs_Walk;
+with Disp_Vhdl;
+with Ada.Text_IO;
+with Errorout;
+
+package body Trans_Analyzes is
+   Driver_List : Iir_List;
+
+   Has_After : Boolean;
+   function Extract_Driver_Target (Target : Iir) return Walk_Status
+   is
+      Base : Iir;
+      Prefix : Iir;
+   begin
+      Base := Get_Object_Prefix (Target);
+      --  Assigment to subprogram interface does not create a driver.
+      if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration
+        and then
+        Get_Kind (Get_Parent (Base)) = Iir_Kind_Procedure_Declaration
+      then
+         return Walk_Continue;
+      end if;
+
+      Prefix := Get_Longuest_Static_Prefix (Target);
+      Add_Element (Driver_List, Prefix);
+      if Has_After then
+         Set_After_Drivers_Flag (Base, True);
+      end if;
+      return Walk_Continue;
+   end Extract_Driver_Target;
+
+   function Extract_Driver_Stmt (Stmt : Iir) return Walk_Status
+   is
+      Status : Walk_Status;
+      pragma Unreferenced (Status);
+      We : Iir;
+   begin
+      case Get_Kind (Stmt) is
+         when Iir_Kind_Signal_Assignment_Statement =>
+            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_Kind (Get_We_Value (We)) /= Iir_Kind_Null_Literal
+            then
+               Has_After := False;
+            else
+               Has_After := True;
+            end if;
+            Status := Walk_Assignment_Target
+              (Get_Target (Stmt), Extract_Driver_Target'Access);
+         when Iir_Kind_Procedure_Call_Statement =>
+            declare
+               Call : constant Iir := Get_Procedure_Call (Stmt);
+               Assoc : Iir;
+               Formal : Iir;
+               Inter : Iir;
+            begin
+               --  Very pessimist.
+               Has_After := True;
+
+               Assoc := Get_Parameter_Association_Chain (Call);
+               Inter := Get_Interface_Declaration_Chain
+                 (Get_Implementation (Call));
+               while Assoc /= Null_Iir loop
+                  Formal := Get_Formal (Assoc);
+                  if Formal = Null_Iir then
+                     Formal := Inter;
+                     Inter := Get_Chain (Inter);
+                  else
+                     Formal := Get_Association_Interface (Assoc);
+                  end if;
+                  if Get_Kind (Assoc)
+                    = Iir_Kind_Association_Element_By_Expression
+                    and then
+                    Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration
+                    and then Get_Mode (Formal) /= Iir_In_Mode
+                  then
+                     Status := Extract_Driver_Target (Get_Actual (Assoc));
+                  end if;
+                  Assoc := Get_Chain (Assoc);
+               end loop;
+            end;
+         when others =>
+            null;
+      end case;
+      return Walk_Continue;
+   end Extract_Driver_Stmt;
+
+   procedure Extract_Drivers_Sequential_Stmt_Chain (Chain : Iir)
+   is
+      Status : Walk_Status;
+      pragma Unreferenced (Status);
+   begin
+      Status := Walk_Sequential_Stmt_Chain (Chain, Extract_Driver_Stmt'Access);
+   end Extract_Drivers_Sequential_Stmt_Chain;
+
+   procedure Extract_Drivers_Declaration_Chain (Chain : Iir)
+   is
+      Decl : Iir := Chain;
+   begin
+      while Decl /= Null_Iir loop
+
+         --  Only procedures and impure functions may contain assignment.
+         if Get_Kind (Decl) = Iir_Kind_Procedure_Body
+           or else (Get_Kind (Decl) = Iir_Kind_Function_Body
+                    and then
+                      not Get_Pure_Flag (Get_Subprogram_Specification (Decl)))
+         then
+            Extract_Drivers_Declaration_Chain (Get_Declaration_Chain (Decl));
+            Extract_Drivers_Sequential_Stmt_Chain
+              (Get_Sequential_Statement_Chain (Decl));
+         end if;
+
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Extract_Drivers_Declaration_Chain;
+
+   function Extract_Drivers (Proc : Iir) return Iir_List
+   is
+   begin
+      Driver_List := Create_Iir_List;
+      Extract_Drivers_Declaration_Chain (Get_Declaration_Chain (Proc));
+      Extract_Drivers_Sequential_Stmt_Chain
+              (Get_Sequential_Statement_Chain (Proc));
+
+      return Driver_List;
+   end Extract_Drivers;
+
+   procedure Free_Drivers_List (List : in out Iir_List)
+   is
+      El : Iir;
+   begin
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         Set_After_Drivers_Flag (Get_Object_Prefix (El), False);
+      end loop;
+      Destroy_Iir_List (List);
+   end Free_Drivers_List;
+
+   procedure Dump_Drivers (Proc : Iir; List : Iir_List)
+   is
+      use Ada.Text_IO;
+      use Errorout;
+      El : Iir;
+   begin
+      Put_Line ("List of drivers for " & Disp_Node (Proc) & ":");
+      Put_Line (" (declared at " & Disp_Location (Proc) & ")");
+      for I in Natural loop
+         El := Get_Nth_Element (List, I);
+         exit when El = Null_Iir;
+         if Get_After_Drivers_Flag (Get_Object_Prefix (El)) then
+            Put ("*  ");
+         else
+            Put ("   ");
+         end if;
+         Disp_Vhdl.Disp_Vhdl (El);
+         New_Line;
+      end loop;
+   end Dump_Drivers;
+
+end Trans_Analyzes;
diff --git a/src/translate/trans_analyzes.ads b/src/translate/trans_analyzes.ads
new file mode 100644
index 000000000..ecebb7597
--- /dev/null
+++ b/src/translate/trans_analyzes.ads
@@ -0,0 +1,31 @@
+--  Analysis for translation.
+--  Copyright (C) 2009 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 Iirs; use Iirs;
+
+package Trans_Analyzes is
+   --  Extract a list of drivers from PROC.
+   function Extract_Drivers (Proc : Iir) return Iir_List;
+
+   --  Free the list.
+   procedure Free_Drivers_List (List : in out Iir_List);
+
+   --  Dump list of drivers (LIST) for process PROC.
+   procedure Dump_Drivers (Proc : Iir; List : Iir_List);
+
+end Trans_Analyzes;
diff --git a/src/translate/trans_be.adb b/src/translate/trans_be.adb
new file mode 100644
index 000000000..dd1b6c338
--- /dev/null
+++ b/src/translate/trans_be.adb
@@ -0,0 +1,182 @@
+--  Back-end for translation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Iirs; use Iirs;
+with Disp_Tree;
+with Disp_Vhdl;
+with Sem;
+with Canon;
+with Translation;
+with Errorout; use Errorout;
+with Post_Sems;
+with Flags;
+with Ada.Text_IO;
+with Back_End;
+
+package body Trans_Be is
+   procedure Finish_Compilation
+     (Unit : Iir_Design_Unit; Main : Boolean := False)
+   is
+      use Ada.Text_IO;
+      Lib : Iir;
+   begin
+      --  No need to semantize during elaboration.
+      --if Flags.Will_Elaborate then
+      --   return;
+      --end if;
+
+      Lib := Get_Library_Unit (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Parse then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      --  Semantic analysis.
+      if Flags.Verbose then
+         Put_Line ("semantize " & Disp_Node (Lib));
+      end if;
+      Sem.Semantic (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Sem then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Sem then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      --  Post checks
+      ----------------
+
+      Post_Sems.Post_Sem_Checks (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      --  Canonalisation.
+      ------------------
+      if Flags.Verbose then
+         Put_Line ("canonicalize " & Disp_Node (Lib));
+      end if;
+
+      Canon.Canonicalize (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Canon then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Canon then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      if Flags.Flag_Elaborate then
+         if Get_Kind (Lib) = Iir_Kind_Architecture_Body then
+            declare
+               Config : Iir_Design_Unit;
+            begin
+               Config := Canon.Create_Default_Configuration_Declaration (Lib);
+               Set_Default_Configuration_Declaration (Lib, Config);
+               if (Main or Flags.Dump_All) and then Flags.Dump_Canon then
+                  Disp_Tree.Disp_Tree (Config);
+               end if;
+               if (Main or Flags.List_All) and then Flags.List_Canon then
+                  Disp_Vhdl.Disp_Vhdl (Config);
+               end if;
+            end;
+         end if;
+
+         --  Do not translate during elaboration.
+         --  This is done directly in Translation.Chap12.
+         return;
+      end if;
+
+      --  Translation
+      ---------------
+      if not Main then
+         --  Main units (those from the analyzed design file) are translated
+         --  directly by ortho_front.
+
+         Translation.Translate (Unit, Main);
+
+         if Errorout.Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+      end if;
+
+   end Finish_Compilation;
+
+   procedure Sem_Foreign (Decl : Iir)
+   is
+      use Translation;
+      Fi : Foreign_Info_Type;
+      pragma Unreferenced (Fi);
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Architecture_Body =>
+            Error_Msg_Sem ("FOREIGN architectures are not yet handled", Decl);
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            null;
+         when others =>
+            Error_Kind ("sem_foreign", Decl);
+      end case;
+      --  Let is generate error messages.
+      Fi := Translate_Foreign_Id (Decl);
+   end Sem_Foreign;
+
+   function Parse_Option (Opt : String) return Boolean is
+   begin
+      if Opt = "--dump-drivers" then
+         Translation.Flag_Dump_Drivers := True;
+      elsif Opt = "--no-direct-drivers" then
+         Translation.Flag_Direct_Drivers := False;
+      elsif Opt = "--no-range-checks" then
+         Translation.Flag_Range_Checks := False;
+      elsif Opt = "--no-index-checks" then
+         Translation.Flag_Index_Checks := False;
+      elsif Opt = "--no-identifiers" then
+         Translation.Flag_Discard_Identifiers := True;
+      else
+         return False;
+      end if;
+      return True;
+   end Parse_Option;
+
+   procedure Disp_Option
+   is
+      procedure P (Str : String) renames Ada.Text_IO.Put_Line;
+   begin
+      P ("  --dump-drivers     dump processes drivers");
+   end Disp_Option;
+
+   procedure Register_Translation_Back_End is
+   begin
+      Back_End.Finish_Compilation := Finish_Compilation'Access;
+      Back_End.Sem_Foreign := Sem_Foreign'Access;
+      Back_End.Parse_Option := Parse_Option'Access;
+      Back_End.Disp_Option := Disp_Option'Access;
+   end Register_Translation_Back_End;
+end Trans_Be;
diff --git a/src/translate/trans_be.ads b/src/translate/trans_be.ads
new file mode 100644
index 000000000..9ff06031b
--- /dev/null
+++ b/src/translate/trans_be.ads
@@ -0,0 +1,21 @@
+--  Back-end for translation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.
+package Trans_Be is
+   procedure Register_Translation_Back_End;
+end Trans_Be;
+
diff --git a/src/translate/trans_decls.ads b/src/translate/trans_decls.ads
new file mode 100644
index 000000000..e104c71c4
--- /dev/null
+++ b/src/translate/trans_decls.ads
@@ -0,0 +1,257 @@
+--  Declarations for well-known nodes generated by translation.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Ortho_Nodes; use Ortho_Nodes;
+
+package Trans_Decls is
+   --  Procedures called in case of assert failed.
+   Ghdl_Assert_Failed : O_Dnode;
+   Ghdl_Ieee_Assert_Failed : O_Dnode;
+   Ghdl_Psl_Assert_Failed : O_Dnode;
+
+   Ghdl_Psl_Cover : O_Dnode;
+   Ghdl_Psl_Cover_Failed : O_Dnode;
+   --  Procedure for report statement.
+   Ghdl_Report : O_Dnode;
+
+   --  Register a process.
+   Ghdl_Process_Register : O_Dnode;
+   Ghdl_Sensitized_Process_Register : O_Dnode;
+   Ghdl_Postponed_Process_Register : O_Dnode;
+   Ghdl_Postponed_Sensitized_Process_Register : O_Dnode;
+
+   Ghdl_Finalize_Register : O_Dnode;
+
+   --  Wait subprograms.
+   --  Short forms.
+   Ghdl_Process_Wait_Timeout : O_Dnode;
+   Ghdl_Process_Wait_Exit : O_Dnode;
+   --  Complete form:
+   Ghdl_Process_Wait_Set_Timeout : O_Dnode;
+   Ghdl_Process_Wait_Add_Sensitivity : O_Dnode;
+   Ghdl_Process_Wait_Suspend : O_Dnode;
+   Ghdl_Process_Wait_Close : O_Dnode;
+
+   --  Register a sensitivity for a process.
+   Ghdl_Process_Add_Sensitivity : O_Dnode;
+
+   --  Register a driver for a process.
+   Ghdl_Process_Add_Driver : O_Dnode;
+   Ghdl_Signal_Add_Direct_Driver : O_Dnode;
+
+   --  NOW variable.
+   Ghdl_Now : O_Dnode;
+
+   --  Protected variables.
+   Ghdl_Protected_Enter : O_Dnode;
+   Ghdl_Protected_Leave : O_Dnode;
+   Ghdl_Protected_Init : O_Dnode;
+   Ghdl_Protected_Fini : O_Dnode;
+
+   Ghdl_Signal_Set_Disconnect : O_Dnode;
+   Ghdl_Signal_Disconnect : O_Dnode;
+
+   Ghdl_Signal_Driving : O_Dnode;
+
+   Ghdl_Signal_Direct_Assign : O_Dnode;
+
+   Ghdl_Signal_Simple_Assign_Error : O_Dnode;
+   Ghdl_Signal_Start_Assign_Error : O_Dnode;
+   Ghdl_Signal_Next_Assign_Error : O_Dnode;
+
+   Ghdl_Signal_Start_Assign_Null : O_Dnode;
+   Ghdl_Signal_Next_Assign_Null : O_Dnode;
+
+   Ghdl_Create_Signal_E8 : O_Dnode;
+   Ghdl_Signal_Init_E8 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_E8 : O_Dnode;
+   Ghdl_Signal_Start_Assign_E8 : O_Dnode;
+   Ghdl_Signal_Next_Assign_E8 : O_Dnode;
+   Ghdl_Signal_Associate_E8 : O_Dnode;
+   Ghdl_Signal_Driving_Value_E8 : O_Dnode;
+
+   Ghdl_Create_Signal_E32 : O_Dnode;
+   Ghdl_Signal_Init_E32 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_E32 : O_Dnode;
+   Ghdl_Signal_Start_Assign_E32 : O_Dnode;
+   Ghdl_Signal_Next_Assign_E32 : O_Dnode;
+   Ghdl_Signal_Associate_E32 : O_Dnode;
+   Ghdl_Signal_Driving_Value_E32 : O_Dnode;
+
+   Ghdl_Create_Signal_B1 : O_Dnode;
+   Ghdl_Signal_Init_B1 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_B1 : O_Dnode;
+   Ghdl_Signal_Start_Assign_B1 : O_Dnode;
+   Ghdl_Signal_Next_Assign_B1 : O_Dnode;
+   Ghdl_Signal_Associate_B1 : O_Dnode;
+   Ghdl_Signal_Driving_Value_B1 : O_Dnode;
+
+   Ghdl_Create_Signal_I32 : O_Dnode;
+   Ghdl_Signal_Init_I32 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_I32 : O_Dnode;
+   Ghdl_Signal_Start_Assign_I32 : O_Dnode;
+   Ghdl_Signal_Next_Assign_I32 : O_Dnode;
+   Ghdl_Signal_Associate_I32 : O_Dnode;
+   Ghdl_Signal_Driving_Value_I32 : O_Dnode;
+
+   Ghdl_Create_Signal_F64 : O_Dnode;
+   Ghdl_Signal_Init_F64 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_F64 : O_Dnode;
+   Ghdl_Signal_Start_Assign_F64 : O_Dnode;
+   Ghdl_Signal_Next_Assign_F64 : O_Dnode;
+   Ghdl_Signal_Associate_F64 : O_Dnode;
+   Ghdl_Signal_Driving_Value_F64 : O_Dnode;
+
+   Ghdl_Create_Signal_I64 : O_Dnode;
+   Ghdl_Signal_Init_I64 : O_Dnode;
+   Ghdl_Signal_Simple_Assign_I64 : O_Dnode;
+   Ghdl_Signal_Start_Assign_I64 : O_Dnode;
+   Ghdl_Signal_Next_Assign_I64 : O_Dnode;
+   Ghdl_Signal_Associate_I64 : O_Dnode;
+   Ghdl_Signal_Driving_Value_I64 : O_Dnode;
+
+   Ghdl_Signal_In_Conversion : O_Dnode;
+   Ghdl_Signal_Out_Conversion : O_Dnode;
+
+   Ghdl_Signal_Add_Source : O_Dnode;
+   Ghdl_Signal_Effective_Value : O_Dnode;
+
+   Ghdl_Signal_Create_Resolution : O_Dnode;
+
+   Ghdl_Signal_Name_Rti : O_Dnode;
+   Ghdl_Signal_Merge_Rti : O_Dnode;
+
+   Ghdl_Signal_Get_Nbr_Drivers : O_Dnode;
+   Ghdl_Signal_Get_Nbr_Ports: O_Dnode;
+   Ghdl_Signal_Read_Driver : O_Dnode;
+   Ghdl_Signal_Read_Port : O_Dnode;
+
+   --  Signal attribute.
+   Ghdl_Create_Stable_Signal : O_Dnode;
+   Ghdl_Create_Quiet_Signal : O_Dnode;
+   Ghdl_Create_Transaction_Signal : O_Dnode;
+   Ghdl_Signal_Attribute_Register_Prefix : O_Dnode;
+   Ghdl_Create_Delayed_Signal : O_Dnode;
+
+   --  Guard signal.
+   Ghdl_Signal_Create_Guard : O_Dnode;
+   Ghdl_Signal_Guard_Dependence : O_Dnode;
+
+   --  Predefined subprograms.
+   Ghdl_Memcpy : O_Dnode;
+   Ghdl_Deallocate : O_Dnode;
+   Ghdl_Malloc : O_Dnode;
+   Ghdl_Malloc0 : O_Dnode;
+   Ghdl_Real_Exp : O_Dnode;
+   Ghdl_Integer_Exp : O_Dnode;
+
+   --  Procedure called in case of check failed.
+   Ghdl_Program_Error : O_Dnode;
+   Ghdl_Bound_Check_Failed_L1 : O_Dnode;
+
+   --  Stack 2.
+   Ghdl_Stack2_Allocate : O_Dnode;
+   Ghdl_Stack2_Mark : O_Dnode;
+   Ghdl_Stack2_Release : O_Dnode;
+
+   Std_Standard_Boolean_Rti : O_Dnode;
+   Std_Standard_Bit_Rti : O_Dnode;
+
+   --  Predefined file subprograms.
+   Ghdl_Text_File_Elaborate : O_Dnode;
+   Ghdl_File_Elaborate : O_Dnode;
+
+   Ghdl_Text_File_Finalize : O_Dnode;
+   Ghdl_File_Finalize : O_Dnode;
+
+   Ghdl_Text_File_Open : O_Dnode;
+   Ghdl_File_Open : O_Dnode;
+
+   Ghdl_Text_File_Open_Status : O_Dnode;
+   Ghdl_File_Open_Status : O_Dnode;
+
+   Ghdl_Text_Write : O_Dnode;
+   Ghdl_Write_Scalar : O_Dnode;
+
+   Ghdl_Read_Scalar : O_Dnode;
+
+   Ghdl_Text_Read_Length : O_Dnode;
+
+   Ghdl_Text_File_Close : O_Dnode;
+   Ghdl_File_Close : O_Dnode;
+   Ghdl_File_Flush : O_Dnode;
+
+   Ghdl_File_Endfile : O_Dnode;
+
+   --  'Image attributes.
+   Ghdl_Image_B1 : O_Dnode;
+   Ghdl_Image_E8 : O_Dnode;
+   Ghdl_Image_E32 : O_Dnode;
+   Ghdl_Image_I32 : O_Dnode;
+   Ghdl_Image_P32 : O_Dnode;
+   Ghdl_Image_P64 : O_Dnode;
+   Ghdl_Image_F64 : O_Dnode;
+
+   --  'Value attributes
+   Ghdl_Value_B1 : O_Dnode;
+   Ghdl_Value_E8 : O_Dnode;
+   Ghdl_Value_E32 : O_Dnode;
+   Ghdl_Value_I32 : O_Dnode;
+   Ghdl_Value_P32 : O_Dnode;
+   Ghdl_Value_P64 : O_Dnode;
+   Ghdl_Value_F64 : O_Dnode;
+
+   --  'Path_Name
+   Ghdl_Get_Path_Name : O_Dnode;
+   Ghdl_Get_Instance_Name : O_Dnode;
+
+   --  For PSL.
+   Ghdl_Std_Ulogic_To_Boolean_Array : O_Dnode;
+
+   --  For std_logic_1164 (vhdl 2008).
+   Ghdl_Std_Ulogic_Match_Eq : O_Dnode;
+   Ghdl_Std_Ulogic_Match_Ne : O_Dnode;
+   Ghdl_Std_Ulogic_Match_Lt : O_Dnode;
+   Ghdl_Std_Ulogic_Match_Le : O_Dnode;
+   Ghdl_Std_Ulogic_Array_Match_Eq : O_Dnode;
+   Ghdl_Std_Ulogic_Array_Match_Ne : O_Dnode;
+
+   --  For To_String (vhdl 2008).
+   Ghdl_To_String_I32 : O_Dnode;
+   Ghdl_To_String_F64 : O_Dnode;
+   Ghdl_To_String_F64_Digits : O_Dnode;
+   Ghdl_To_String_F64_Format : O_Dnode;
+   Ghdl_To_String_B1 : O_Dnode;
+   Ghdl_To_String_E8 : O_Dnode;
+   Ghdl_To_String_E32 : O_Dnode;
+   Ghdl_To_String_Char : O_Dnode;
+   Ghdl_To_String_P32 : O_Dnode;
+   Ghdl_To_String_P64 : O_Dnode;
+   Ghdl_Time_To_String_Unit : O_Dnode;
+   Ghdl_Array_Char_To_String_B1 : O_Dnode;
+   Ghdl_Array_Char_To_String_E8 : O_Dnode;
+   Ghdl_Array_Char_To_String_E32 : O_Dnode;
+   Ghdl_BV_To_String : O_Dnode;
+   Ghdl_BV_To_Ostring : O_Dnode;
+   Ghdl_BV_To_Hstring : O_Dnode;
+
+   --  Register a package
+   Ghdl_Rti_Add_Package : O_Dnode;
+   Ghdl_Rti_Add_Top : O_Dnode;
+
+   Ghdl_Elaborate : O_Dnode;
+end Trans_Decls;
diff --git a/src/translate/translation.adb b/src/translate/translation.adb
new file mode 100644
index 000000000..7c5fbe85c
--- /dev/null
+++ b/src/translate/translation.adb
@@ -0,0 +1,31355 @@
+--  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_Inst;
+with Sem;
+with Iir_Chains; use Iir_Chains;
+with Nodes;
+with Nodes_Meta;
+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.standard.integer.
+   Std_Integer_Otype : O_Tnode;
+
+   --  Ortho type for std.standard.real.
+   Std_Real_Otype : O_Tnode;
+
+   --  Ortho type node for std.standard.time.
+   Std_Time_Otype : 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;
+   Wki_Val : O_Ident;
+   Wki_L_Len : O_Ident;
+   Wki_R_Len : 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;
+
+      --  Scope for variables.  This is used both to build instances (so it
+      --  contains the record type that contains objects declared in that
+      --  scope) and to use instances (it contains the path to access to these
+      --  objects).
+      type Var_Scope_Type is private;
+
+      type Var_Scope_Acc is access all Var_Scope_Type;
+      for Var_Scope_Acc'Storage_Size use 0;
+
+      Null_Var_Scope : constant Var_Scope_Type;
+
+      type Var_Type is private;
+      Null_Var : constant Var_Type;
+
+      --  Return the record type for SCOPE.
+      function Get_Scope_Type (Scope : Var_Scope_Type) return O_Tnode;
+
+      --  Return the size for instances of SCOPE.
+      function Get_Scope_Size (Scope : Var_Scope_Type) return O_Cnode;
+
+      --  Return True iff SCOPE is defined.
+      function Has_Scope_Type (Scope : Var_Scope_Type) return Boolean;
+
+      --  Create an empty and incomplete scope type for SCOPE using NAME.
+      procedure Predeclare_Scope_Type (Scope : Var_Scope_Acc; Name : O_Ident);
+
+      --  Declare a pointer PTR_TYPE with NAME to scope type SCOPE.
+      procedure Declare_Scope_Acc
+        (Scope : Var_Scope_Type; Name : O_Ident; Ptr_Type : out O_Tnode);
+
+      --  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 (Scope : Var_Scope_Acc);
+
+      --  Manually add a field to the current instance being built.
+      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
+                                          return O_Fnode;
+
+      --  In the scope being built, add a field NAME that contain sub-scope
+      --  CHILD.  CHILD is modified so that accesses to CHILD objects is done
+      --  via SCOPE.
+      procedure Add_Scope_Field
+        (Name : O_Ident; Child : in out Var_Scope_Type);
+
+      --  Return the offset of field for CHILD in its parent scope.
+      function Get_Scope_Offset (Child : Var_Scope_Type; Otype : O_Tnode)
+                                return O_Cnode;
+
+      --  Finish the building of the current instance and return the type
+      --  built.
+      procedure Pop_Instance_Factory (Scope : Var_Scope_Acc);
+
+      --  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;
+
+      --  Set_Scope defines how to access to variables of SCOPE.
+      --  Variables defined in SCOPE can be accessed via field SCOPE_FIELD
+      --  in scope SCOPE_PARENT.
+      procedure Set_Scope_Via_Field
+        (Scope : in out Var_Scope_Type;
+         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc);
+
+      --  Variables defined in SCOPE can be accessed by dereferencing
+      --  field SCOPE_FIELD defined in SCOPE_PARENT.
+      procedure Set_Scope_Via_Field_Ptr
+        (Scope : in out Var_Scope_Type;
+         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc);
+
+      --  Variables/scopes defined in SCOPE can be accessed via
+      --  dereference of parameter SCOPE_PARAM.
+      procedure Set_Scope_Via_Param_Ptr
+        (Scope : in out Var_Scope_Type; Scope_Param : O_Dnode);
+
+      --  Variables/scopes defined in SCOPE can be accessed via DECL.
+      procedure Set_Scope_Via_Decl
+        (Scope : in out Var_Scope_Type; Decl : O_Dnode);
+
+      --  Variables/scopes defined in SCOPE can be accessed by derefencing
+      --  VAR.
+      procedure Set_Scope_Via_Var_Ptr
+        (Scope : in out Var_Scope_Type; Var : Var_Type);
+
+      --  No more accesses to SCOPE_TYPE are allowed.  Scopes must be cleared
+      --  before being set.
+      procedure Clear_Scope (Scope : in out Var_Scope_Type);
+
+      --  Reset the identifier.
+      type Id_Mark_Type is limited private;
+      type Local_Identifier_Type is 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 : 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;
+
+      --  Create variable NAME of type VTYPE 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_Type;
+
+      --  Create a global variable.
+      function Create_Global_Var
+        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
+        return Var_Type;
+
+      --  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_Type;
+      procedure Define_Global_Const (Const : in out Var_Type; Val : O_Cnode);
+
+      --  Return the (real) reference to a variable created by Create_Var.
+      function Get_Var (Var : Var_Type) return O_Lnode;
+
+      --  Return a reference to the instance of type ITYPE.
+      function Get_Instance_Ref (Scope : Var_Scope_Type) 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_Type) return Allocation_Kind;
+
+      --  Return TRUE iff VAR is stable, ie get_var (VAR) can be referenced
+      --  several times.
+      function Is_Var_Stable (Var : Var_Type) return Boolean;
+
+      --  Used only to generate RTI.
+      function Is_Var_Field (Var : Var_Type) return Boolean;
+      function Get_Var_Offset (Var : Var_Type; Otype : O_Tnode) return O_Cnode;
+      function Get_Var_Label (Var : Var_Type) return O_Dnode;
+
+      --  For package instantiation.
+
+      --  Associate INST_SCOPE as the instantiated scope for ORIG_SCOPE.
+      procedure Push_Instantiate_Var_Scope
+        (Inst_Scope : Var_Scope_Acc; Orig_Scope : Var_Scope_Acc);
+
+      --  Remove the association for INST_SCOPE.
+      procedure Pop_Instantiate_Var_Scope
+        (Inst_Scope : Var_Scope_Acc);
+
+      --  Get the associated instantiated scope for SCOPE.
+      function Instantiated_Var_Scope (Scope : Var_Scope_Acc)
+                                      return Var_Scope_Acc;
+
+      --  Create a copy of VAR using instantiated scope (if needed).
+      function Instantiate_Var (Var : Var_Type) return Var_Type;
+
+      --  Create a copy of SCOPE using instantiated scope (if needed).
+      function Instantiate_Var_Scope (Scope : Var_Scope_Type)
+                                     return Var_Scope_Type;
+   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;
+
+      --  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 =>
+               Scope : Var_Scope_Acc;
+               Elements : O_Element_List;
+         end case;
+      end record;
+
+      --  Kind of variable:
+      --  VAR_NONE: the variable doesn't exist.
+      --  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_None, Var_Global, Var_Local, Var_Scope);
+
+      type Var_Type (Kind : Var_Kind := Var_None) is record
+         case Kind is
+            when Var_None =>
+               null;
+            when Var_Global
+              | Var_Local =>
+               E : O_Dnode;
+            when Var_Scope =>
+               I_Field : O_Fnode;
+               I_Scope : Var_Scope_Acc;
+         end case;
+      end record;
+
+      Null_Var : constant Var_Type := (Kind => Var_None);
+
+      type Var_Scope_Kind is (Var_Scope_None,
+                              Var_Scope_Ptr,
+                              Var_Scope_Decl,
+                              Var_Scope_Field,
+                              Var_Scope_Field_Ptr);
+
+      type Var_Scope_Type (Kind : Var_Scope_Kind := Var_Scope_None) is record
+         Scope_Type : O_Tnode := O_Tnode_Null;
+
+         case Kind is
+            when Var_Scope_None =>
+               --  Not set, cannot be referenced.
+               null;
+            when Var_Scope_Ptr
+              | Var_Scope_Decl =>
+               --  Instance for entity, architecture, component, subprogram,
+               --  resolver, process, guard function, PSL directive, PSL cover,
+               --  PSL assert, component instantiation elaborator
+               D : O_Dnode;
+            when Var_Scope_Field
+              | Var_Scope_Field_Ptr =>
+               --  For an entity: the architecture.
+               --  For an architecture: ptr to a generate subblock.
+               --  For a subprogram: parent frame
+               Field : O_Fnode;
+               Up_Link : Var_Scope_Acc;
+         end case;
+      end record;
+
+      Null_Var_Scope : constant Var_Scope_Type := (Scope_Type => O_Tnode_Null,
+                                                   Kind => Var_Scope_None);
+
+   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_Package_Declaration (Decl : Iir_Package_Declaration);
+      procedure Translate_Package_Body (Decl : Iir_Package_Body);
+      procedure Translate_Package_Instantiation_Declaration (Inst : Iir);
+
+      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir);
+
+      --  Add info for an interface_package_declaration or a
+      --  package_instantiation_declaration
+      procedure Instantiate_Info_Package (Inst : Iir);
+
+      --  Elaborate packages that DESIGN_UNIT depends on (except std.standard).
+      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit);
+
+      --  Declare an incomplete record type DECL_TYPE and access PTR_TYPE to
+      --  it.  The names are respectively INSTTYPE and INSTPTR.
+      procedure Declare_Inst_Type_And_Ptr (Scope : Var_Scope_Acc;
+                                           Ptr_Type : out O_Tnode);
+
+      --  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 is the node for which the instance is created. 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 (Scope : Var_Scope_Acc;
+                                      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);
+
+      --  True iff there is currently a subprogram instance.
+      function Has_Current_Subprg_Instance return Boolean;
+
+      --  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 interface during invocation of a
+      --  subprogram.
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Type);
+
+      --  Get the value to be associated to the instance interface.
+      function Get_Subprg_Instance (Vars : Subprg_Instance_Type)
+                                   return O_Enode;
+
+      --  True iff VARS is associated with an instance.
+      function Has_Subprg_Instance (Vars : Subprg_Instance_Type)
+                                   return Boolean;
+
+      --  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);
+
+      function Instantiate_Subprg_Instance (Inst : Subprg_Instance_Type)
+                                           return Subprg_Instance_Type;
+   private
+      type Subprg_Instance_Type is record
+         Inter : O_Dnode;
+         Inter_Type : O_Tnode;
+         Scope : Var_Scope_Acc;
+      end record;
+      Null_Subprg_Instance : constant Subprg_Instance_Type :=
+        (O_Dnode_Null, O_Tnode_Null, null);
+
+      type Subprg_Instance_Stack is record
+         Scope : Var_Scope_Acc;
+         Ptr_Type : O_Tnode;
+         Ident : O_Ident;
+      end record;
+
+      Null_Subprg_Instance_Stack : constant Subprg_Instance_Stack :=
+        (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);
+
+      procedure Elab_Generic_Map_Aspect (Mapping : 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_B1 : 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_Index,
+      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_Package_Instance,
+      Kind_Config,
+      Kind_Assoc,
+      Kind_Str_Choice,
+      Kind_Design_File,
+      Kind_Library
+      );
+
+   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_Type;
+
+            --  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;
+
+            --  True if the array bounds are static.
+            Static_Bounds : Boolean;
+
+            --  Variable containing the bounds for a constrained array.
+            Array_Bounds : Var_Type;
+
+            --  Variable containing a 1 length bound for unidimensional
+            --  unconstrained arrays.
+            Array_1bound : Var_Type;
+
+            --  Variable containing the description for each index.
+            Array_Index_Desc : Var_Type;
+
+         when Kind_Type_Record =>
+            --  Variable containing the description for each element.
+            Record_El_Desc : Var_Type;
+
+         when Kind_Type_File =>
+            --  Constant containing the signature of the file.
+            File_Signature : O_Dnode;
+
+         when Kind_Type_Protected =>
+            Prot_Scope : aliased Var_Scope_Type;
+
+            --  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),
+      Static_Bounds => False,
+      Array_Bounds => Null_Var,
+      Array_1bound => Null_Var,
+      Array_Index_Desc => Null_Var);
+
+   Ortho_Info_Type_Record_Init : constant Ortho_Info_Type_Type :=
+     (Kind => Kind_Type_Record,
+      Rti_Max_Depth => 0,
+      Record_El_Desc => Null_Var);
+
+   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_Scope => Null_Var_Scope,
+      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_B1,
+      --  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_B1 .. Type_Mode_F64;
+
+   subtype Type_Mode_Non_Composite is Type_Mode_Type
+     range Type_Mode_B1 .. 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_B1 .. 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_B1 .. 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;
+      --  Parameter nodes.
+      Var_Instance : Chap2.Subprg_Instance_Type;
+
+      --  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_Type;
+
+      --  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_Type;
+
+      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_Type;
+   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_Index =>
+            --  Field declaration for array dimension.
+            Index_Field : O_Fnode;
+
+         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;
+
+            --  Field in the frame for a pointer to the RESULT structure.
+            Res_Record_Var : Var_Type := Null_Var;
+
+            --  For a subprogram 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;
+
+            --  Access to the declarations within this subprogram.
+            Subprg_Frame_Scope : aliased Var_Scope_Type;
+
+            --  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_Type;
+            --  Direct driver for signal (if any).
+            Object_Driver : Var_Type := Null_Var;
+            --  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 := O_Dnode_Null;
+
+         when Kind_Alias =>
+            Alias_Var : Var_Type;
+            Alias_Kind : Object_Kind_Type;
+
+         when Kind_Iterator =>
+            Iterator_Var : Var_Type;
+
+         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_Type;
+
+         when Kind_Process =>
+            Process_Scope : aliased Var_Scope_Type;
+
+            --  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 =>
+            Psl_Scope : aliased Var_Scope_Type;
+
+            --  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_Type;
+
+            --  Boolean variable (for cover)
+            Psl_Bool_Var : Var_Type;
+
+            --  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 =>
+            --  Access to declarations of this block.
+            Block_Scope : aliased Var_Scope_Type;
+
+            --  Instance type (ortho record) for declarations contained in the
+            --  block/entity/architecture.
+            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 =>
+            --  How to access to component interfaces.
+            Comp_Scope : aliased Var_Scope_Type;
+
+            --  Instance for the component.
+            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;
+
+            --  Instance for the elaborators.
+            Package_Elab_Spec_Instance : Chap2.Subprg_Instance_Type;
+            Package_Elab_Body_Instance : Chap2.Subprg_Instance_Type;
+
+            --  Variable set to true when the package is elaborated.
+            Package_Elab_Var : Var_Type;
+
+            --  RTI constant for the package.
+            Package_Rti_Const : O_Dnode;
+
+            --  Access to declarations of the spec.
+            Package_Spec_Scope : aliased Var_Scope_Type;
+
+            --  Instance type for uninstantiated package
+            Package_Spec_Ptr_Type : O_Tnode;
+
+            Package_Body_Scope : aliased Var_Scope_Type;
+            Package_Body_Ptr_Type : O_Tnode;
+
+            --  Field to the spec within the body.
+            Package_Spec_Field : O_Fnode;
+
+            --  Local id, set by package declaration, continued by package
+            --  body.
+            Package_Local_Id : Local_Identifier_Type;
+
+         when Kind_Package_Instance =>
+            --  The variables containing the instance.  There are two variables
+            --  for interface package: one for the spec, one for the body.
+            --  For package instantiation, only the variable for the body is
+            --  used.  The variable for spec is added so that packages with
+            --  package interfaces don't need to know the body of their
+            --  interfaces.
+            Package_Instance_Spec_Var : Var_Type;
+            Package_Instance_Body_Var : Var_Type;
+
+            --  Elaboration procedure for the instance.
+            Package_Instance_Elab_Subprg : O_Dnode;
+
+            Package_Instance_Spec_Scope : aliased Var_Scope_Type;
+            Package_Instance_Body_Scope : aliased Var_Scope_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 Index_Info_Acc is Ortho_Info_Acc (Kind_Index);
+   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
+         Unchecked_Deallocation (Info);
+         Clear_Info (Target);
+      end if;
+   end Free_Info;
+
+   procedure Free_Type_Info (Info : in out Type_Info_Acc) is
+   begin
+      if Info.C /= null then
+         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;
+
+   --  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_Type; 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 or subtype indication.
+      --  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);
+
+      --  Call lock or unlock on a protected object.
+      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 (the number of elements).
+      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode;
+
+      --  Get the number of elements for bounds BOUNDS.  BOUNDS are
+      --  automatically stabilized if necessary.
+      function Get_Bounds_Length (Bounds : Mnode; Atype : Iir) return O_Enode;
+
+      --  Get the number of elements in array ATYPE.
+      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;
+
+      --  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 : Mnode);
+
+      --  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;
+
+      --  Return True iff all indexes of L_TYPE and R_TYPE have the same
+      --  length.  They must be locally static.
+      function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean;
+
+      --  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.
+      procedure Translate_Declaration_Chain_Subprograms (Parent : 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;
+
+      function Get_Array_Bound_Length (Arr : Mnode;
+                                       Arr_Type : Iir;
+                                       Dim : Natural)
+                                      return O_Enode;
+
+      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
+        (Atype : 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);
+
+      --  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_Dnode);
+
+      --  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 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_Type; 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_Type;
+                    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_Type; 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 Inc_Var (V : O_Dnode) is
+      begin
+         New_Assign_Stmt (New_Obj (V),
+                          New_Dyadic_Op (ON_Add_Ov,
+                                         New_Obj_Value (V),
+                                         New_Lit (Ghdl_Index_1)));
+      end Inc_Var;
+
+      procedure Dec_Var (V : O_Dnode) is
+      begin
+         New_Assign_Stmt (New_Obj (V),
+                          New_Dyadic_Op (ON_Sub_Ov,
+                                         New_Obj_Value (V),
+                                         New_Lit (Ghdl_Index_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;
+
+      --  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 : constant Block_Info_Acc := Get_Info (Blk);
+      begin
+         Chap2.Declare_Inst_Type_And_Ptr
+           (Info.Block_Scope'Access, 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_Scope'Access);
+
+         --  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_Scope'Access);
+
+         Chap2.Push_Subprg_Instance (Info.Block_Scope'Access,
+                                     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);
+         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 : constant Block_Info_Acc := Get_Info (Arch);
+         Entity : constant Iir := Get_Entity (Arch);
+         Entity_Info : constant Block_Info_Acc := Get_Info (Entity);
+      begin
+         Set_Scope_Via_Param_Ptr (Arch_Info.Block_Scope, Instance);
+         Set_Scope_Via_Field (Entity_Info.Block_Scope,
+                              Arch_Info.Block_Parent_Field,
+                              Arch_Info.Block_Scope'Access);
+      end Push_Architecture_Scope;
+
+      --  Pop scopes created by Push_Architecture_Scope.
+      procedure Pop_Architecture_Scope (Arch : Iir)
+      is
+         Arch_Info : constant Block_Info_Acc := Get_Info (Arch);
+         Entity : constant Iir := Get_Entity (Arch);
+         Entity_Info : constant Block_Info_Acc := Get_Info (Entity);
+      begin
+         Clear_Scope (Entity_Info.Block_Scope);
+         Clear_Scope (Arch_Info.Block_Scope);
+      end Pop_Architecture_Scope;
+
+      procedure Translate_Architecture_Body (Arch : Iir)
+      is
+         Entity : constant Iir := Get_Entity (Arch);
+         Entity_Info : constant Block_Info_Acc := Get_Info (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_Scope'Access);
+
+         --  We cannot use Add_Scope_Field here, because the entity is not a
+         --  child scope of the architecture.
+         Info.Block_Parent_Field := Add_Instance_Factory_Field
+           (Get_Identifier ("ENTITY"),
+            Get_Scope_Type (Entity_Info.Block_Scope));
+
+         Chap9.Translate_Block_Declarations (Arch, Arch);
+
+         Pop_Instance_Factory (Info.Block_Scope'Access);
+
+         --  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, Get_Scope_Size (Info.Block_Scope));
+         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;
+
+         --  Create process subprograms.
+         Chap2.Push_Subprg_Instance (Info.Block_Scope'Access,
+                                     Info.Block_Decls_Ptr_Type,
+                                     Wki_Instance,
+                                     Prev_Subprg_Instance);
+         Set_Scope_Via_Field (Entity_Info.Block_Scope,
+                              Info.Block_Parent_Field,
+                              Info.Block_Scope'Access);
+
+         Chap9.Translate_Block_Subprograms (Arch, Arch);
+
+         Clear_Scope (Entity_Info.Block_Scope);
+         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
+            Set_Scope_Via_Param_Ptr (Base_Info.Block_Scope, Base_Instance);
+         end if;
+
+         Set_Scope_Via_Param_Ptr (Comp_Info.Comp_Scope, 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;
+
+         Clear_Scope (Comp_Info.Comp_Scope);
+
+         if Get_Kind (Base_Block) = Iir_Kind_Architecture_Body then
+            Pop_Architecture_Scope (Base_Block);
+         else
+            Clear_Scope (Base_Info.Block_Scope);
+         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.
+      --  BLOCK is the block being configured (initially the architecture),
+      --  BASE_BLOCK is the root block giving the instance (initially the
+      --  architecture)
+      --  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;
+      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 =>
+                  declare
+                     Mark : Id_Mark_Type;
+                     Base_Info : constant Block_Info_Acc :=
+                       Get_Info (Base_Block);
+                     Blk : constant Iir := Get_Block_From_Block_Specification
+                       (Get_Block_Specification (El));
+                     Blk_Info : constant Block_Info_Acc := Get_Info (Blk);
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (Blk));
+                     case Get_Kind (Blk) is
+                        when Iir_Kind_Generate_Statement =>
+                           Set_Scope_Via_Field_Ptr
+                             (Base_Info.Block_Scope,
+                              Blk_Info.Block_Origin_Field,
+                              Blk_Info.Block_Scope'Access);
+                           Translate_Block_Configuration_Decls
+                             (El, Blk, Blk, Num);
+                           Clear_Scope (Base_Info.Block_Scope);
+                        when Iir_Kind_Block_Statement =>
+                           Translate_Block_Configuration_Decls
+                             (El, Blk, Base_Block, Num);
+                        when others =>
+                           Error_Kind
+                             ("translate_block_configuration_decls(2)", Blk);
+                     end case;
+                     Pop_Identifier_Prefix (Mark);
+                  end;
+               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_Scope);
+                        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_Scope);
+                        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;
+         Base_Info : Block_Info_Acc);
+
+      procedure Translate_Generate_Block_Configuration_Calls
+        (Block_Config : Iir_Block_Configuration;
+         Parent_Info : Block_Info_Acc)
+      is
+         Spec : constant Iir := Get_Block_Specification (Block_Config);
+         Block : constant Iir := Get_Block_From_Block_Specification (Spec);
+         Info : constant Block_Info_Acc := Get_Info (Block);
+         Scheme : constant Iir := Get_Generation_Scheme (Block);
+
+         Type_Info : Type_Info_Acc;
+         Iter_Type : Iir;
+
+         --  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_Scope),
+                               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));
+            Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var_Inst);
+            Translate_Block_Configuration_Calls (Block_Config, Block, Info);
+            Clear_Scope (Info.Block_Scope);
+
+            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;
+
+         procedure Apply_To_All_Others_Blocks (Is_All : Boolean)
+         is
+            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)), Is_All);
+            Inc_Var (Var_I);
+            Finish_Loop_Stmt (Label);
+            Finish_Declare_Stmt;
+         end Apply_To_All_Others_Blocks;
+      begin
+         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_Simple_Name =>
+                  Apply_To_All_Others_Blocks (True);
+               when Iir_Kind_Indexed_Name =>
+                  declare
+                     Index_List : constant Iir_List := Get_Index_List (Spec);
+                     Rng : Mnode;
+                  begin
+                     if Index_List = Iir_List_Others then
+                        Apply_To_All_Others_Blocks (False);
+                     else
+                        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 (Index_List, 0), Iter_Type),
+                              Scheme, Iter_Type, Spec),
+                           True);
+                        Close_Temp;
+                     end if;
+                  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_Scope),
+                              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));
+               Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
+               Translate_Block_Configuration_Calls (Block_Config, Block, Info);
+               Clear_Scope (Info.Block_Scope);
+               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;
+         Base_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, Base_Info);
+               when Iir_Kind_Block_Configuration =>
+                  declare
+                     Block : constant Iir := Strip_Denoting_Name
+                       (Get_Block_Specification (El));
+                  begin
+                     if Get_Kind (Block) = Iir_Kind_Block_Statement then
+                        Translate_Block_Configuration_Calls
+                          (El, Base_Block, Get_Info (Block));
+                     else
+                        Translate_Generate_Block_Configuration_Calls
+                          (El, Base_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
+         Block_Config : constant Iir_Block_Configuration :=
+           Get_Block_Configuration (Config);
+         Arch : constant Iir_Architecture_Body :=
+           Get_Block_Specification (Block_Config);
+         Arch_Info : constant Block_Info_Acc := Get_Info (Arch);
+         Interface_List : O_Inter_List;
+         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);
+
+         --  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_Interface_Constant_Declaration
+              | Iir_Kind_Interface_Variable_Declaration
+              | Iir_Kind_Interface_File_Declaration =>
+               Mode := Mode_Value;
+            when Iir_Kind_Interface_Signal_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_Interface_Variable_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;
+
+         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 (Info.Subprg_Frame_Scope'Access);
+            Add_Subprg_Instance_Field (Upframe_Field);
+
+            if Info.Res_Record_Ptr /= O_Tnode_Null then
+               Info.Res_Record_Var :=
+                 Create_Var (Create_Var_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_Scope'Access);
+
+            New_Type_Decl (Create_Identifier ("_FRAMETYPE"),
+                           Get_Scope_Type (Info.Subprg_Frame_Scope));
+            Declare_Scope_Acc
+              (Info.Subprg_Frame_Scope,
+               Create_Identifier ("_FRAMEPTR"), Frame_Ptr_Type);
+
+            Rtis.Generate_Subprogram_Body (Subprg);
+
+            --  Local frame
+            Chap2.Push_Subprg_Instance
+              (Info.Subprg_Frame_Scope'Access, 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);
+
+            Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+
+            --  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);
+
+         --  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;
+
+         if not Has_Nested then
+            Chap4.Translate_Declaration_Chain (Subprg);
+            Rtis.Generate_Subprogram_Body (Subprg);
+            Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+         else
+            New_Var_Decl (Frame, Wki_Frame, O_Storage_Local,
+                          Get_Scope_Type (Info.Subprg_Frame_Scope));
+
+            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));
+
+            --  FIXME: use direct reference (ie Frame instead of Frame_Ptr)
+            Set_Scope_Via_Param_Ptr (Info.Subprg_Frame_Scope, 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 (Get_Var (Info.Res_Record_Var),
+                                New_Obj_Value (Info.Res_Interface));
+               --  Do not reference the RESULT field in the subprogram body,
+               --  directly reference the RESULT parameter.
+               --  FIXME: has a flag (see below for parameters).
+               Info.Res_Record_Var := Null_Var;
+            end if;
+
+            --  Copy parameters 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;
+
+         --  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_Interface_Variable_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;
+
+         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
+            Clear_Scope (Info.Subprg_Frame_Scope);
+         end if;
+
+         Chap2.Pop_Subprg_Instance (O_Ident_Nul, Prev_Subprg_Instances);
+         Close_Local_Temp;
+         Pop_Local_Factory;
+
+         Finish_Subprg_Instance_Use (Spec);
+
+         Finish_Subprogram_Body;
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Subprogram_Body;
+
+      procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
+      is
+         Header : constant Iir := Get_Package_Header (Decl);
+         Info : Ortho_Info_Acc;
+         Interface_List : O_Inter_List;
+         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
+      begin
+         Info := Add_Info (Decl, Kind_Package);
+
+         --  Translate declarations.
+         if Is_Uninstantiated_Package (Decl) then
+            --  Create an instance for the spec.
+            Push_Instance_Factory (Info.Package_Spec_Scope'Access);
+            Chap4.Translate_Generic_Chain (Header);
+            Chap4.Translate_Declaration_Chain (Decl);
+            Info.Package_Elab_Var := Create_Var
+              (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
+            Pop_Instance_Factory (Info.Package_Spec_Scope'Access);
+
+            --  Name the spec instance and create a pointer.
+            New_Type_Decl (Create_Identifier ("SPECINSTTYPE"),
+                           Get_Scope_Type (Info.Package_Spec_Scope));
+            Declare_Scope_Acc (Info.Package_Spec_Scope,
+                               Create_Identifier ("SPECINSTPTR"),
+                               Info.Package_Spec_Ptr_Type);
+
+            --  Create an instance and its pointer for the body.
+            Chap2.Declare_Inst_Type_And_Ptr
+              (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type);
+
+            --  Each subprogram has a body instance argument.
+            Chap2.Push_Subprg_Instance
+              (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type,
+               Wki_Instance, Prev_Subprg_Instance);
+         else
+            Chap4.Translate_Declaration_Chain (Decl);
+            Info.Package_Elab_Var := Create_Var
+              (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
+         end if;
+
+         --  Translate subprograms declarations.
+         Chap4.Translate_Declaration_Chain_Subprograms (Decl);
+
+         --  Declare elaborator for the body.
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
+         Chap2.Add_Subprg_Instance_Interfaces
+           (Interface_List, Info.Package_Elab_Body_Instance);
+         Finish_Subprogram_Decl
+           (Interface_List, Info.Package_Elab_Body_Subprg);
+
+         if Is_Uninstantiated_Package (Decl) then
+            Chap2.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
+
+            --  The spec elaborator has a spec instance argument.
+            Chap2.Push_Subprg_Instance
+              (Info.Package_Spec_Scope'Access, Info.Package_Spec_Ptr_Type,
+               Wki_Instance, Prev_Subprg_Instance);
+         end if;
+
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
+         Chap2.Add_Subprg_Instance_Interfaces
+           (Interface_List, Info.Package_Elab_Spec_Instance);
+         Finish_Subprogram_Decl
+           (Interface_List, Info.Package_Elab_Spec_Subprg);
+
+         if Flag_Rti then
+            --  Generate RTI.
+            Rtis.Generate_Unit (Decl);
+         end if;
+
+         if Global_Storage = O_Storage_Public then
+            --  Create elaboration procedure for the spec
+            Elab_Package (Decl);
+         end if;
+
+         if Is_Uninstantiated_Package (Decl) then
+            Chap2.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
+         end if;
+         Save_Local_Identifier (Info.Package_Local_Id);
+      end Translate_Package_Declaration;
+
+      procedure Translate_Package_Body (Decl : Iir_Package_Body)
+      is
+         Spec : constant Iir_Package_Declaration := Get_Package (Decl);
+         Info : constant Ortho_Info_Acc := Get_Info (Spec);
+         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
+      begin
+         --  Translate declarations.
+         if Is_Uninstantiated_Package (Spec) then
+            Push_Instance_Factory (Info.Package_Body_Scope'Access);
+            Info.Package_Spec_Field := Add_Instance_Factory_Field
+              (Get_Identifier ("SPEC"),
+               Get_Scope_Type (Info.Package_Spec_Scope));
+
+            Chap4.Translate_Declaration_Chain (Decl);
+
+            Pop_Instance_Factory (Info.Package_Body_Scope'Access);
+
+            if Global_Storage = O_Storage_External then
+               return;
+            end if;
+         else
+            --  May be called during elaboration to generate RTI.
+            if Global_Storage = O_Storage_External then
+               return;
+            end if;
+
+            Restore_Local_Identifier (Get_Info (Spec).Package_Local_Id);
+
+            Chap4.Translate_Declaration_Chain (Decl);
+         end if;
+
+         if Flag_Rti then
+            Rtis.Generate_Unit (Decl);
+         end if;
+
+         if Is_Uninstantiated_Package (Spec) then
+            Chap2.Push_Subprg_Instance
+              (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type,
+               Wki_Instance, Prev_Subprg_Instance);
+            Set_Scope_Via_Field (Info.Package_Spec_Scope,
+                                 Info.Package_Spec_Field,
+                                 Info.Package_Body_Scope'Access);
+         end if;
+
+         Chap4.Translate_Declaration_Chain_Subprograms (Decl);
+
+         if Is_Uninstantiated_Package (Spec) then
+            Clear_Scope (Info.Package_Spec_Scope);
+            Chap2.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
+         end if;
+
+         Elab_Package_Body (Spec, Decl);
+      end Translate_Package_Body;
+
+      procedure Elab_Package (Spec : Iir_Package_Declaration)
+      is
+         Info : constant Ortho_Info_Acc := Get_Info (Spec);
+         Final : Boolean;
+         Constr : O_Assoc_List;
+         pragma Unreferenced (Final);
+      begin
+         Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg);
+         Push_Local_Factory;
+         Chap2.Start_Subprg_Instance_Use (Info.Package_Elab_Spec_Instance);
+
+         Elab_Dependence (Get_Design_Unit (Spec));
+
+         if not Is_Uninstantiated_Package (Spec)
+           and then Get_Kind (Get_Parent (Spec)) = Iir_Kind_Design_Unit
+         then
+            --  Register the top level 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
+            --  instantiated 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);
+         end if;
+
+         Open_Temp;
+         Chap4.Elab_Declaration_Chain (Spec, Final);
+         Close_Temp;
+
+         Chap2.Finish_Subprg_Instance_Use (Info.Package_Elab_Spec_Instance);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Elab_Package;
+
+      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir)
+      is
+         Info : constant Ortho_Info_Acc := Get_Info (Spec);
+         If_Blk : O_If_Block;
+         Constr : O_Assoc_List;
+         Final : Boolean;
+      begin
+         Start_Subprogram_Body (Info.Package_Elab_Body_Subprg);
+         Push_Local_Factory;
+         Chap2.Start_Subprg_Instance_Use (Info.Package_Elab_Body_Instance);
+
+         if Is_Uninstantiated_Package (Spec) then
+            Set_Scope_Via_Field (Info.Package_Spec_Scope,
+                                 Info.Package_Spec_Field,
+                                 Info.Package_Body_Scope'Access);
+         end if;
+
+         --  If the package was already elaborated, return now,
+         --  else mark the package as elaborated.
+         Start_If_Stmt (If_Blk, New_Value (Get_Var (Info.Package_Elab_Var)));
+         New_Return_Stmt;
+         New_Else_Stmt (If_Blk);
+         New_Assign_Stmt (Get_Var (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);
+         Add_Subprg_Instance_Assoc (Constr, Info.Package_Elab_Spec_Instance);
+         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;
+
+         if Is_Uninstantiated_Package (Spec) then
+            Clear_Scope (Info.Package_Spec_Scope);
+         end if;
+
+         Chap2.Finish_Subprg_Instance_Use (Info.Package_Elab_Body_Instance);
+         Pop_Local_Factory;
+         Finish_Subprogram_Body;
+      end Elab_Package_Body;
+
+      procedure Instantiate_Iir_Info (N : Iir);
+
+      procedure Instantiate_Iir_Chain_Info (Chain : Iir)
+      is
+         N : Iir;
+      begin
+         N := Chain;
+         while N /= Null_Iir loop
+            Instantiate_Iir_Info (N);
+            N := Get_Chain (N);
+         end loop;
+      end Instantiate_Iir_Chain_Info;
+
+      procedure Instantiate_Iir_List_Info (L : Iir_List)
+      is
+         El : Iir;
+      begin
+         case L is
+            when Null_Iir_List
+              | Iir_List_All
+              | Iir_List_Others =>
+               return;
+            when others =>
+               for I in Natural loop
+                  El := Get_Nth_Element (L, I);
+                  exit when El = Null_Iir;
+                  Instantiate_Iir_Info (El);
+               end loop;
+         end case;
+      end Instantiate_Iir_List_Info;
+
+      procedure Copy_Info (Dest : Ortho_Info_Acc; Src : Ortho_Info_Acc) is
+      begin
+         case Src.Kind is
+            when Kind_Type =>
+               Dest.all := (Kind => Kind_Type,
+                            Type_Mode => Src.Type_Mode,
+                            Type_Incomplete => Src.Type_Incomplete,
+                            Type_Locally_Constrained =>
+                              Src.Type_Locally_Constrained,
+                            C => null,
+                            Ortho_Type => Src.Ortho_Type,
+                            Ortho_Ptr_Type => Src.Ortho_Ptr_Type,
+                            Type_Transient_Chain => Null_Iir,
+                            T => Src.T,
+                            Type_Rti => Src.Type_Rti);
+               pragma Assert (Src.C = null);
+               pragma Assert (Src.Type_Transient_Chain = Null_Iir);
+            when Kind_Object =>
+               pragma Assert (Src.Object_Driver = Null_Var);
+               pragma Assert (Src.Object_Function = O_Dnode_Null);
+               Dest.all :=
+                 (Kind => Kind_Object,
+                  Object_Static => Src.Object_Static,
+                  Object_Var => Instantiate_Var (Src.Object_Var),
+                  Object_Driver => Null_Var,
+                  Object_Rti => Src.Object_Rti,
+                  Object_Function => O_Dnode_Null);
+            when Kind_Subprg =>
+               Dest.Subprg_Frame_Scope :=
+                 Instantiate_Var_Scope (Src.Subprg_Frame_Scope);
+               Dest.all :=
+                 (Kind => Kind_Subprg,
+                  Use_Stack2 => Src.Use_Stack2,
+                  Ortho_Func => Src.Ortho_Func,
+                  Res_Interface => Src.Res_Interface,
+                  Res_Record_Var => Instantiate_Var (Src.Res_Record_Var),
+                  Res_Record_Type => Src.Res_Record_Type,
+                  Res_Record_Ptr => Src.Res_Record_Ptr,
+                  Subprg_Frame_Scope => Dest.Subprg_Frame_Scope,
+                  Subprg_Instance => Instantiate_Subprg_Instance
+                    (Src.Subprg_Instance),
+                  Subprg_Resolv => null,
+                  Subprg_Local_Id => Src.Subprg_Local_Id,
+                  Subprg_Exit => Src.Subprg_Exit,
+                  Subprg_Result => Src.Subprg_Result);
+            when Kind_Interface =>
+               Dest.all := (Kind => Kind_Interface,
+                            Interface_Node => Src.Interface_Node,
+                            Interface_Field => Src.Interface_Field,
+                            Interface_Type => Src.Interface_Type);
+            when Kind_Index =>
+               Dest.all := (Kind => Kind_Index,
+                            Index_Field => Src.Index_Field);
+            when Kind_Expr =>
+               Dest.all := (Kind => Kind_Expr,
+                            Expr_Node => Src.Expr_Node);
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Copy_Info;
+
+      procedure Instantiate_Iir_Info (N : Iir) is
+      begin
+         --  Nothing to do for null node.
+         if N = Null_Iir then
+            return;
+         end if;
+
+         declare
+            use Nodes_Meta;
+            Kind : constant Iir_Kind := Get_Kind (N);
+            Fields : constant Fields_Array := Get_Fields (Kind);
+            F : Fields_Enum;
+            Orig : constant Iir := Sem_Inst.Get_Origin (N);
+            pragma Assert (Orig /= Null_Iir);
+            Orig_Info : constant Ortho_Info_Acc := Get_Info (Orig);
+            Info : Ortho_Info_Acc;
+         begin
+            if Orig_Info /= null then
+               Info := Add_Info (N, Orig_Info.Kind);
+
+               Copy_Info (Info, Orig_Info);
+
+               case Info.Kind is
+                  when Kind_Subprg =>
+                     Push_Instantiate_Var_Scope
+                       (Info.Subprg_Frame_Scope'Access,
+                        Orig_Info.Subprg_Frame_Scope'Access);
+                  when others =>
+                     null;
+               end case;
+            end if;
+
+            for I in Fields'Range loop
+               F := Fields (I);
+               case Get_Field_Type (F) is
+                  when Type_Iir =>
+                     case Get_Field_Attribute (F) is
+                        when Attr_None =>
+                           Instantiate_Iir_Info (Get_Iir (N, F));
+                        when Attr_Ref =>
+                           null;
+                        when Attr_Maybe_Ref =>
+                           if not Get_Is_Ref (N) then
+                              Instantiate_Iir_Info (Get_Iir (N, F));
+                           end if;
+                        when Attr_Chain =>
+                           Instantiate_Iir_Chain_Info (Get_Iir (N, F));
+                        when Attr_Chain_Next =>
+                           null;
+                        when Attr_Of_Ref =>
+                           raise Internal_Error;
+                     end case;
+                  when Type_Iir_List =>
+                     case Get_Field_Attribute (F) is
+                        when Attr_None =>
+                           Instantiate_Iir_List_Info (Get_Iir_List (N, F));
+                        when Attr_Ref
+                          | Attr_Of_Ref =>
+                           null;
+                        when others =>
+                           raise Internal_Error;
+                     end case;
+                  when Type_PSL_NFA
+                    | Type_PSL_Node =>
+                     --  TODO
+                     raise Internal_Error;
+                  when Type_Date_Type
+                    | Type_Date_State_Type
+                    | Type_Time_Stamp_Id =>
+                     --  Can this happen ?
+                     raise Internal_Error;
+                  when Type_String_Id
+                    | Type_Source_Ptr
+                    | Type_Base_Type
+                    | Type_Iir_Constraint
+                    | Type_Iir_Mode
+                    | Type_Iir_Index32
+                    | Type_Iir_Int64
+                    | Type_Boolean
+                    | Type_Iir_Staticness
+                    | Type_Iir_All_Sensitized
+                    | Type_Iir_Signal_Kind
+                    | Type_Tri_State_Type
+                    | Type_Iir_Pure_State
+                    | Type_Iir_Delay_Mechanism
+                    | Type_Iir_Lexical_Layout_Type
+                    | Type_Iir_Predefined_Functions
+                    | Type_Iir_Direction
+                    | Type_Location_Type
+                    | Type_Iir_Int32
+                    | Type_Int32
+                    | Type_Iir_Fp64
+                    | Type_Token_Type
+                    | Type_Name_Id =>
+                     null;
+               end case;
+            end loop;
+
+            if Info /= null then
+               case Info.Kind is
+                  when Kind_Subprg =>
+                     Pop_Instantiate_Var_Scope
+                       (Info.Subprg_Frame_Scope'Access);
+                  when others =>
+                     null;
+               end case;
+            end if;
+         end;
+      end Instantiate_Iir_Info;
+
+      procedure Instantiate_Iir_Generic_Chain_Info (Chain : Iir)
+      is
+         Inter : Iir;
+         Orig : Iir;
+         Orig_Info : Ortho_Info_Acc;
+         Info : Ortho_Info_Acc;
+      begin
+         Inter := Chain;
+         while Inter /= Null_Iir loop
+            case Get_Kind (Inter) is
+               when Iir_Kind_Interface_Constant_Declaration =>
+                  Orig := Sem_Inst.Get_Origin (Inter);
+                  Orig_Info := Get_Info (Orig);
+
+                  Info := Add_Info (Inter, Orig_Info.Kind);
+                  Copy_Info (Info, Orig_Info);
+
+               when Iir_Kind_Interface_Package_Declaration =>
+                  null;
+
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            Inter := Get_Chain (Inter);
+         end loop;
+      end Instantiate_Iir_Generic_Chain_Info;
+
+      --  Add info for an interface_package_declaration or a
+      --  package_instantiation_declaration
+      procedure Instantiate_Info_Package (Inst : Iir)
+      is
+         Spec : constant Iir :=
+           Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst));
+         Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec);
+         Info : Ortho_Info_Acc;
+      begin
+         Info := Add_Info (Inst, Kind_Package_Instance);
+
+         --  Create the info instances.
+         Push_Instantiate_Var_Scope
+           (Info.Package_Instance_Spec_Scope'Access,
+            Pkg_Info.Package_Spec_Scope'Access);
+         Push_Instantiate_Var_Scope
+           (Info.Package_Instance_Body_Scope'Access,
+            Pkg_Info.Package_Body_Scope'Access);
+         Instantiate_Iir_Generic_Chain_Info (Get_Generic_Chain (Inst));
+         Instantiate_Iir_Chain_Info (Get_Declaration_Chain (Inst));
+         Pop_Instantiate_Var_Scope
+           (Info.Package_Instance_Body_Scope'Access);
+         Pop_Instantiate_Var_Scope
+           (Info.Package_Instance_Spec_Scope'Access);
+      end Instantiate_Info_Package;
+
+      procedure Translate_Package_Instantiation_Declaration (Inst : Iir)
+      is
+         Spec : constant Iir :=
+           Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst));
+         Pkg_Info : constant Ortho_Info_Acc := Get_Info (Spec);
+         Info : Ortho_Info_Acc;
+         Interface_List : O_Inter_List;
+         Constr : O_Assoc_List;
+      begin
+         Instantiate_Info_Package (Inst);
+         Info := Get_Info (Inst);
+
+         --  FIXME: if the instantiation occurs within a package declaration,
+         --  the variable must be declared extern (and public in the body).
+         Info.Package_Instance_Body_Var := Create_Var
+           (Create_Var_Identifier (Inst),
+            Get_Scope_Type (Pkg_Info.Package_Body_Scope));
+
+         --  FIXME: this is correct only for global instantiation, and only if
+         --  there is only one.
+         Set_Scope_Via_Decl (Info.Package_Instance_Body_Scope,
+                             Get_Var_Label (Info.Package_Instance_Body_Var));
+         Set_Scope_Via_Field (Info.Package_Instance_Spec_Scope,
+                              Pkg_Info.Package_Spec_Field,
+                              Info.Package_Instance_Body_Scope'Access);
+
+         --  Declare elaboration procedure
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB"), Global_Storage);
+         --  Chap2.Add_Subprg_Instance_Interfaces
+         --   (Interface_List, Info.Package_Instance_Elab_Instance);
+         Finish_Subprogram_Decl
+           (Interface_List, Info.Package_Instance_Elab_Subprg);
+
+         if Global_Storage /= O_Storage_Public then
+            return;
+         end if;
+
+         --  Elaborator:
+         Start_Subprogram_Body (Info.Package_Instance_Elab_Subprg);
+         --  Chap2.Start_Subprg_Instance_Use
+         --    (Info.Package_Instance_Elab_Instance);
+
+         Elab_Dependence (Get_Design_Unit (Inst));
+
+         Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope,
+                             Get_Var_Label (Info.Package_Instance_Body_Var));
+         Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope,
+                              Pkg_Info.Package_Spec_Field,
+                              Pkg_Info.Package_Body_Scope'Access);
+         Chap5.Elab_Generic_Map_Aspect (Inst);
+         Clear_Scope (Pkg_Info.Package_Spec_Scope);
+         Clear_Scope (Pkg_Info.Package_Body_Scope);
+
+         --  Call the elaborator of the generic.  The generic must be
+         --  temporary associated with the instance variable.
+         Start_Association (Constr, Pkg_Info.Package_Elab_Body_Subprg);
+         Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope,
+                             Get_Var_Label (Info.Package_Instance_Body_Var));
+         Add_Subprg_Instance_Assoc
+           (Constr, Pkg_Info.Package_Elab_Body_Instance);
+         Clear_Scope (Pkg_Info.Package_Body_Scope);
+         New_Procedure_Call (Constr);
+
+         --  Chap2.Finish_Subprg_Instance_Use
+         --    (Info.Package_Instance_Elab_Instance);
+         Finish_Subprogram_Body;
+      end Translate_Package_Instantiation_Declaration;
+
+      procedure Elab_Dependence_Package (Pkg : Iir_Package_Declaration)
+      is
+         Info : Ortho_Info_Acc;
+         If_Blk : O_If_Block;
+         Constr : O_Assoc_List;
+      begin
+         --  Std.Standard is pre-elaborated.
+         if Pkg = Standard_Package then
+            return;
+         end if;
+
+         --  Nothing to do for uninstantiated package.
+         if Is_Uninstantiated_Package (Pkg) then
+            return;
+         end if;
+
+         --  Call the package elaborator only if not already elaborated.
+         Info := Get_Info (Pkg);
+         Start_If_Stmt
+           (If_Blk,
+            New_Monadic_Op (ON_Not,
+                            New_Value (Get_Var (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 Elab_Dependence_Package;
+
+      procedure Elab_Dependence_Package_Instantiation (Pkg : Iir)
+      is
+         Info : constant Ortho_Info_Acc := Get_Info (Pkg);
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Info.Package_Instance_Elab_Subprg);
+         New_Procedure_Call (Constr);
+      end Elab_Dependence_Package_Instantiation;
+
+      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit)
+      is
+         Depend_List: Iir_Design_Unit_List;
+         Design: Iir;
+         Library_Unit: Iir;
+      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 =>
+                     Elab_Dependence_Package (Library_Unit);
+                  when Iir_Kind_Package_Instantiation_Declaration =>
+                     Elab_Dependence_Package_Instantiation (Library_Unit);
+                  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 Iir_Kind_Package_Body =>
+                     --  A package instantiation depends on the body.
+                     null;
+                  when others =>
+                     Error_Kind ("elab_dependence", Library_Unit);
+               end case;
+            end if;
+         end loop;
+      end Elab_Dependence;
+
+      procedure Declare_Inst_Type_And_Ptr (Scope : Var_Scope_Acc;
+                                           Ptr_Type : out O_Tnode) is
+      begin
+         Predeclare_Scope_Type (Scope, Create_Identifier ("INSTTYPE"));
+         Declare_Scope_Acc
+           (Scope.all, Create_Identifier ("INSTPTR"), Ptr_Type);
+      end Declare_Inst_Type_And_Ptr;
+
+      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 (Scope : Var_Scope_Acc;
+                                      Ptr_Type : O_Tnode;
+                                      Ident : O_Ident;
+                                      Prev : out Subprg_Instance_Stack)
+      is
+      begin
+         Prev := Current_Subprg_Instance;
+         Current_Subprg_Instance := (Scope => Scope,
+                                     Ptr_Type => Ptr_Type,
+                                     Ident => Ident);
+      end Push_Subprg_Instance;
+
+      function Has_Current_Subprg_Instance return Boolean is
+      begin
+         return Current_Subprg_Instance.Ptr_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.Scope := Current_Subprg_Instance.Scope;
+            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;
+
+      function Has_Subprg_Instance (Vars : Subprg_Instance_Type)
+                                   return Boolean is
+      begin
+         return Vars.Inter /= O_Dnode_Null;
+      end Has_Subprg_Instance;
+
+      function Get_Subprg_Instance (Vars : Subprg_Instance_Type)
+                                   return O_Enode is
+      begin
+         pragma Assert (Has_Subprg_Instance (Vars));
+         return New_Address (Get_Instance_Ref (Vars.Scope.all),
+                             Vars.Inter_Type);
+      end Get_Subprg_Instance;
+
+      procedure Add_Subprg_Instance_Assoc
+        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Type) is
+      begin
+         if Has_Subprg_Instance (Vars) then
+            New_Association (Assocs, Get_Subprg_Instance (Vars));
+         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 Has_Subprg_Instance (Vars) 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 Has_Subprg_Instance (Vars) then
+            Set_Scope_Via_Param_Ptr (Vars.Scope.all, Vars.Inter);
+         end if;
+      end Start_Subprg_Instance_Use;
+
+      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Type) is
+      begin
+         if Has_Subprg_Instance (Vars) then
+            Clear_Scope (Vars.Scope.all);
+         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
+            Set_Scope_Via_Field_Ptr (Prev.Scope.all, Field,
+                                     Current_Subprg_Instance.Scope);
+         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
+            Clear_Scope (Prev.Scope.all);
+         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;
+
+      function Instantiate_Subprg_Instance (Inst : Subprg_Instance_Type)
+                                           return Subprg_Instance_Type is
+      begin
+         return Subprg_Instance_Type'
+           (Inter => Inst.Inter,
+            Inter_Type => Inst.Inter_Type,
+            Scope => Instantiated_Var_Scope (Inst.Scope));
+      end Instantiate_Subprg_Instance;
+   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);
+
+      --  For scalar subtypes: creates info from the base type.
+      procedure Create_Subtype_Info_From_Type (Def : Iir;
+                                               Subtype_Info : Type_Info_Acc;
+                                               Base_Info : Type_Info_Acc);
+
+      --  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 : constant Type_Info_Acc := Get_Info (Def);
+      begin
+         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 : constant Type_Info_Acc := Get_Info (Var_Type);
+         Binfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Var_Type));
+         Assoc : O_Assoc_List;
+      begin
+         --  Build the field
+         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;
+
+         if Tinfo.Type_Mode in Type_Mode_Arrays then
+            declare
+               Arr : Mnode;
+            begin
+               case Type_Mode_Arrays (Tinfo.Type_Mode) is
+                  when Type_Mode_Array =>
+                     Arr := T2M (Var_Type, Kind);
+                  when Type_Mode_Fat_Array =>
+                     Arr := Dp2M (Var_Ptr, Tinfo, Kind);
+               end case;
+               New_Association
+                 (Assoc, M2Addr (Chap3.Get_Array_Bounds (Arr)));
+            end;
+         end if;
+
+         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_B1;
+         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
+         Phy_Type : constant O_Tnode := Get_Ortho_Type (Def, Mode_Value);
+         Unit : Iir;
+         Info : Object_Info_Acc;
+      begin
+         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;
+
+      --  Declare the bounds types for DEF.
+      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_Definition_List (Def);
+         Constr : O_Element_List;
+         Dim : String (1 .. 8);
+         N : Natural;
+         P : Natural;
+         Index : Iir;
+         Index_Info : Index_Info_Acc;
+         Index_Type_Mark : Iir;
+      begin
+         Start_Record_Type (Constr);
+         for I in Natural loop
+            Index_Type_Mark := Get_Nth_Element (Indexes_List, I);
+            exit when Index_Type_Mark = Null_Iir;
+            Index := Get_Index_Type (Index_Type_Mark);
+
+            --  Index comes from a type mark.
+            pragma Assert (not Is_Anonymous_Type_Definition (Index));
+
+            Index_Info := Add_Info (Index_Type_Mark, Kind_Index);
+
+            --  Build the name
+            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, Index_Info.Index_Field,
+                              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_Definition
+        (Def : Iir_Array_Type_Definition)
+      is
+         Info : constant Type_Info_Acc := Get_Info (Def);
+         --  If true, INFO was already partially filled, by a previous access
+         --  type definition to this incomplete array type.
+         Completion : constant Boolean := Info.Type_Mode = Type_Mode_Fat_Array;
+         El_Tinfo : Type_Info_Acc;
+      begin
+         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_Var;
+               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_Definition;
+
+      --  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_Definition
+        (Def : Iir_Array_Subtype_Definition)
+      is
+         Info : constant Type_Info_Acc := Get_Info (Def);
+         Base_Type : constant Iir := Get_Base_Type (Def);
+         Binfo : constant Type_Info_Acc := Get_Info (Base_Type);
+
+         Len : Iir_Int64;
+
+         Id : O_Ident;
+      begin
+         --  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_Definition;
+
+      procedure Translate_Array_Subtype_Element_Subtype
+        (Def : Iir_Array_Subtype_Definition)
+      is
+         El_Type : constant Iir := Get_Element_Subtype (Def);
+         Type_Mark : constant Iir := Get_Denoted_Type_Mark (Def);
+         Tm_El_Type : Iir;
+      begin
+         if Type_Mark = Null_Iir then
+            --  Array subtype for constained array definition.  Same element
+            --  subtype as the base type.
+            return;
+         end if;
+
+         Tm_El_Type := Get_Element_Subtype (Type_Mark);
+         if El_Type = Tm_El_Type then
+            --  Same element subtype as the type mark.
+            return;
+         end if;
+
+         case Get_Kind (El_Type) is
+            when Iir_Kinds_Scalar_Subtype_Definition =>
+               declare
+                  El_Info : Ortho_Info_Acc;
+               begin
+                  El_Info := Add_Info (El_Type, Kind_Type);
+                  Create_Subtype_Info_From_Type
+                    (El_Type, El_Info, Get_Info (Tm_El_Type));
+               end;
+            when others =>
+               Error_Kind ("translate_array_subtype_element_subtype", El_Type);
+         end case;
+      end Translate_Array_Subtype_Element_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
+         Base_Type : constant Iir := Get_Base_Type (Def);
+         Baseinfo : constant Type_Info_Acc := Get_Info (Base_Type);
+         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def);
+         Indexes_Def_List : constant Iir_List :=
+           Get_Index_Subtype_Definition_List (Base_Type);
+         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);
+               Base_Index_Info : constant Index_Info_Acc :=
+                 Get_Info (Get_Nth_Element (Indexes_Def_List, I));
+               D : O_Dnode;
+            begin
+               Open_Temp;
+               D := Create_Temp_Ptr
+                 (Index_Info.T.Range_Ptr_Type,
+                  New_Selected_Element (M2Lv (Targ),
+                                        Base_Index_Info.Index_Field));
+               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 : constant Type_Info_Acc := Get_Info (Def);
+         Base_Info : Type_Info_Acc;
+         Val : O_Cnode;
+      begin
+         if Info.T.Array_Bounds /= Null_Var 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_Length (Dp2M (Bound, Info,
+                                                    Mode_Value,
+                                                    Info.T.Bounds_Type,
+                                                    Info.T.Bounds_Ptr_Type),
+                                              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 : constant Type_Info_Acc := Get_Info (Def);
+         Mark : Id_Mark_Type;
+      begin
+         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.
+         Push_Identifier_Prefix
+           (Mark, Get_Identifier (Get_Type_Declarator (Def)));
+         Chap4.Translate_Declaration_Chain (Def);
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Protected_Type;
+
+      procedure Translate_Protected_Type_Subprograms
+        (Def : Iir_Protected_Type_Declaration)
+      is
+         Info : constant Type_Info_Acc := Get_Info (Def);
+         El : Iir;
+         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)));
+
+         --  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.T.Prot_Scope'Unrestricted_Access,
+                                     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 : constant Iir_Protected_Type_Declaration :=
+           Get_Protected_Type_Declaration (Bod);
+         Info : constant Type_Info_Acc := Get_Info (Decl);
+         Mark : Id_Mark_Type;
+      begin
+         Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
+
+         --  Create the object type
+         Push_Instance_Factory (Info.T.Prot_Scope'Unrestricted_Access);
+         --  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.T.Prot_Scope'Unrestricted_Access);
+         Info.Ortho_Type (Mode_Value) := Get_Scope_Type (Info.T.Prot_Scope);
+
+         Pop_Identifier_Prefix (Mark);
+      end Translate_Protected_Type_Body;
+
+      procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode)
+      is
+         Info : constant Type_Info_Acc := Get_Info (Type_Def);
+         Assoc : O_Assoc_List;
+      begin
+         Start_Association (Assoc, Proc);
+         New_Association
+           (Assoc,
+            New_Unchecked_Address
+              (New_Selected_Element
+                 (Get_Instance_Ref (Info.T.Prot_Scope),
+                  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
+         Mark : Id_Mark_Type;
+         Decl : constant Iir := Get_Protected_Type_Declaration (Bod);
+         Info : constant Type_Info_Acc := Get_Info (Decl);
+         Final : Boolean;
+         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
+      begin
+         Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
+
+         --  Subprograms of BOD.
+         Chap2.Push_Subprg_Instance (Info.T.Prot_Scope'Unrestricted_Access,
+                                     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);
+
+         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);
+
+         Pop_Identifier_Prefix (Mark);
+
+         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);
+
+            Set_Scope_Via_Param_Ptr (Info.T.Prot_Scope, Var_Obj);
+
+            --   Create lock.
+            Call_Ghdl_Protected_Procedure (Decl, Ghdl_Protected_Init);
+
+            --   Elaborate fields.
+            Open_Temp;
+            Chap4.Elab_Declaration_Chain (Bod, Final);
+            Close_Temp;
+
+            Clear_Scope (Info.T.Prot_Scope);
+
+            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_Kinds_Scalar_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_Kinds_Scalar_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;
+
+      --  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_B1 =>
+               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;
+
+      --  For scalar subtypes: creates info from the base type.
+      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;
+
+      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_Var 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 : constant Type_Info_Acc := Get_Info (Def);
+         Base_Info : Type_Info_Acc;
+         Val : O_Cnode;
+         Suffix : String (1 .. 3) := "xTR";
+      begin
+         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;
+
+      --  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
+               --  The subtype was already translated.
+               return;
+            end if;
+            if Info.Kind = Kind_Incomplete_Type then
+               --  Type is being completed.
+               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_Var;
+               end if;
+
+            when Iir_Kind_Floating_Type_Definition =>
+               Translate_Floating_Type (Def);
+               Create_Scalar_Type_Range_Type (Def, False);
+
+            when Iir_Kinds_Scalar_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_Var;
+               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_Definition (Def);
+
+            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_Definition (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
+                  --  An unconstrained array subtype.  Use same infos as base
+                  --  type.
+                  Free_Info (Def);
+                  Set_Info (Def, Base_Info);
+               end if;
+               Translate_Array_Subtype_Element_Subtype (Def);
+
+            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);
+         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
+         Indexes_List : constant Iir_List :=
+           Get_Index_Subtype_Definition_List (Get_Base_Type (Atype));
+         Index_Type_Mark : constant Iir :=
+           Get_Nth_Element (Indexes_List, Dim - 1);
+         Index_Type : constant Iir := Get_Index_Type (Index_Type_Mark);
+         Base_Index_Info : constant Index_Info_Acc :=
+           Get_Info (Index_Type_Mark);
+         Iinfo : constant Type_Info_Acc :=
+           Get_Info (Get_Base_Type (Index_Type));
+      begin
+         return Lv2M (New_Selected_Element (M2Lv (B),
+                                            Base_Index_Info.Index_Field),
+                      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 : constant Type_Info_Acc := Get_Type_Info (R);
+      begin
+         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_Bounds_Length (Bounds : Mnode; Atype : Iir) return O_Enode
+      is
+         Type_Info : constant Type_Info_Acc := Get_Info (Atype);
+         Index_List : constant Iir_List := Get_Index_Subtype_List (Atype);
+         Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
+         Dim_Length : O_Enode;
+         Res : O_Enode;
+         Bounds_Stable : Mnode;
+      begin
+         if Type_Info.Type_Locally_Constrained then
+            return New_Lit (Get_Thin_Array_Length (Atype));
+         end if;
+
+         if Nbr_Dim > 1 then
+            Bounds_Stable := Stabilize (Bounds);
+         else
+            Bounds_Stable := Bounds;
+         end if;
+
+         for Dim in 1 .. Nbr_Dim loop
+            Dim_Length :=
+              M2E (Range_To_Length
+                     (Bounds_To_Range (Bounds_Stable, 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_Bounds_Length;
+
+      function Get_Array_Type_Length (Atype : Iir) return O_Enode
+      is
+         Type_Info : constant Type_Info_Acc := Get_Info (Atype);
+      begin
+         if Type_Info.Type_Locally_Constrained then
+            return New_Lit (Get_Thin_Array_Length (Atype));
+         else
+            return Get_Bounds_Length (Get_Array_Type_Bounds (Atype), Atype);
+         end if;
+      end Get_Array_Type_Length;
+
+      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode
+      is
+         Type_Info : constant Type_Info_Acc := Get_Info (Atype);
+      begin
+         if Type_Info.Type_Locally_Constrained then
+            return New_Lit (Get_Thin_Array_Length (Atype));
+         else
+            return Get_Bounds_Length (Get_Array_Bounds (Arr), Atype);
+         end if;
+      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;
+
+      procedure Allocate_Fat_Array_Base (Alloc_Kind : Allocation_Kind;
+                                         Res : Mnode;
+                                         Arr_Type : Iir)
+      is
+         Dinfo : constant Type_Info_Acc :=
+           Get_Info (Get_Base_Type (Arr_Type));
+         Kind : constant Object_Kind_Type := Get_Object_Kind (Res);
+         Length : O_Enode;
+      begin
+         --  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.
+               D := Stabilize (Dest);
+               Copy_Fat_Pointer (D, Stabilize (E2M (Src, Info, Kind)));
+            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 : constant Type_Info_Acc := Get_Type_Info (Obj);
+         Kind : constant Object_Kind_Type := Get_Object_Kind (Obj);
+      begin
+         if Is_Complex_Type (Type_Info)
+           and then Type_Info.C (Kind).Size_Var /= Null_Var
+         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 : Mnode)
+      is
+         Dinfo : constant Type_Info_Acc := Get_Info (Obj_Type);
+         Kind : constant Object_Kind_Type := Get_Object_Kind (Res);
+      begin
+         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)),
+               M2Addr (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;
+
+      function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean
+      is
+         L_Indexes : constant Iir_List := Get_Index_Subtype_List (L_Type);
+         R_Indexes : constant Iir_List := Get_Index_Subtype_List (R_Type);
+         L_El : Iir;
+         R_El : Iir;
+      begin
+         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
+               return False;
+            end if;
+         end loop;
+         return True;
+      end Locally_Array_Match;
+
+      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.
+            if not Locally_Array_Match (L_Type, R_Type) then
+               Chap6.Gen_Bound_Error (Loc);
+            end if;
+         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_Interface_Constant_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_Var 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_Def : constant Iir := Get_Type (Decl);
+         Sig_Type : O_Tnode;
+         Type_Info : Type_Info_Acc;
+         Info : Ortho_Info_Acc;
+      begin
+         Chap3.Translate_Object_Subtype (Decl);
+
+         Type_Info := Get_Info (Sig_Type_Def);
+         Sig_Type := Get_Object_Type (Type_Info, Mode_Signal);
+         pragma Assert (Sig_Type /= O_Tnode_Null);
+
+         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_Interface_Signal_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 Create_Package_Interface (Inter : Iir)
+      is
+         Info : Ortho_Info_Acc;
+         Pkg : constant Iir := Get_Named_Entity
+           (Get_Uninstantiated_Package_Name (Inter));
+         Pkg_Info : constant Ortho_Info_Acc := Get_Info (Pkg);
+      begin
+         Chap2.Instantiate_Info_Package (Inter);
+         Info := Get_Info (Inter);
+
+         --  The spec
+         Info.Package_Instance_Spec_Var :=
+           Create_Var (Create_Var_Identifier (Inter, "SPEC", 0),
+                       Pkg_Info.Package_Spec_Ptr_Type);
+         Set_Scope_Via_Var_Ptr
+           (Info.Package_Instance_Spec_Scope,
+            Info.Package_Instance_Spec_Var);
+
+         --  The body
+         Info.Package_Instance_Body_Var :=
+           Create_Var (Create_Var_Identifier (Inter, "BODY", 0),
+                       Pkg_Info.Package_Body_Ptr_Type);
+         Set_Scope_Via_Var_Ptr
+           (Info.Package_Instance_Body_Scope,
+            Info.Package_Instance_Body_Var);
+      end Create_Package_Interface;
+
+      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_Type : constant Iir := Get_Type (Obj);
+         Obj_Info : constant Object_Info_Acc := Get_Info (Obj);
+
+         Name_Node : Mnode;
+
+         Type_Info : Type_Info_Acc;
+         Alloc_Kind : Allocation_Kind;
+      begin
+         --  Elaborate subtype.
+         Chap3.Elab_Object_Subtype (Obj_Type);
+
+         Type_Info := Get_Info (Obj_Type);
+
+         --  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
+                    (M2Lp (Chap3.Get_Array_Bounds (Name_Node)),
+                     M2Addr (Chap3.Get_Array_Type_Bounds (Aggr_Type)));
+                  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 : Mnode;
+               begin
+                  Name_Node := Stabilize (Name);
+                  S := Stabilize (E2M (Value_Node, Type_Info, Mode_Value));
+
+                  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, S);
+                  else
+                     Chap3.Translate_Object_Allocation
+                       (Name_Node, Alloc_Kind, Obj_Type,
+                        Chap3.Get_Array_Bounds (S));
+                     Chap3.Translate_Object_Copy
+                       (Name_Node, M2Addr (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_Decl : Iir)
+      is
+         Func_Info : constant Subprg_Info_Acc := Get_Info (Func_Decl);
+         Resolv_Info : constant Subprg_Resolv_Info_Acc :=
+           Func_Info.Subprg_Resolv;
+         Val : O_Enode;
+      begin
+         New_Association
+           (Assoc, New_Lit (New_Subprogram_Address (Resolv_Info.Resolv_Func,
+                                                    Ghdl_Ptr_Type)));
+         if Chap2.Has_Subprg_Instance (Resolv_Info.Var_Instance) then
+            Val := New_Convert_Ov
+              (Chap2.Get_Subprg_Instance (Resolv_Info.Var_Instance),
+               Ghdl_Ptr_Type);
+         else
+            Val := New_Lit (New_Null_Access (Ghdl_Ptr_Type));
+         end if;
+         New_Association (Assoc, Val);
+      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 : constant Type_Info_Acc := Get_Info (Targ_Type);
+         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
+         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_B1 =>
+               Create_Subprg := Ghdl_Create_Signal_B1;
+               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 := Has_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 := Has_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_Var;
+      end Has_Direct_Driver;
+
+      procedure Elab_Direct_Driver_Declaration_Storage (Decl : Iir)
+      is
+         Sig_Type : constant Iir := Get_Type (Decl);
+         Sig_Info : constant Ortho_Info_Acc := Get_Info (Decl);
+         Type_Info : constant Type_Info_Acc := Get_Info (Sig_Type);
+         Name_Node : Mnode;
+      begin
+         Open_Temp;
+
+         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_Otype, 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_Otype, 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_Interface_Signal_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
+            case Get_Kind (Decl) is
+               when Iir_Kinds_Interface_Object_Declaration =>
+                  Create_Object (Decl);
+               when Iir_Kind_Interface_Package_Declaration =>
+                  Create_Package_Interface (Decl);
+               when others =>
+                  Error_Kind ("translate_generic_chain", Decl);
+            end case;
+            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 (Info.Comp_Scope'Access);
+
+         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_Scope'Access);
+         New_Type_Decl (Create_Identifier ("_COMPTYPE"),
+                        Get_Scope_Type (Info.Comp_Scope));
+         Info.Comp_Ptr_Type := New_Access_Type
+           (Get_Scope_Type (Info.Comp_Scope));
+         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_Interface_Signal_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 =>
+               --  Useless as attribute declarations have a type mark.
+               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)
+      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;
+         Id : O_Ident;
+         Itype : O_Tnode;
+         Unused_Instance : O_Dnode;
+      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 Chap2.Has_Current_Subprg_Instance then
+            Chap2.Add_Subprg_Instance_Interfaces (Interface_List,
+                                                  Rinfo.Var_Instance);
+         else
+            --  Create a dummy instance parameter
+            New_Interface_Decl (Interface_List, Unused_Instance,
+                                Wki_Instance, Ghdl_Ptr_Type);
+            Rinfo.Var_Instance := Chap2.Null_Subprg_Instance;
+         end if;
+
+         --  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)
+      is
+         --  Type of the resolution function parameter.
+         Arr_Type : Iir;
+         Base_Type : Iir;
+         Base_Info : Type_Info_Acc;
+         Index_Info : Index_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;
+
+         Data : Read_Source_Data;
+      begin
+         if Rinfo = null then
+            --  No 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);
+         Index_Info := Get_Info
+           (Get_First_Element (Get_Index_Subtype_Definition_List (Base_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 Chap2.Has_Subprg_Instance (Rinfo.Var_Instance) then
+            Chap2.Start_Subprg_Instance_Use (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),
+                                               Index_Info.Index_Field),
+                         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.
+         if Finfo.Use_Stack2 then
+            Create_Temp_Stack2_Mark;
+         end if;
+
+         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 Chap2.Has_Subprg_Instance (Rinfo.Var_Instance) then
+            Chap2.Finish_Subprg_Instance_Use (Rinfo.Var_Instance);
+         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)
+      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);
+                  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));
+                  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 : constant Block_Info_Acc := Get_Info (Base_Block);
+         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;
+         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));
+         Set_Scope_Via_Param_Ptr (Block_Info.Block_Scope, 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;
+            begin
+               if Entity_Info.Kind = Kind_Component then
+                  Ptr_Type := Entity_Info.Comp_Ptr_Type;
+               else
+                  Ptr_Type := Entity_Info.Block_Decls_Ptr_Type;
+               end if;
+               V := Create_Temp_Init
+                 (Ptr_Type,
+                  New_Value_Selected_Acc_Value (New_Obj (Var_Data),
+                                                Conv_Info.Instantiated_Field));
+               if Entity_Info.Kind = Kind_Component then
+                  Set_Scope_Via_Param_Ptr (Entity_Info.Comp_Scope, V);
+               else
+                  Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, V);
+               end if;
+            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 Has_Scope_Type (Stmt_Info.Block_Scope)
+         then
+            Set_Scope_Via_Field (Stmt_Info.Block_Scope,
+                                 Stmt_Info.Block_Parent_Field,
+                                 Get_Info (Block).Block_Scope'Access);
+         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_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 Has_Scope_Type (Stmt_Info.Block_Scope)
+         then
+            Clear_Scope (Stmt_Info.Block_Scope);
+         end if;
+         if Conv_Info.Instantiated_Entity /= Null_Iir then
+            if Entity_Info.Kind = Kind_Component then
+               Clear_Scope (Entity_Info.Comp_Scope);
+            else
+               Clear_Scope (Entity_Info.Block_Scope);
+            end if;
+         end if;
+         Clear_Scope (Block_Info.Block_Scope);
+
+         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_Scope),
+                     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_Otype,
+            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_B1 =>
+                     Subprg := Ghdl_Signal_Associate_B1;
+                     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 not Inherit_Collapse_Flag (Get_Associated_Expr (Assoc))
+                  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_Generic_Map_Aspect (Mapping : Iir)
+      is
+         Assoc : Iir;
+         Formal : Iir;
+      begin
+         --  Elab generics, and associate.
+         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 =>
+                  declare
+                     Targ : Mnode;
+                  begin
+                     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;
+                  end;
+               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_Type : constant Iir := Get_Type (Formal);
+                     Obj_Info : constant Object_Info_Acc := Get_Info (Formal);
+                     Obj_Type : constant Iir := Get_Actual_Type (Assoc);
+                     Formal_Node : Mnode;
+                     Type_Info : Type_Info_Acc;
+                     Bounds : Mnode;
+                  begin
+                     Chap3.Elab_Object_Subtype (Formal_Type);
+                     Type_Info := Get_Info (Formal_Type);
+                     Formal_Node := Get_Var
+                       (Obj_Info.Object_Var, Type_Info, Mode_Value);
+                     Stabilize (Formal_Node);
+                     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 := Chap3.Get_Array_Type_Bounds (Obj_Type);
+                        Chap3.Translate_Object_Allocation
+                          (Formal_Node, Alloc_System, Formal_Type, Bounds);
+                     end if;
+                  end;
+               when Iir_Kind_Association_Element_Package =>
+                  pragma Assert (Get_Kind (Formal) =
+                                   Iir_Kind_Interface_Package_Declaration);
+                  declare
+                     Uninst_Pkg : constant Iir := Get_Named_Entity
+                       (Get_Uninstantiated_Package_Name (Formal));
+                     Uninst_Info : constant Ortho_Info_Acc :=
+                       Get_Info (Uninst_Pkg);
+                     Formal_Info : constant Ortho_Info_Acc :=
+                       Get_Info (Formal);
+                     Actual : constant Iir := Get_Named_Entity
+                       (Get_Actual (Assoc));
+                     Actual_Info : constant Ortho_Info_Acc :=
+                       Get_Info (Actual);
+                  begin
+                     New_Assign_Stmt
+                       (Get_Var (Formal_Info.Package_Instance_Spec_Var),
+                        New_Address
+                          (Get_Instance_Ref
+                             (Actual_Info.Package_Instance_Spec_Scope),
+                           Uninst_Info.Package_Spec_Ptr_Type));
+                     New_Assign_Stmt
+                       (Get_Var (Formal_Info.Package_Instance_Body_Var),
+                        New_Address
+                          (Get_Instance_Ref
+                             (Actual_Info.Package_Instance_Body_Scope),
+                           Uninst_Info.Package_Body_Ptr_Type));
+                  end;
+               when others =>
+                  Error_Kind ("elab_generic_map_aspect(1)", Assoc);
+            end case;
+            Close_Temp;
+            Assoc := Get_Chain (Assoc);
+         end loop;
+      end Elab_Generic_Map_Aspect;
+
+      procedure Elab_Port_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;
+      begin
+         --  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_Port_Map_Aspect;
+
+      procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir) is
+      begin
+         --  The generic map must be done before the elaboration of
+         --  the ports, since a port subtype may depend on a generic.
+         Elab_Generic_Map_Aspect (Mapping);
+
+         Elab_Port_Map_Aspect (Mapping, Block_Parent);
+      end Elab_Map_Aspect;
+   end Chap5;
+
+   package body Chap6 is
+      function Get_Array_Bound_Length (Arr : Mnode;
+                                       Arr_Type : Iir;
+                                       Dim : Natural)
+                                      return O_Enode
+      is
+         Index_Type : constant Iir := Get_Index_Type (Arr_Type, Dim - 1);
+         Tinfo : constant Type_Info_Acc := Get_Info (Arr_Type);
+         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
+            return M2E
+              (Chap3.Range_To_Length
+                 (Chap3.Get_Array_Range (Arr, Arr_Type, Dim)));
+         end if;
+      end Get_Array_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_Type : constant Iir := Get_Type (Get_Prefix (Expr));
+         Prefix_Info : constant Type_Info_Acc := Get_Info (Prefix_Type);
+         Index_List : constant Iir_List := Get_Index_List (Expr);
+         Type_List : constant Iir_List := Get_Index_Subtype_List (Prefix_Type);
+         Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
+         Prefix : Mnode;
+         Index : Iir;
+         Offset : O_Dnode;
+         R : O_Enode;
+         Length : O_Enode;
+         Itype : Iir;
+         Ibasetype : Iir;
+         Range_Ptr : Mnode;
+      begin
+         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;
+         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 : constant Iir := Get_Type (Get_Prefix (Expr));
+
+         --  Type info of the prefix.
+         Prefix_Info : Type_Info_Acc;
+
+         --  Type of the first (and only) index of the prefix array type.
+         Index_Type : constant Iir := Get_Index_Type (Prefix_Type, 0);
+
+         --  Type of the slice.
+         Slice_Type : constant Iir := Get_Type (Expr);
+         Slice_Info : Type_Info_Acc;
+
+         --  True iff the direction of the slice is known at compile time.
+         Static_Range : Boolean;
+
+         --  Suffix of the slice (discrete range).
+         Expr_Range : constant Iir := Get_Suffix (Expr);
+
+         --  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_Blk, If_Blk1 : O_If_Block;
+      begin
+         --  Evaluate slice bounds.
+         Chap3.Create_Array_Subtype (Slice_Type, True);
+
+         --  The info may have just been created.
+         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;
+
+         Unsigned_Diff := Create_Temp (Ghdl_Index_Type);
+
+         --  Check if not a null slice.
+         --  The bounds of a null slice may be out of range.  So DIFF cannot
+         --  be computed by substraction.
+         Start_If_Stmt
+           (If_Blk,
+            New_Compare_Op
+              (ON_Eq,
+               M2E (Chap3.Range_To_Length (Slice_Range)),
+               New_Lit (Ghdl_Index_0),
+               Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Unsigned_Diff), New_Lit (Ghdl_Index_0));
+         New_Else_Stmt (If_Blk);
+         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.
+         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;
+         Finish_If_Stmt (If_Blk);
+
+         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
+                  --  Normal case: the parameter was translated as an ortho
+                  --  interface.
+                  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;
+               else
+                  --  The parameter was put somewhere else.
+                  declare
+                     Subprg : constant Iir := Get_Parent (Inter);
+                     Subprg_Info : constant Subprg_Info_Acc :=
+                       Get_Info (Subprg);
+                     Linter : O_Lnode;
+                  begin
+                     if Info.Interface_Node = O_Dnode_Null then
+                        --  The parameter is passed via a field of the RESULT
+                        --  record parameter.
+                        if Subprg_Info.Res_Record_Var = Null_Var then
+                           Linter := New_Obj (Subprg_Info.Res_Interface);
+                        else
+                           --  Unnesting case.
+                           Linter := Get_Var (Subprg_Info.Res_Record_Var);
+                        end if;
+                        return Lv2M (New_Selected_Element
+                                       (New_Acc_Value (Linter),
+                                        Info.Interface_Field),
+                                     Type_Info, Kind);
+                     else
+                        --  Unnesting case: the parameter was copied in the
+                        --  subprogram frame so that nested subprograms can
+                        --  reference it.  Use field in FRAME.
+                        Linter := New_Selected_Element
+                          (Get_Instance_Ref (Subprg_Info.Subprg_Frame_Scope),
+                           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;
+               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);
+--          Clear_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_Interface_Constant_Declaration =>
+--                return Translate_Formal_Interface_Name
+--                  (Scope_Type, Scope_Param, Name, Mode_Value);
+
+--             when Iir_Kind_Interface_Signal_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_Interface_Constant_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Value);
+
+            when Iir_Kind_Interface_File_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Value);
+
+            when Iir_Kind_Interface_Variable_Declaration =>
+               return Translate_Interface_Name (Name, Name_Info, Mode_Value);
+
+            when Iir_Kind_Interface_Signal_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_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_Interface_Signal_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_Expr (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 : constant Iir := Get_Type (Aggr);
+         El_Type : constant Iir := Get_Element_Subtype (Aggr_Type);
+         List : O_Array_Aggr_List;
+         Res : O_Cnode;
+      begin
+         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
+         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_Type
+      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_Type 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_Type;
+         Bound : Var_Type;
+         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);
+
+            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));
+         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
+         Str_Type : constant Iir := Get_Type (Str);
+         Var : Var_Type;
+         Info : Type_Info_Acc;
+         Res : O_Cnode;
+         R : O_Enode;
+      begin
+         if Get_Constraint_State (Str_Type) = Fully_Constrained
+           and then
+           Get_Type_Staticness (Get_Index_Type (Str_Type, 0)) = Locally
+         then
+            Chap3.Create_Array_Subtype (Str_Type, True);
+            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;
+            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));
+            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_Type;
+         Res : O_Cnode;
+         List : O_Record_Aggr_List;
+         Bound : Var_Type;
+      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_Var 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_Interface_Constant_Declaration
+              | Iir_Kind_Interface_File_Declaration =>
+               return Chap3.Maybe_Insert_Scalar_Check
+                 (Translate_Expression (Actual, Get_Type (Formal)),
+                  Actual, Get_Type (Formal));
+            when Iir_Kind_Interface_Signal_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 : Mnode; Res_Type : Iir)
+        return Mnode
+      is
+         Type_Info : constant Type_Info_Acc := Get_Info (Res_Type);
+         Kind : constant Object_Kind_Type := Get_Object_Kind (Expr);
+         Stable_Expr : Mnode;
+         Res : Mnode;
+      begin
+         Res := Create_Temp (Type_Info, Kind);
+         Stable_Expr := Stabilize (Expr);
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Array_Base (Res)),
+            New_Convert_Ov (M2Addr (Chap3.Get_Array_Base (Stable_Expr)),
+                            Type_Info.T.Base_Ptr_Type (Kind)));
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Array_Bounds (Res)),
+            M2Addr (Chap3.Get_Array_Bounds (Stable_Expr)));
+         return Res;
+      end Convert_Constrained_To_Unconstrained;
+
+      function Convert_Array_To_Thin_Array (Expr : Mnode;
+                                            Expr_Type : Iir;
+                                            Atype : Iir;
+                                            Loc : Iir)
+                                           return Mnode
+      is
+         Expr_Indexes : constant Iir_List :=
+           Get_Index_Subtype_List (Expr_Type);
+         Expr_Stable : Mnode;
+         Success_Label, Failure_Label : O_Snode;
+      begin
+         Expr_Stable := Stabilize (Expr);
+
+         Open_Temp;
+         --  Check each dimension.
+         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_Bound_Length
+                    (Expr_Stable, Expr_Type, I),
+                  Chap6.Get_Array_Bound_Length
+                    (T2M (Atype, Get_Object_Kind (Expr_Stable)), Atype, I),
+                  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 Chap3.Get_Array_Base (Expr_Stable);
+      end Convert_Array_To_Thin_Array;
+
+      function Translate_Implicit_Array_Conversion
+        (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
+        return Mnode
+      is
+         Ainfo : Type_Info_Acc;
+         Einfo : Type_Info_Acc;
+      begin
+         pragma Assert
+           (Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition);
+
+         if Res_Type = Expr_Type then
+            return Expr;
+         end if;
+
+         Ainfo := Get_Info (Res_Type);
+         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, Res_Type);
+                  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.
+                  if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) 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;
+                  return Expr;
+               else
+                  --  Unbounded/bounded array to bounded array.
+                  return Convert_Array_To_Thin_Array
+                    (Expr, Expr_Type, Res_Type, Loc);
+               end if;
+            when others =>
+               raise Internal_Error;
+         end case;
+      end Translate_Implicit_Array_Conversion;
+
+      --  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
+      begin
+         --  Same type: nothing to do.
+         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
+            return M2E (Translate_Implicit_Array_Conversion
+                          (E2M (Expr, Get_Info (Expr_Type), Is_Sig),
+                           Expr_Type, Atype, Loc));
+         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 : constant Subprg_Info_Acc := Get_Info (Func);
+         Constr : O_Assoc_List;
+      begin
+         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
+         Ret_Type : constant Iir := Get_Return_Type (Imp);
+         Kind : constant Iir_Predefined_Functions :=
+           Get_Implicit_Definition (Imp);
+         Arr_El1 : O_Enode;
+         Arr_El2 : O_Enode;
+         Res : O_Enode;
+      begin
+         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_Scalar_Min_Max
+        (Op : ON_Op_Kind;
+         Left, Right : Iir;
+         Res_Type : Iir)
+        return O_Enode
+      is
+         Res_Otype : constant O_Tnode :=
+           Get_Ortho_Type (Res_Type, Mode_Value);
+         Res, L, R : O_Dnode;
+         If_Blk : O_If_Block;
+      begin
+         --  Create a variable for the result.
+         Res := Create_Temp (Res_Otype);
+
+         Open_Temp;
+         L := Create_Temp_Init
+           (Res_Otype, Translate_Expression (Left, Res_Type));
+         R := Create_Temp_Init
+           (Res_Otype, Translate_Expression (Right, Res_Type));
+
+         Start_If_Stmt (If_Blk, New_Compare_Op (Op,
+                                                New_Obj_Value (L),
+                                                New_Obj_Value (R),
+                                                Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Res), New_Obj_Value (L));
+         New_Else_Stmt (If_Blk);
+         New_Assign_Stmt (New_Obj (Res), New_Obj_Value (R));
+         Finish_If_Stmt (If_Blk);
+         Close_Temp;
+
+         return New_Obj_Value (Res);
+      end Translate_Scalar_Min_Max;
+
+      function Translate_Predefined_Vector_Min_Max (Is_Min : Boolean;
+                                                    Left : Iir;
+                                                    Res_Type : Iir)
+                                                   return O_Enode
+      is
+         Res_Otype : constant O_Tnode :=
+           Get_Ortho_Type (Res_Type, Mode_Value);
+         Left_Type : constant Iir := Get_Type (Left);
+         Res, El, Len : O_Dnode;
+         Arr : Mnode;
+         If_Blk : O_If_Block;
+         Label : O_Snode;
+         Op : ON_Op_Kind;
+      begin
+         --  Create a variable for the result.
+         Res := Create_Temp (Res_Otype);
+
+         Open_Temp;
+         if Is_Min then
+            Op := ON_Lt;
+         else
+            Op := ON_Gt;
+         end if;
+         New_Assign_Stmt
+           (New_Obj (Res),
+            Chap14.Translate_High_Low_Type_Attribute (Res_Type, Is_Min));
+
+         El := Create_Temp (Res_Otype);
+         Arr := Stabilize (E2M (Translate_Expression (Left),
+                                Get_Info (Left_Type), Mode_Value));
+         Len := Create_Temp_Init
+           (Ghdl_Index_Type,
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (Arr, Left_Type, 1))));
+
+         --  Create:
+         --    loop
+         --      exit when LEN = 0;
+         --      LEN := LEN - 1;
+         --      if ARR[LEN] </> RES then
+         --         RES := ARR[LEN];
+         --      end if;
+         --    end loop;
+         Start_Loop_Stmt (Label);
+         Gen_Exit_When (Label, New_Compare_Op (ON_Eq, New_Obj_Value (Len),
+                                               New_Lit (Ghdl_Index_0),
+                                               Ghdl_Bool_Type));
+         Dec_Var (Len);
+         New_Assign_Stmt
+           (New_Obj (El),
+            M2E (Chap3.Index_Base (Chap3.Get_Array_Base (Arr),
+                                   Left_Type, New_Obj_Value (Len))));
+         Start_If_Stmt (If_Blk, New_Compare_Op (Op,
+                                                New_Obj_Value (El),
+                                                New_Obj_Value (Res),
+                                                Ghdl_Bool_Type));
+         New_Assign_Stmt (New_Obj (Res), New_Obj_Value (El));
+         Finish_If_Stmt (If_Blk);
+         Finish_Loop_Stmt (Label);
+
+         Close_Temp;
+
+         return New_Obj_Value (Res);
+      end Translate_Predefined_Vector_Min_Max;
+
+      function Translate_Std_Ulogic_Match (Func : O_Dnode;
+                                           L, R : O_Enode;
+                                           Res_Type : O_Tnode)
+                                          return O_Enode
+      is
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Func);
+         New_Association (Constr, New_Convert_Ov (L, Ghdl_I32_Type));
+         New_Association (Constr, New_Convert_Ov (R, Ghdl_I32_Type));
+         return New_Convert_Ov (New_Function_Call (Constr), Res_Type);
+      end Translate_Std_Ulogic_Match;
+
+      function Translate_To_String (Subprg : O_Dnode;
+                                    Res_Type : Iir;
+                                    Loc : Iir;
+                                    Val : O_Enode;
+                                    Arg2 : O_Enode := O_Enode_Null;
+                                    Arg3 : O_Enode := O_Enode_Null)
+                                   return O_Enode
+      is
+         Val_Type : constant Iir := Get_Base_Type (Res_Type);
+         Res : O_Dnode;
+         Assoc : O_Assoc_List;
+      begin
+         Res := Create_Temp (Std_String_Node);
+         Create_Temp_Stack2_Mark;
+         Start_Association (Assoc, Subprg);
+         New_Association (Assoc,
+                          New_Address (New_Obj (Res), Std_String_Ptr_Node));
+         New_Association (Assoc, Val);
+         if Arg2 /= O_Enode_Null then
+            New_Association (Assoc, Arg2);
+            if Arg3 /= O_Enode_Null then
+               New_Association (Assoc, Arg3);
+            end if;
+         end if;
+         New_Procedure_Call (Assoc);
+         return M2E (Translate_Implicit_Array_Conversion
+                       (Dv2M (Res, Get_Info (Val_Type), Mode_Value),
+                        Val_Type, Res_Type, Loc));
+      end Translate_To_String;
+
+      function Translate_Bv_To_String (Subprg : O_Dnode;
+                                       Val : O_Enode;
+                                       Val_Type : Iir;
+                                       Res_Type : Iir;
+                                       Loc : Iir)
+                                      return O_Enode
+      is
+         Arr : Mnode;
+      begin
+         Arr := Stabilize (E2M (Val, Get_Info (Val_Type), Mode_Value));
+         return Translate_To_String
+           (Subprg, Res_Type, Loc,
+            M2E (Chap3.Get_Array_Base (Arr)),
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (Arr, Val_Type, 1))));
+      end Translate_Bv_To_String;
+
+      subtype Predefined_Boolean_Logical is Iir_Predefined_Functions range
+        Iir_Predefined_Boolean_And .. Iir_Predefined_Boolean_Xnor;
+
+      function Translate_Predefined_Logical
+        (Op : Predefined_Boolean_Logical; Left, Right : O_Enode)
+        return O_Enode is
+      begin
+         case Op is
+            when Iir_Predefined_Boolean_And =>
+               return New_Dyadic_Op (ON_And, Left, Right);
+            when Iir_Predefined_Boolean_Or =>
+               return New_Dyadic_Op (ON_Or, Left, Right);
+            when Iir_Predefined_Boolean_Nand =>
+               return New_Monadic_Op
+                 (ON_Not, New_Dyadic_Op (ON_And, Left, Right));
+            when Iir_Predefined_Boolean_Nor =>
+               return New_Monadic_Op
+                 (ON_Not, New_Dyadic_Op (ON_Or, Left, Right));
+            when Iir_Predefined_Boolean_Xor =>
+               return New_Dyadic_Op (ON_Xor, Left, Right);
+            when Iir_Predefined_Boolean_Xnor =>
+               return New_Monadic_Op
+                 (ON_Not, New_Dyadic_Op (ON_Xor, Left, Right));
+         end case;
+      end Translate_Predefined_Logical;
+
+      function Translate_Predefined_TF_Array_Element
+        (Op : Predefined_Boolean_Logical;
+         Left, Right : Iir;
+         Res_Type : Iir;
+         Loc : Iir)
+        return O_Enode
+      is
+         Arr_Type : constant Iir := Get_Type (Left);
+         Res_Btype : constant Iir := Get_Base_Type (Res_Type);
+         Res_Info : constant Type_Info_Acc := Get_Info (Res_Btype);
+         Base_Ptr_Type : constant O_Tnode :=
+           Res_Info.T.Base_Ptr_Type (Mode_Value);
+         Arr : Mnode;
+         El : O_Dnode;
+         Base : O_Dnode;
+         Len : O_Dnode;
+         Label : O_Snode;
+         Res : Mnode;
+      begin
+         --  Translate the array.
+         Arr := Stabilize (E2M (Translate_Expression (Left),
+                                Get_Info (Arr_Type), Mode_Value));
+
+         --  Extract its length.
+         Len := Create_Temp_Init
+           (Ghdl_Index_Type,
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (Arr, Arr_Type, 1))));
+
+         --  Allocate the result array.
+         Base := Create_Temp_Init
+           (Base_Ptr_Type,
+            Gen_Alloc (Alloc_Stack, New_Obj_Value (Len), Base_Ptr_Type));
+
+         Open_Temp;
+         --  Translate the element.
+         El := Create_Temp_Init (Get_Ortho_Type (Get_Type (Right), Mode_Value),
+                                 Translate_Expression (Right));
+         --  Create:
+         --    loop
+         --      exit when LEN = 0;
+         --      LEN := LEN - 1;
+         --      BASE[LEN] := EL op ARR[LEN];
+         --    end loop;
+         Start_Loop_Stmt (Label);
+         Gen_Exit_When (Label, New_Compare_Op (ON_Eq, New_Obj_Value (Len),
+                                               New_Lit (Ghdl_Index_0),
+                                               Ghdl_Bool_Type));
+         Dec_Var (Len);
+         New_Assign_Stmt
+           (New_Indexed_Acc_Value (New_Obj (Base),
+                                   New_Obj_Value (Len)),
+            Translate_Predefined_Logical
+              (Op,
+               New_Obj_Value (El),
+               M2E (Chap3.Index_Base (Chap3.Get_Array_Base (Arr),
+                                      Arr_Type, New_Obj_Value (Len)))));
+         Finish_Loop_Stmt (Label);
+         Close_Temp;
+
+         Res := Create_Temp (Res_Info, Mode_Value);
+         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (Res)),
+                          New_Obj_Value (Base));
+         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (Res)),
+                          M2Addr (Chap3.Get_Array_Bounds (Arr)));
+
+         return Translate_Implicit_Conv (M2E (Res), Res_Btype, Res_Type,
+                                         Mode_Value, Loc);
+      end Translate_Predefined_TF_Array_Element;
+
+      function Translate_Predefined_TF_Reduction
+        (Op : ON_Op_Kind; Operand : Iir; Res_Type : Iir)
+        return O_Enode
+      is
+         Arr_Type : constant Iir := Get_Type (Operand);
+         Enums : constant Iir_List :=
+           Get_Enumeration_Literal_List (Get_Base_Type (Res_Type));
+         Init_Enum : Iir;
+
+         Res : O_Dnode;
+         Arr_Expr : O_Enode;
+         Arr : Mnode;
+         Len : O_Dnode;
+         Label : O_Snode;
+      begin
+         if Op = ON_And then
+            Init_Enum := Get_Nth_Element (Enums, 1);
+         else
+            Init_Enum := Get_Nth_Element (Enums, 0);
+         end if;
+
+         Res := Create_Temp_Init (Get_Ortho_Type (Res_Type, Mode_Value),
+                                  New_Lit (Get_Ortho_Expr (Init_Enum)));
+
+         Open_Temp;
+         --  Translate the array.  Note that Translate_Expression may create
+         --  the info for the array type, so be sure to call it before calling
+         --  Get_Info.
+         Arr_Expr := Translate_Expression (Operand);
+         Arr := Stabilize (E2M (Arr_Expr, Get_Info (Arr_Type), Mode_Value));
+
+         --  Extract its length.
+         Len := Create_Temp_Init
+           (Ghdl_Index_Type,
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (Arr, Arr_Type, 1))));
+
+         --  Create:
+         --    loop
+         --      exit when LEN = 0;
+         --      LEN := LEN - 1;
+         --      RES := RES op ARR[LEN];
+         --    end loop;
+         Start_Loop_Stmt (Label);
+         Gen_Exit_When (Label, New_Compare_Op (ON_Eq, New_Obj_Value (Len),
+                                               New_Lit (Ghdl_Index_0),
+                                               Ghdl_Bool_Type));
+         Dec_Var (Len);
+         New_Assign_Stmt
+           (New_Obj (Res),
+            New_Dyadic_Op
+              (Op,
+               New_Obj_Value (Res),
+               M2E (Chap3.Index_Base (Chap3.Get_Array_Base (Arr),
+                                      Arr_Type, New_Obj_Value (Len)))));
+         Finish_Loop_Stmt (Label);
+         Close_Temp;
+
+         return New_Obj_Value (Res);
+      end Translate_Predefined_TF_Reduction;
+
+      function Translate_Predefined_Array_Min_Max
+        (Is_Min : Boolean;
+         Left, Right : O_Enode;
+         Left_Type, Right_Type : Iir;
+         Res_Type : Iir;
+         Imp : Iir;
+         Loc : Iir)
+        return O_Enode
+      is
+         Arr_Type : constant Iir := Get_Base_Type (Left_Type);
+         Arr_Info : constant Type_Info_Acc := Get_Info (Arr_Type);
+         L, R : Mnode;
+         If_Blk : O_If_Block;
+         Res : Mnode;
+      begin
+         Res := Create_Temp (Arr_Info, Mode_Value);
+         L := Stabilize (E2M (Left, Get_Info (Left_Type), Mode_Value));
+         R := Stabilize (E2M (Right, Get_Info (Right_Type), Mode_Value));
+         Start_If_Stmt
+           (If_Blk,
+            New_Compare_Op
+              (ON_Eq,
+               Translate_Predefined_Lib_Operator (M2E (L), M2E (R), Imp),
+               New_Lit (Ghdl_Compare_Lt),
+               Std_Boolean_Type_Node));
+         if Is_Min then
+            Copy_Fat_Pointer (Res, Translate_Implicit_Array_Conversion
+                                (L, Left_Type, Arr_Type, Loc));
+         else
+            Copy_Fat_Pointer (Res, Translate_Implicit_Array_Conversion
+                                (R, Right_Type, Arr_Type, Loc));
+         end if;
+         New_Else_Stmt (If_Blk);
+         if Is_Min then
+            Copy_Fat_Pointer (Res, Translate_Implicit_Array_Conversion
+                                (R, Right_Type, Arr_Type, Loc));
+         else
+            Copy_Fat_Pointer (Res, Translate_Implicit_Array_Conversion
+                                (L, Left_Type, Arr_Type, Loc));
+         end if;
+         Finish_If_Stmt (If_Blk);
+
+         return M2E (Translate_Implicit_Array_Conversion
+                       (Res, Arr_Type, Res_Type, Loc));
+      end Translate_Predefined_Array_Min_Max;
+
+      function Translate_Predefined_TF_Edge
+        (Is_Rising : Boolean; Left : Iir)
+        return O_Enode
+      is
+         Enums : constant Iir_List :=
+           Get_Enumeration_Literal_List (Get_Base_Type (Get_Type (Left)));
+         Name : Mnode;
+      begin
+         Name := Stabilize (Chap6.Translate_Name (Left), True);
+         return New_Dyadic_Op
+           (ON_And,
+            New_Value (Chap14.Get_Signal_Field
+                         (Name, Ghdl_Signal_Event_Field)),
+            New_Compare_Op
+              (ON_Eq,
+               New_Value (New_Access_Element (M2E (Name))),
+               New_Lit (Get_Ortho_Expr
+                          (Get_Nth_Element (Enums, Boolean'Pos (Is_Rising)))),
+               Std_Boolean_Type_Node));
+      end Translate_Predefined_TF_Edge;
+
+      function Translate_Predefined_Std_Ulogic_Array_Match
+        (Subprg : O_Dnode; Left, Right : Iir; Res_Type : Iir)
+        return O_Enode
+      is
+         Res_Otype : constant O_Tnode :=
+           Get_Ortho_Type (Res_Type, Mode_Value);
+         L_Type : constant Iir := Get_Type (Left);
+         R_Type : constant Iir := Get_Type (Right);
+         L_Expr, R_Expr : O_Enode;
+         L, R : Mnode;
+         Assoc : O_Assoc_List;
+
+         Res : O_Dnode;
+      begin
+         Res := Create_Temp (Ghdl_I32_Type);
+
+         Open_Temp;
+         --  Translate the arrays.  Note that Translate_Expression may create
+         --  the info for the array type, so be sure to call it before calling
+         --  Get_Info.
+         L_Expr := Translate_Expression (Left);
+         L := Stabilize (E2M (L_Expr, Get_Info (L_Type), Mode_Value));
+
+         R_Expr := Translate_Expression (Right);
+         R := Stabilize (E2M (R_Expr, Get_Info (R_Type), Mode_Value));
+
+         Start_Association (Assoc, Subprg);
+         New_Association
+           (Assoc,
+            New_Convert_Ov (M2E (Chap3.Get_Array_Base (L)), Ghdl_Ptr_Type));
+         New_Association
+           (Assoc,
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (L, L_Type, 1))));
+
+         New_Association
+           (Assoc,
+            New_Convert_Ov (M2E (Chap3.Get_Array_Base (R)), Ghdl_Ptr_Type));
+         New_Association
+           (Assoc,
+            M2E (Chap3.Range_To_Length
+                   (Chap3.Get_Array_Range (R, R_Type, 1))));
+
+         New_Assign_Stmt (New_Obj (Res), New_Function_Call (Assoc));
+
+         Close_Temp;
+
+         return New_Convert_Ov (New_Obj_Value (Res), Res_Otype);
+      end Translate_Predefined_Std_Ulogic_Array_Match;
+
+      function Translate_Predefined_Operator
+        (Imp : Iir_Implicit_Function_Declaration;
+         Left, Right : Iir;
+         Res_Type : Iir;
+         Loc : Iir)
+        return O_Enode
+      is
+         Kind : constant Iir_Predefined_Functions :=
+           Get_Implicit_Definition (Imp);
+         Left_Tree : O_Enode;
+         Right_Tree : O_Enode;
+         Left_Type : Iir;
+         Right_Type : Iir;
+         Res_Otype : O_Tnode;
+         Op : ON_Op_Kind;
+         Inter : Iir;
+         Res : O_Enode;
+      begin
+         case Kind is
+            when Iir_Predefined_Bit_And
+              | Iir_Predefined_Bit_Or
+              | Iir_Predefined_Bit_Nand
+              | Iir_Predefined_Bit_Nor
+              | Iir_Predefined_Boolean_And
+              | Iir_Predefined_Boolean_Or
+              | Iir_Predefined_Boolean_Nand
+              | Iir_Predefined_Boolean_Nor =>
+               --  Right operand of shortcur operators may not be evaluated.
+               return Translate_Shortcut_Operator (Imp, Left, Right);
+
+            --  Operands of min/max are evaluated in a declare block.
+            when Iir_Predefined_Enum_Minimum
+              | Iir_Predefined_Integer_Minimum
+              | Iir_Predefined_Floating_Minimum
+              | Iir_Predefined_Physical_Minimum =>
+               return Translate_Scalar_Min_Max (ON_Le, Left, Right, Res_Type);
+            when Iir_Predefined_Enum_Maximum
+              | Iir_Predefined_Integer_Maximum
+              | Iir_Predefined_Floating_Maximum
+              | Iir_Predefined_Physical_Maximum =>
+               return Translate_Scalar_Min_Max (ON_Ge, Left, Right, Res_Type);
+
+            --  Avoid implicit conversion of the array parameters to the
+            --  unbounded type for optimizing purpose.  FIXME: should do the
+            --  same for the result.
+            when Iir_Predefined_TF_Array_Element_And =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_And, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_And =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_And, Right, Left, Res_Type, Loc);
+            when Iir_Predefined_TF_Array_Element_Or =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Or, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_Or =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Or, Right, Left, Res_Type, Loc);
+            when Iir_Predefined_TF_Array_Element_Nand =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Nand, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_Nand =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Nand, Right, Left, Res_Type, Loc);
+            when Iir_Predefined_TF_Array_Element_Nor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Nor, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_Nor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Nor, Right, Left, Res_Type, Loc);
+            when Iir_Predefined_TF_Array_Element_Xor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Xor, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_Xor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Xor, Right, Left, Res_Type, Loc);
+            when Iir_Predefined_TF_Array_Element_Xnor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Xnor, Left, Right, Res_Type, Loc);
+            when Iir_Predefined_TF_Element_Array_Xnor =>
+               return Translate_Predefined_TF_Array_Element
+                 (Iir_Predefined_Boolean_Xnor, Right, Left, Res_Type, Loc);
+
+            --  Avoid implicit conversion of the array parameters to the
+            --  unbounded type for optimizing purpose.
+            when Iir_Predefined_TF_Reduction_And =>
+               return Translate_Predefined_TF_Reduction
+                 (ON_And, Left, Res_Type);
+            when Iir_Predefined_TF_Reduction_Or =>
+               return Translate_Predefined_TF_Reduction
+                 (ON_Or, Left, Res_Type);
+            when Iir_Predefined_TF_Reduction_Nand =>
+               return New_Monadic_Op
+                 (ON_Not,
+                  Translate_Predefined_TF_Reduction (ON_And, Left, Res_Type));
+            when Iir_Predefined_TF_Reduction_Nor =>
+               return New_Monadic_Op
+                 (ON_Not,
+                  Translate_Predefined_TF_Reduction (ON_Or, Left, Res_Type));
+            when Iir_Predefined_TF_Reduction_Xor =>
+               return Translate_Predefined_TF_Reduction
+                 (ON_Xor, Left, Res_Type);
+            when Iir_Predefined_TF_Reduction_Xnor =>
+               return New_Monadic_Op
+                 (ON_Not,
+                  Translate_Predefined_TF_Reduction (ON_Xor, Left, Res_Type));
+
+            when Iir_Predefined_Vector_Minimum =>
+               return Translate_Predefined_Vector_Min_Max
+                 (True, Left, Res_Type);
+            when Iir_Predefined_Vector_Maximum =>
+               return Translate_Predefined_Vector_Min_Max
+                 (False, Left, Res_Type);
+
+            when Iir_Predefined_Bit_Rising_Edge
+              | Iir_Predefined_Boolean_Rising_Edge =>
+               return Translate_Predefined_TF_Edge (True, Left);
+            when Iir_Predefined_Bit_Falling_Edge
+              | Iir_Predefined_Boolean_Falling_Edge =>
+               return Translate_Predefined_TF_Edge (False, Left);
+
+            when Iir_Predefined_Std_Ulogic_Array_Match_Equality =>
+               return Translate_Predefined_Std_Ulogic_Array_Match
+                 (Ghdl_Std_Ulogic_Array_Match_Eq, Left, Right, Res_Type);
+            when Iir_Predefined_Std_Ulogic_Array_Match_Inequality =>
+               return Translate_Predefined_Std_Ulogic_Array_Match
+                 (Ghdl_Std_Ulogic_Array_Match_Ne, Left, Right, Res_Type);
+
+            when others =>
+               null;
+         end case;
+
+         --  Evaluate parameters.
+         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 Translate_Predefined_Logical
+                 (Iir_Predefined_Boolean_Xnor, Left_Tree, Right_Tree);
+            when Iir_Predefined_Bit_Match_Equality =>
+               return New_Compare_Op (ON_Eq, Left_Tree, Right_Tree,
+                                      Get_Ortho_Type (Res_Type, Mode_Value));
+            when Iir_Predefined_Bit_Match_Inequality =>
+               return New_Compare_Op (ON_Neq, Left_Tree, Right_Tree,
+                                      Get_Ortho_Type (Res_Type, Mode_Value));
+
+            when Iir_Predefined_Bit_Condition =>
+               return New_Compare_Op
+                 (ON_Eq, Left_Tree, New_Lit (Get_Ortho_Expr (Bit_1)),
+                  Std_Boolean_Type_Node);
+
+            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_Otype),
+                  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_Otype),
+                  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 Iir_Predefined_Std_Ulogic_Match_Equality =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Eq,
+                  Left_Tree, Right_Tree, Res_Otype);
+            when Iir_Predefined_Std_Ulogic_Match_Inequality =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Ne,
+                  Left_Tree, Right_Tree, Res_Otype);
+            when Iir_Predefined_Std_Ulogic_Match_Less =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Lt,
+                  Left_Tree, Right_Tree, Res_Otype);
+            when Iir_Predefined_Std_Ulogic_Match_Less_Equal =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Le,
+                  Left_Tree, Right_Tree, Res_Otype);
+            when Iir_Predefined_Std_Ulogic_Match_Greater =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Lt,
+                  Right_Tree, Left_Tree, Res_Otype);
+            when Iir_Predefined_Std_Ulogic_Match_Greater_Equal =>
+               return Translate_Std_Ulogic_Match
+                 (Ghdl_Std_Ulogic_Match_Le,
+                  Right_Tree, Left_Tree, Res_Otype);
+
+            when Iir_Predefined_Bit_Array_Match_Equality =>
+               return New_Compare_Op
+                 (ON_Eq,
+                  Translate_Predefined_Lib_Operator
+                    (Left_Tree, Right_Tree, Imp),
+                  New_Lit (Std_Boolean_True_Node),
+                  Res_Otype);
+            when Iir_Predefined_Bit_Array_Match_Inequality =>
+               return New_Compare_Op
+                 (ON_Eq,
+                  Translate_Predefined_Lib_Operator
+                    (Left_Tree, Right_Tree, Imp),
+                  New_Lit (Std_Boolean_False_Node),
+                  Res_Otype);
+
+            when Iir_Predefined_Array_Minimum =>
+               return Translate_Predefined_Array_Min_Max
+                 (True, Left_Tree, Right_Tree, Left_Type, Right_Type,
+                  Res_Type, Imp, Loc);
+            when Iir_Predefined_Array_Maximum =>
+               return Translate_Predefined_Array_Min_Max
+                 (False, Left_Tree, Right_Tree, Left_Type, Right_Type,
+                  Res_Type, Imp, Loc);
+
+            when Iir_Predefined_Integer_To_String =>
+               case Get_Info (Left_Type).Type_Mode is
+                  when Type_Mode_I32 =>
+                     return Translate_To_String
+                       (Ghdl_To_String_I32, Res_Type, Loc,
+                        New_Convert_Ov (Left_Tree, Ghdl_I32_Type));
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            when Iir_Predefined_Enum_To_String =>
+               --  LRM08 5.7 String representations
+               --  - For a given value of type CHARACTER, [...]
+               --
+               --  So special case for character.
+               if Get_Base_Type (Left_Type) = Character_Type_Definition then
+                  return Translate_To_String
+                    (Ghdl_To_String_Char, Res_Type, Loc, Left_Tree);
+               end if;
+
+               --  LRM08 5.7 String representations
+               --  - For a given value of type other than CHARACTER, [...]
+               declare
+                  Conv : O_Tnode;
+                  Subprg : O_Dnode;
+               begin
+                  case Get_Info (Left_Type).Type_Mode is
+                     when Type_Mode_B1 =>
+                        Subprg := Ghdl_To_String_B1;
+                        Conv := Ghdl_Bool_Type;
+                     when Type_Mode_E8 =>
+                        Subprg := Ghdl_To_String_E8;
+                        Conv := Ghdl_I32_Type;
+                     when Type_Mode_E32 =>
+                        Subprg := Ghdl_To_String_E32;
+                        Conv := Ghdl_I32_Type;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+                  return Translate_To_String
+                       (Subprg, Res_Type, Loc,
+                        New_Convert_Ov (Left_Tree, Conv),
+                        New_Lit (Rtis.New_Rti_Address
+                                   (Get_Info (Left_Type).Type_Rti)));
+               end;
+            when Iir_Predefined_Floating_To_String =>
+               return Translate_To_String
+                 (Ghdl_To_String_F64, Res_Type, Loc,
+                  New_Convert_Ov (Left_Tree, Ghdl_Real_Type));
+            when Iir_Predefined_Real_To_String_Digits =>
+               return Translate_To_String
+                 (Ghdl_To_String_F64_Digits, Res_Type, Loc,
+                  New_Convert_Ov (Left_Tree, Ghdl_Real_Type),
+                  New_Convert_Ov (Right_Tree, Ghdl_I32_Type));
+            when Iir_Predefined_Real_To_String_Format =>
+               return Translate_To_String
+                 (Ghdl_To_String_F64_Format, Res_Type, Loc,
+                  New_Convert_Ov (Left_Tree, Ghdl_Real_Type),
+                  Right_Tree);
+            when Iir_Predefined_Physical_To_String =>
+               declare
+                  Conv : O_Tnode;
+                  Subprg : O_Dnode;
+               begin
+                  case Get_Info (Left_Type).Type_Mode is
+                     when Type_Mode_P32 =>
+                        Subprg := Ghdl_To_String_P32;
+                        Conv := Ghdl_I32_Type;
+                     when Type_Mode_P64 =>
+                        Subprg := Ghdl_To_String_P64;
+                        Conv := Ghdl_I64_Type;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+                  return Translate_To_String
+                    (Subprg, Res_Type, Loc,
+                     New_Convert_Ov (Left_Tree, Conv),
+                     New_Lit (Rtis.New_Rti_Address
+                                (Get_Info (Left_Type).Type_Rti)));
+               end;
+            when Iir_Predefined_Time_To_String_Unit =>
+               return Translate_To_String
+                 (Ghdl_Time_To_String_Unit, Res_Type, Loc,
+                  Left_Tree, Right_Tree,
+                  New_Lit (Rtis.New_Rti_Address
+                             (Get_Info (Left_Type).Type_Rti)));
+            when Iir_Predefined_Bit_Vector_To_Ostring =>
+               return Translate_Bv_To_String
+                 (Ghdl_BV_To_Ostring, Left_Tree, Left_Type, Res_Type, Loc);
+            when Iir_Predefined_Bit_Vector_To_Hstring =>
+               return Translate_Bv_To_String
+                 (Ghdl_BV_To_Hstring, Left_Tree, Left_Type, Res_Type, Loc);
+            when Iir_Predefined_Array_Char_To_String =>
+               declare
+                  El_Type : constant Iir := Get_Element_Subtype (Left_Type);
+                  Subprg : O_Dnode;
+                  Arg : Mnode;
+               begin
+                  Arg := Stabilize
+                    (E2M (Left_Tree, Get_Info (Left_Type), Mode_Value));
+                  case Get_Info (El_Type).Type_Mode is
+                     when Type_Mode_B1 =>
+                        Subprg := Ghdl_Array_Char_To_String_B1;
+                     when Type_Mode_E8 =>
+                        Subprg := Ghdl_Array_Char_To_String_E8;
+                     when Type_Mode_E32 =>
+                        Subprg := Ghdl_Array_Char_To_String_E32;
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+                  return Translate_To_String
+                    (Subprg, Res_Type, Loc,
+                     New_Convert_Ov (M2E (Chap3.Get_Array_Base (Arg)),
+                                     Ghdl_Ptr_Type),
+                     Chap3.Get_Array_Length (Arg, Left_Type),
+                     New_Lit (Rtis.New_Rti_Address
+                                (Get_Info (El_Type).Type_Rti)));
+               end;
+
+            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 =>
+               Chap3.Translate_Object_Copy (Target, Val, Target_Type);
+            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_Expr (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_Type;
+                  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;
+               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_Expr (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_Expr (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_Choice_Range (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_Expr (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_Expr (El) /= Null_Iir then
+                  El_Assoc := Get_Associated_Expr (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_Expr (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_Choice_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 : constant Iir := Get_Type (Aggr);
+         Index_List : constant Iir_List := Get_Index_Subtype_List (Aggr_Type);
+         Targ_Index_List : constant Iir_List :=
+           Get_Index_Subtype_List (Target_Type);
+
+         Aggr_Info : Iir_Aggregate_Info;
+         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;
+         Subtarg_Type : Iir;
+         Subaggr_Type : Iir;
+         L, H : Iir;
+         Min : Iir_Int32;
+         Has_Others : Boolean;
+
+         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));
+         Aggr_Info := Get_Aggregate_Info (Aggr);
+
+         --  Check type
+         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 : constant Iir := Get_Type (Aggr);
+         El : Iir;
+      begin
+         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,
+                  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, Mnode_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 : Mnode;
+         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 := 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 := Mnode_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);
+         E : Mnode;
+      begin
+         E := Stabilize (E2M (Expr, Expr_Info, Mode_Value));
+         case Res_Info.Type_Mode is
+            when Type_Mode_Array =>
+               Chap3.Check_Array_Match
+                 (Res_Type, T2M (Res_Type, Mode_Value),
+                  Expr_Type, E,
+                  Loc);
+               return New_Convert_Ov
+                 (M2Addr (Chap3.Get_Array_Base (E)),
+                  Res_Info.Ortho_Ptr_Type (Mode_Value));
+            when Type_Mode_Fat_Array =>
+               declare
+                  Res : Mnode;
+               begin
+                  Res := Create_Temp (Res_Info);
+                  Copy_Fat_Pointer (Res, E);
+                  Chap3.Check_Array_Match (Res_Type, Res, Expr_Type, E, Loc);
+                  return M2Addr (Res);
+               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_Info : constant Type_Info_Acc := Get_Info (Res_Type);
+         Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type);
+         Res_Indexes : constant Iir_List :=
+           Get_Index_Subtype_List (Res_Type);
+         Expr_Indexes : constant Iir_List :=
+           Get_Index_Subtype_List (Expr_Type);
+
+         Res_Base_Type : constant Iir := Get_Base_Type (Res_Type);
+         Expr_Base_Type : constant Iir := Get_Base_Type (Expr_Type);
+         Res_Base_Indexes : constant Iir_List :=
+           Get_Index_Subtype_List (Res_Base_Type);
+         Expr_Base_Indexes : constant Iir_List :=
+           Get_Index_Subtype_List (Expr_Base_Type);
+         Res : Mnode;
+         E : Mnode;
+         Bounds : O_Dnode;
+         R_El : Iir;
+         E_El : Iir;
+      begin
+         Res := Create_Temp (Res_Info, Mode_Value);
+         Bounds := Create_Temp (Res_Info.T.Bounds_Type);
+         E := Stabilize (E2M (Expr, Expr_Info, Mode_Value));
+         Open_Temp;
+         --  Set base.
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Array_Base (Res)),
+            New_Convert_Ov (M2Addr (Chap3.Get_Array_Base (E)),
+                            Res_Info.T.Base_Ptr_Type (Mode_Value)));
+         --  Set bounds.
+         New_Assign_Stmt
+           (M2Lp (Chap3.Get_Array_Bounds (Res)),
+            New_Address (New_Obj (Bounds), Res_Info.T.Bounds_Ptr_Type));
+
+         --  Convert bounds.
+         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 : Mnode;
+               Eb_Ptr : Mnode;
+               Ee : O_Enode;
+               Same_Index_Type : constant Boolean :=
+                 (Get_Index_Type (Res_Base_Indexes, I)
+                    = Get_Index_Type (Expr_Base_Indexes, I));
+            begin
+               Open_Temp;
+               Rb_Ptr := Stabilize
+                 (Chap3.Get_Array_Range (Res, Res_Type, I + 1));
+               Eb_Ptr := Stabilize
+                 (Chap3.Get_Array_Range (E, Expr_Type, I + 1));
+               --  Convert left and right (unless they have the same type -
+               --  this is an optimization but also this deals with null
+               --  array in common cases).
+               Ee := M2E (Chap3.Range_To_Left (Eb_Ptr));
+               if not Same_Index_Type then
+                  Ee := Translate_Type_Conversion (Ee, E_El, R_El, Loc);
+               end if;
+               New_Assign_Stmt (M2Lv (Chap3.Range_To_Left (Rb_Ptr)), Ee);
+               Ee := M2E (Chap3.Range_To_Right (Eb_Ptr));
+               if not Same_Index_Type then
+                  Ee := Translate_Type_Conversion (Ee, E_El, R_El, Loc);
+               end if;
+               New_Assign_Stmt (M2Lv (Chap3.Range_To_Right (Rb_Ptr)), Ee);
+               --  Copy Dir and Length.
+               New_Assign_Stmt (M2Lv (Chap3.Range_To_Dir (Rb_Ptr)),
+                                M2E (Chap3.Range_To_Dir (Eb_Ptr)));
+               New_Assign_Stmt (M2Lv (Chap3.Range_To_Length (Rb_Ptr)),
+                                M2E (Chap3.Range_To_Length (Eb_Ptr)));
+               Close_Temp;
+            end;
+         end loop;
+         Close_Temp;
+         return M2E (Res);
+      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
+                  --  Extract the type of the aggregate.  Use the type of the
+                  --  context if it is fully constrained.
+                  pragma Assert (Rtype /= Null_Iir);
+                  if Is_Fully_Constrained_Type (Rtype) then
+                     Aggr_Type := Rtype;
+                  else
+                     Aggr_Type := Expr_Type;
+                  end if;
+                  if Get_Kind (Aggr_Type) = Iir_Kind_Array_Subtype_Definition
+                  then
+                     Chap3.Create_Array_Subtype (Aggr_Type, True);
+                  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_Interface_Constant_Declaration
+              | Iir_Kind_Interface_Variable_Declaration
+              | Iir_Kind_Interface_Signal_Declaration
+              | Iir_Kind_Interface_File_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_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
+                 (Get_Type (Expr), True);
+            when Iir_Kind_Low_Type_Attribute =>
+               return Chap14.Translate_High_Low_Type_Attribute
+                 (Get_Type (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;
+
+         Arr_Type : constant Iir_Array_Type_Definition :=
+           Get_Type (Get_Interface_Declaration_Chain (Subprg));
+         Info : constant Type_Info_Acc := Get_Info (Arr_Type);
+         Id : constant Name_Id :=
+           Get_Identifier (Get_Type_Declarator (Arr_Type));
+         Arr_Ptr_Type : constant O_Tnode := Info.Ortho_Ptr_Type (Mode_Value);
+
+         F_Info : Subprg_Info_Acc;
+         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
+         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, Wki_L_Len,
+                       O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_R_Len, Wki_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_Bound_Length
+                            (Dp2M (L, Info, Mode_Value), Arr_Type, 1));
+         New_Assign_Stmt (New_Obj (Var_R_Len),
+                          Chap6.Get_Array_Bound_Length
+                            (Dp2M (R, Info, Mode_Value), Arr_Type, 1));
+         --  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),
+            M2E (Chap3.Index_Base
+                   (Chap3.Get_Array_Base (Dp2M (L, Info, Mode_Value)),
+                    Arr_Type,
+                    New_Obj_Value (Var_I))));
+         New_Assign_Stmt
+           (New_Obj (Var_R_El),
+            M2E (Chap3.Index_Base
+                   (Chap3.Get_Array_Base (Dp2M (R, Info, Mode_Value)),
+                    Arr_Type,
+                    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);
+         Open_Temp;
+         New_Assign_Stmt (New_Obj (Var_Len),
+                          Chap3.Get_Array_Length (L, Arr_Type));
+         Close_Temp;
+         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, Wki_L_Len, O_Storage_Local, Ghdl_Index_Type);
+         New_Var_Decl (Var_R_Len, Wki_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
+         Arr_Type : constant Iir_Array_Type_Definition :=
+           Get_Type (Get_Interface_Declaration_Chain (Subprg));
+         --  Info for the array type.
+         Info : constant Type_Info_Acc := Get_Info (Arr_Type);
+         --  Identifier of the type.
+         Id : constant Name_Id :=
+           Get_Identifier (Get_Type_Declarator (Arr_Type));
+         Arr_Ptr_Type : constant O_Tnode := Info.Ortho_Ptr_Type (Mode_Value);
+         F_Info : Subprg_Info_Acc;
+         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
+         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_Bound_Length
+                            (Dp2M (L, Info, Mode_Value), Arr_Type, 1));
+         --  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_Bound_Length
+                                 (Dp2M (R, Info, Mode_Value), Arr_Type, 1),
+                               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_Bounds (Dp2M (L, Info, Mode_Value)));
+         New_Assign_Stmt
+           (New_Obj (Var_Base), M2Addr (Chap3.Get_Array_Base (Res)));
+         New_Assign_Stmt
+           (New_Obj (Var_L_Base),
+            M2Addr (Chap3.Get_Array_Base (Dp2M (L, Info, Mode_Value))));
+         if not Is_Monadic then
+            New_Assign_Stmt
+              (New_Obj (Var_R_Base),
+               M2Addr (Chap3.Get_Array_Base (Dp2M (R, Info, 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
+            --  LEFT:
+            --  * I := 0;
+            if not To_Right then
+               Init_Var (Var_I);
+            end if;
+
+            --  * 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));
+            --  Shift the elements (that remains in the result).
+            --  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
+               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);
+            --  RIGHT:
+            --  * else
+            --  *   R := LENGTH;
+            if To_Right then
+               New_Else_Stmt (If_Blk1);
+               New_Assign_Stmt (New_Obj (Var_Rl), New_Obj_Value (Var_Length));
+            end if;
+            Finish_If_Stmt (If_Blk1);
+
+            --  Pad the result.
+            --  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_Otype);
+         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, Wki_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_Otype));
+                  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 : constant Iir_Predefined_Functions :=
+           Get_Implicit_Definition (Subprg);
+      begin
+         if Predefined_To_Onop (Kind) /= ON_Nil then
+            --  Intrinsic.
+            return;
+         end if;
+
+         case Kind is
+            when Iir_Predefined_Error =>
+               raise Internal_Error;
+            when Iir_Predefined_Boolean_And
+              | Iir_Predefined_Boolean_Or
+              | Iir_Predefined_Boolean_Xor
+              | Iir_Predefined_Boolean_Not
+              | Iir_Predefined_Enum_Equality
+              | Iir_Predefined_Enum_Inequality
+              | Iir_Predefined_Enum_Less
+              | Iir_Predefined_Enum_Less_Equal
+              | Iir_Predefined_Enum_Greater
+              | Iir_Predefined_Enum_Greater_Equal
+              | Iir_Predefined_Bit_And
+              | Iir_Predefined_Bit_Or
+              | Iir_Predefined_Bit_Xor
+              | Iir_Predefined_Bit_Not
+              | Iir_Predefined_Integer_Equality
+              | Iir_Predefined_Integer_Inequality
+              | Iir_Predefined_Integer_Less
+              | Iir_Predefined_Integer_Less_Equal
+              | Iir_Predefined_Integer_Greater
+              | Iir_Predefined_Integer_Greater_Equal
+              | Iir_Predefined_Integer_Negation
+              | Iir_Predefined_Integer_Absolute
+              | Iir_Predefined_Integer_Plus
+              | Iir_Predefined_Integer_Minus
+              | Iir_Predefined_Integer_Mul
+              | Iir_Predefined_Integer_Div
+              | Iir_Predefined_Integer_Mod
+              | Iir_Predefined_Integer_Rem
+              | Iir_Predefined_Floating_Equality
+              | Iir_Predefined_Floating_Inequality
+              | Iir_Predefined_Floating_Less
+              | Iir_Predefined_Floating_Less_Equal
+              | Iir_Predefined_Floating_Greater
+              | Iir_Predefined_Floating_Greater_Equal
+              | Iir_Predefined_Floating_Negation
+              | Iir_Predefined_Floating_Absolute
+              | Iir_Predefined_Floating_Plus
+              | Iir_Predefined_Floating_Minus
+              | Iir_Predefined_Floating_Mul
+              | Iir_Predefined_Floating_Div
+              | Iir_Predefined_Physical_Equality
+              | Iir_Predefined_Physical_Inequality
+              | Iir_Predefined_Physical_Less
+              | Iir_Predefined_Physical_Less_Equal
+              | Iir_Predefined_Physical_Greater
+              | Iir_Predefined_Physical_Greater_Equal
+              | Iir_Predefined_Physical_Negation
+              | Iir_Predefined_Physical_Absolute
+              | Iir_Predefined_Physical_Plus
+              | Iir_Predefined_Physical_Minus =>
+               pragma Assert (Predefined_To_Onop (Kind) /= ON_Nil);
+               return;
+
+            when Iir_Predefined_Boolean_Nand
+              | Iir_Predefined_Boolean_Nor
+              | Iir_Predefined_Boolean_Xnor
+              | Iir_Predefined_Bit_Nand
+              | Iir_Predefined_Bit_Nor
+              | Iir_Predefined_Bit_Xnor
+              | Iir_Predefined_Bit_Match_Equality
+              | Iir_Predefined_Bit_Match_Inequality
+              | Iir_Predefined_Bit_Match_Less
+              | Iir_Predefined_Bit_Match_Less_Equal
+              | Iir_Predefined_Bit_Match_Greater
+              | Iir_Predefined_Bit_Match_Greater_Equal
+              | Iir_Predefined_Bit_Condition
+              | Iir_Predefined_Boolean_Rising_Edge
+              | Iir_Predefined_Boolean_Falling_Edge
+              | Iir_Predefined_Bit_Rising_Edge
+              | Iir_Predefined_Bit_Falling_Edge =>
+               --  Intrinsic.
+               null;
+
+            when Iir_Predefined_Enum_Minimum
+              | Iir_Predefined_Enum_Maximum
+              | Iir_Predefined_Enum_To_String =>
+               --  Intrinsic.
+               null;
+
+            when Iir_Predefined_Integer_Identity
+              | Iir_Predefined_Integer_Exp
+              | Iir_Predefined_Integer_Minimum
+              | Iir_Predefined_Integer_Maximum
+              | Iir_Predefined_Integer_To_String =>
+               --  Intrinsic.
+               null;
+            when Iir_Predefined_Universal_R_I_Mul
+              | Iir_Predefined_Universal_I_R_Mul
+              | Iir_Predefined_Universal_R_I_Div =>
+               --  Intrinsic
+               null;
+
+            when Iir_Predefined_Physical_Identity
+              | Iir_Predefined_Physical_Minimum
+              | Iir_Predefined_Physical_Maximum
+              | Iir_Predefined_Physical_To_String
+              | Iir_Predefined_Time_To_String_Unit =>
+               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
+              | Iir_Predefined_Floating_Minimum
+              | Iir_Predefined_Floating_Maximum
+              | Iir_Predefined_Floating_To_String
+              | Iir_Predefined_Real_To_String_Digits
+              | Iir_Predefined_Real_To_String_Format =>
+               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
+              | Iir_Predefined_Bit_Array_Match_Equality
+              | Iir_Predefined_Bit_Array_Match_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
+              | Iir_Predefined_Array_Minimum
+              | Iir_Predefined_Array_Maximum =>
+               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_Vector_Minimum
+              | Iir_Predefined_Vector_Maximum =>
+               null;
+
+            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_TF_Reduction_And
+              | Iir_Predefined_TF_Reduction_Or
+              | Iir_Predefined_TF_Reduction_Nand
+              | Iir_Predefined_TF_Reduction_Nor
+              | Iir_Predefined_TF_Reduction_Xor
+              | Iir_Predefined_TF_Reduction_Xnor
+              | Iir_Predefined_TF_Reduction_Not
+              | Iir_Predefined_TF_Array_Element_And
+              | Iir_Predefined_TF_Element_Array_And
+              | Iir_Predefined_TF_Array_Element_Or
+              | Iir_Predefined_TF_Element_Array_Or
+              | Iir_Predefined_TF_Array_Element_Nand
+              | Iir_Predefined_TF_Element_Array_Nand
+              | Iir_Predefined_TF_Array_Element_Nor
+              | Iir_Predefined_TF_Element_Array_Nor
+              | Iir_Predefined_TF_Array_Element_Xor
+              | Iir_Predefined_TF_Element_Array_Xor
+              | Iir_Predefined_TF_Array_Element_Xnor
+              | Iir_Predefined_TF_Element_Array_Xnor =>
+               null;
+
+            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_Access_Equality
+              | Iir_Predefined_Access_Inequality =>
+               --  Intrinsic.
+               null;
+            when Iir_Predefined_Deallocate =>
+               --  Intrinsic.
+               null;
+
+            when Iir_Predefined_File_Open
+              | Iir_Predefined_File_Open_Status
+              | Iir_Predefined_File_Close
+              | Iir_Predefined_Flush
+              | 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_Attribute_Image
+              | Iir_Predefined_Attribute_Value
+              | Iir_Predefined_Attribute_Pos
+              | Iir_Predefined_Attribute_Val
+              | Iir_Predefined_Attribute_Succ
+              | Iir_Predefined_Attribute_Pred
+              | Iir_Predefined_Attribute_Leftof
+              | Iir_Predefined_Attribute_Rightof
+              | Iir_Predefined_Attribute_Left
+              | Iir_Predefined_Attribute_Right
+              | Iir_Predefined_Attribute_Event
+              | Iir_Predefined_Attribute_Active
+              | Iir_Predefined_Attribute_Last_Event
+              | Iir_Predefined_Attribute_Last_Active
+              | Iir_Predefined_Attribute_Last_Value
+              | Iir_Predefined_Attribute_Driving
+              | Iir_Predefined_Attribute_Driving_Value =>
+               raise Internal_Error;
+
+            when Iir_Predefined_Array_Char_To_String
+              | Iir_Predefined_Bit_Vector_To_Ostring
+              | Iir_Predefined_Bit_Vector_To_Hstring
+              | Iir_Predefined_Std_Ulogic_Match_Equality
+              | Iir_Predefined_Std_Ulogic_Match_Inequality
+              | Iir_Predefined_Std_Ulogic_Match_Less
+              | Iir_Predefined_Std_Ulogic_Match_Less_Equal
+              | Iir_Predefined_Std_Ulogic_Match_Greater
+              | Iir_Predefined_Std_Ulogic_Match_Greater_Equal
+              | Iir_Predefined_Std_Ulogic_Array_Match_Equality
+              | Iir_Predefined_Std_Ulogic_Array_Match_Inequality =>
+               null;
+
+            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
+         Subprg_Info : constant Ortho_Info_Acc :=
+           Get_Info (Chap2.Current_Subprogram);
+         Expr : constant Iir := Get_Expression (Stmt);
+         Ret_Type : Iir;
+         Ret_Info : Type_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
+         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.
+               declare
+                  Val : Mnode;
+                  Area : Mnode;
+               begin
+                  Area := Dp2M (Subprg_Info.Res_Interface,
+                                Ret_Info, Mode_Value);
+                  Val := Stabilize
+                    (E2M (Chap7.Translate_Expression (Expr, Ret_Type),
+                          Ret_Info, Mode_Value));
+                  Chap3.Translate_Object_Allocation
+                    (Area, Alloc_Return, Ret_Type,
+                     Chap3.Get_Array_Bounds (Val));
+                  Chap3.Translate_Object_Copy (Area, M2Addr (Val), Ret_Type);
+                  Gen_Return;
+               end;
+            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_Type;
+         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_Type;
+         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_Type;
+         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_Expr (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_Expr (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_Choice_Name (Aggr_El);
+               when others =>
+                  Error_Kind ("translate_variable_rec_aggr", Aggr_El);
+            end case;
+            Translate_Variable_Aggregate_Assignment
+              (Get_Associated_Expr (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;
+      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));
+         New_Procedure_Call (Assocs);
+      end Translate_Report;
+
+      --  Return True if the current library unit is part of library IEEE.
+      function Is_Within_Ieee_Library return Boolean
+      is
+         Design_File : Iir;
+         Library : Iir;
+      begin
+         --  Guard.
+         if Current_Library_Unit = Null_Iir then
+            return False;
+         end if;
+         Design_File :=
+           Get_Design_File (Get_Design_Unit (Current_Library_Unit));
+         Library := Get_Library (Design_File);
+         return Get_Identifier (Library) = Std_Names.Name_Ieee;
+      end Is_Within_Ieee_Library;
+
+      procedure Translate_Assertion_Statement (Stmt : Iir_Assertion_Statement)
+      is
+         Expr : Iir;
+         If_Blk : O_If_Block;
+         Subprg : O_Dnode;
+      begin
+         --  Select the procedure to call in case of assertion (so that
+         --  assertions within the IEEE library could be ignored).
+         if Is_Within_Ieee_Library then
+            Subprg := Ghdl_Ieee_Assert_Failed;
+         else
+            Subprg := Ghdl_Assert_Failed;
+         end if;
+
+         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, Subprg, 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, Subprg, 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_Choice_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_Chain (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_Chain (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_Chain (Choice);
+            Ch := Choice;
+            loop
+               case Get_Kind (Ch) is
+                  when Iir_Kind_Choice_By_Expression =>
+                     Ch_Expr := Get_Choice_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_Chain (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_Choice_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_Choice_Range (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_Chain (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);
+               pragma Assert (Get_Associated_Chain (Choice) = Null_Iir);
+            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_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
+                  Std_File_Open_Status_Otype : constant O_Tnode :=
+                    Get_Ortho_Type (File_Open_Status_Type_Definition,
+                                    Mode_Value);
+                  N_Param : Iir;
+                  Status_Param : constant Iir := Get_Actual (Param_Chain);
+                  File_Param : Iir;
+                  Name_Param : Iir;
+                  Kind_Param : Iir;
+                  Constr : O_Assoc_List;
+                  Status : Mnode;
+               begin
+                  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_Otype));
+               end;
+
+            when Iir_Predefined_File_Close =>
+               declare
+                  File_Param : constant Iir := Get_Actual (Param_Chain);
+                  Constr : O_Assoc_List;
+               begin
+                  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 Iir_Predefined_Flush =>
+               declare
+                  File_Param : constant Iir := Get_Actual (Param_Chain);
+                  Constr : O_Assoc_List;
+               begin
+                  Start_Association (Constr, Ghdl_File_Flush);
+                  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_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_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 : Mnode;
+         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_Interface_Signal_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 := 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_Interface_Constant_Declaration
+                    | Iir_Kind_Interface_File_Declaration =>
+                     --  No conversion here.
+                     E_Params (Pos) := Chap7.Translate_Expression
+                       (Act, Formal_Type);
+                  when Iir_Kind_Interface_Variable_Declaration
+                    | Iir_Kind_Interface_Signal_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_Interface_Constant_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_Interface_Signal_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_Interface_Variable_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_B1 =>
+               Subprg := Ghdl_Signal_Simple_Assign_B1;
+               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_B1 =>
+               Subprg := Ghdl_Signal_Start_Assign_B1;
+               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_B1 =>
+               Subprg := Ghdl_Signal_Next_Assign_B1;
+               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_Expr (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_Choice_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_Expr (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_Otype);
+               After_Time := Create_Temp (Std_Time_Otype);
+               Del := Get_Time (We);
+               if Del = Null_Iir then
+                  New_Assign_Stmt
+                    (New_Obj (After_Time),
+                     New_Lit (New_Signed_Literal (Std_Time_Otype, 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_Otype, 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_Otype);
+                  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_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_Type;
+         Sig : Iir;
+      begin
+         for I in Drivers.all'Range loop
+            Var := Drivers (I).Var;
+            if Var /= Null_Var 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_Type;
+         Sig : Iir;
+      begin
+         for I in Drivers.all'Range loop
+            Var := Drivers (I).Var;
+            if Var /= Null_Var then
+               Sig := Get_Object_Prefix (Drivers (I).Sig);
+               Info := Get_Info (Sig);
+               case Info.Kind is
+                  when Kind_Object =>
+                     Info.Object_Driver := Null_Var;
+                  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
+         Info : constant Proc_Info_Acc := Get_Info (Proc);
+         Inter_List : O_Inter_List;
+         Instance : O_Dnode;
+      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.Process_Subprg);
+
+         Start_Subprogram_Body (Info.Process_Subprg);
+         Push_Local_Factory;
+         --  Push scope for architecture declarations.
+         Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
+
+         Chap8.Translate_Statements_Chain
+           (Get_Sequential_Statement_Chain (Proc));
+
+         Clear_Scope (Base.Block_Scope);
+         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;
+         Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
+         Open_Temp;
+         New_Return_Stmt (Chap7.Translate_Expression (Guard_Expr));
+         Close_Temp;
+         Clear_Scope (Base.Block_Scope);
+         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);
+
+         if Is_Component_Instantiation (Inst) 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),
+               Get_Scope_Type (Comp_Info.Comp_Scope));
+         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 (Info.Block_Scope'Access);
+                  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_Scope'Access);
+            New_Type_Decl
+              (Create_Identifier (Get_Identifier (Inst), "__CONVS"),
+               Get_Scope_Type (Info.Block_Scope));
+            Info.Block_Parent_Field := Add_Instance_Factory_Field
+              (Create_Identifier_Without_Prefix (Get_Identifier (Inst),
+                                                 "__CONVS"),
+               Get_Scope_Type (Info.Block_Scope));
+         end if;
+      end Translate_Component_Instantiation_Statement;
+
+      procedure Translate_Process_Declarations (Proc : Iir)
+      is
+         Mark : Id_Mark_Type;
+         Info : Ortho_Info_Acc;
+
+         Drivers : Iir_List;
+         Nbr_Drivers : Natural;
+         Sig : Iir;
+      begin
+         Info := Add_Info (Proc, Kind_Process);
+
+         --  Create process record.
+         Push_Identifier_Prefix (Mark, Get_Identifier (Proc));
+         Push_Instance_Factory (Info.Process_Scope'Access);
+         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_Var);
+               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 (Info.Process_Scope'Access);
+         New_Type_Decl (Create_Identifier ("INSTTYPE"),
+                        Get_Scope_Type (Info.Process_Scope));
+         Pop_Identifier_Prefix (Mark);
+
+         --  Create a field in the parent record.
+         Add_Scope_Field (Create_Identifier_Without_Prefix (Proc),
+                          Info.Process_Scope);
+      end Translate_Process_Declarations;
+
+      procedure Translate_Psl_Directive_Declarations (Stmt : Iir)
+      is
+         use PSL.Nodes;
+         use PSL.NFAs;
+
+         N : constant NFA := Get_PSL_NFA (Stmt);
+
+         Mark : Id_Mark_Type;
+         Info : Ortho_Info_Acc;
+      begin
+         Info := Add_Info (Stmt, Kind_Psl_Directive);
+
+         --  Create process record.
+         Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+         Push_Instance_Factory (Info.Psl_Scope'Access);
+
+         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 (Info.Psl_Scope'Access);
+         New_Type_Decl (Create_Identifier ("INSTTYPE"),
+                        Get_Scope_Type (Info.Psl_Scope));
+         Pop_Identifier_Prefix (Mark);
+
+         --  Create a field in the parent record.
+         Add_Scope_Field
+           (Create_Identifier_Without_Prefix (Stmt), Info.Psl_Scope);
+      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.
+         Set_Scope_Via_Param_Ptr (Base.Block_Scope, 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);
+
+         Clear_Scope (Base.Block_Scope);
+         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.
+                  Set_Scope_Via_Param_Ptr (Base.Block_Scope, 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;
+
+                  Clear_Scope (Base.Block_Scope);
+                  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.
+               Set_Scope_Via_Param_Ptr (Base.Block_Scope, 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);
+
+               Clear_Scope (Base.Block_Scope);
+               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;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (El));
+
+                     Info := Add_Info (El, Kind_Block);
+                     Chap1.Start_Block_Decl (El);
+                     Push_Instance_Factory (Info.Block_Scope'Access);
+
+                     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_Scope'Access);
+                     Pop_Identifier_Prefix (Mark);
+
+                     --  Create a field in the parent record.
+                     Add_Scope_Field
+                       (Create_Identifier_Without_Prefix (El),
+                        Info.Block_Scope);
+                  end;
+               when Iir_Kind_Generate_Statement =>
+                  declare
+                     Scheme : constant Iir := Get_Generation_Scheme (El);
+                     Info : Block_Info_Acc;
+                     Mark : Id_Mark_Type;
+                     Iter_Type : Iir;
+                     It_Info : Ortho_Info_Acc;
+                  begin
+                     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_Scope'Access);
+
+                     --  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_Scope'Access);
+
+                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+                        --  Create array type of block_decls_type
+                        Info.Block_Decls_Array_Type := New_Array_Type
+                          (Get_Scope_Type (Info.Block_Scope), 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_Scope : Var_Scope_Type;
+                                       Comp_Field : O_Fnode)
+         is
+         begin
+            New_Assign_Stmt
+              (New_Selected_Element
+                 (New_Selected_Element (Get_Instance_Ref (Ref_Scope),
+                                        Comp_Field),
+                  Rtis.Ghdl_Component_Link_Stmt),
+               New_Lit (Rtis.Get_Context_Rti (Stmt)));
+         end Set_Component_Link;
+
+         Info : constant Block_Info_Acc := Get_Info (Stmt);
+
+         Parent : constant Iir := Get_Parent (Stmt);
+         Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
+
+         Comp : Iir;
+         Comp_Info : Comp_Info_Acc;
+         Inter_List : O_Inter_List;
+         Instance : O_Dnode;
+      begin
+         --  Create the elaborator for the instantiation.
+         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;
+         Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
+
+         New_Debug_Line_Stmt (Get_Line_Number (Stmt));
+
+         --  Add access to the instantiation-specific data.
+         --  This is used only for anonymous subtype variables.
+         if Has_Scope_Type (Info.Block_Scope) then
+            Set_Scope_Via_Field (Info.Block_Scope,
+                                 Info.Block_Parent_Field,
+                                 Parent_Info.Block_Scope'Access);
+         end if;
+
+         Comp := Get_Instantiated_Unit (Stmt);
+         if Is_Entity_Instantiation (Stmt) then
+            --  This is a direct instantiation.
+            Set_Component_Link (Parent_Info.Block_Scope,
+                                Info.Block_Link_Field);
+            Translate_Entity_Instantiation (Comp, Stmt, Stmt, Null_Iir);
+         else
+            Comp := Get_Named_Entity (Comp);
+            Comp_Info := Get_Info (Comp);
+            Set_Scope_Via_Field (Comp_Info.Comp_Scope,
+                                 Info.Block_Link_Field,
+                                 Parent_Info.Block_Scope'Access);
+
+            --  Set the link from component declaration to component
+            --  instantiation statement.
+            Set_Component_Link (Comp_Info.Comp_Scope, Comp_Info.Comp_Link);
+
+            Chap5.Elab_Map_Aspect (Stmt, Comp);
+
+            Clear_Scope (Comp_Info.Comp_Scope);
+         end if;
+
+         if Has_Scope_Type (Info.Block_Scope) then
+            Clear_Scope (Info.Block_Scope);
+         end if;
+
+         Clear_Scope (Base.Block_Scope);
+         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
+         Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
+         Stmt : Iir;
+         Mark : Id_Mark_Type;
+      begin
+         Chap4.Translate_Declaration_Chain_Subprograms (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 =>
+                  if Flag_Direct_Drivers then
+                     Chap9.Set_Direct_Drivers (Stmt);
+                  end if;
+
+                  Chap4.Translate_Declaration_Chain_Subprograms (Stmt);
+                  Translate_Process_Statement (Stmt, Base_Info);
+
+                  if Flag_Direct_Drivers then
+                     Chap9.Reset_Direct_Drivers (Stmt);
+                  end if;
+               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_Statement (Stmt, Base_Info);
+               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
+                     Guard : constant Iir := Get_Guard_Decl (Stmt);
+                     Hdr : constant Iir := Get_Block_Header (Stmt);
+                  begin
+                     if Guard /= Null_Iir then
+                        Translate_Implicit_Guard_Signal (Guard, Base_Info);
+                     end if;
+                     if Hdr /= Null_Iir then
+                        Chap4.Translate_Association_Subprograms
+                          (Hdr, Block, Base_Block, Null_Iir);
+                     end if;
+                     Translate_Block_Subprograms (Stmt, Base_Block);
+                  end;
+               when Iir_Kind_Generate_Statement =>
+                  declare
+                     Info : constant Block_Info_Acc := Get_Info (Stmt);
+                     Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
+                  begin
+                     Chap2.Push_Subprg_Instance (Info.Block_Scope'Access,
+                                                 Info.Block_Decls_Ptr_Type,
+                                                 Wki_Instance,
+                                                 Prev_Subprg_Instance);
+                     Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope,
+                                              Info.Block_Origin_Field,
+                                              Info.Block_Scope'Access);
+                     Translate_Block_Subprograms (Stmt, Stmt);
+                     Clear_Scope (Base_Info.Block_Scope);
+                     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_Interface_Signal_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);
+                  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
+      --  BASE_INFO: info for the global block
+      procedure Elab_Process (Proc : Iir; Base_Info : Block_Info_Acc)
+      is
+         Info : constant Proc_Info_Acc := Get_Info (Proc);
+         Is_Sensitized : constant Boolean :=
+           Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement;
+         Subprg : O_Dnode;
+         Constr : O_Assoc_List;
+         List : Iir_List;
+         List_Orig : Iir_List;
+         Final : Boolean;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Proc));
+
+         --  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_Scope), 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_Var 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;
+      end Elab_Process;
+
+      --  PROC: the process to be elaborated
+      --  BLOCK: the block containing the process (its parent)
+      --  BASE_INFO: info for the global block
+      procedure Elab_Psl_Directive (Stmt : Iir;
+                                    Base_Info : Block_Info_Acc)
+      is
+         Info : constant Psl_Info_Acc := Get_Info (Stmt);
+         Constr : O_Assoc_List;
+         List : Iir_List;
+         Clk : PSL_Node;
+         Var_I : O_Dnode;
+         Label : O_Snode;
+      begin
+         New_Debug_Line_Stmt (Get_Line_Number (Stmt));
+
+         --  Register process.
+         Start_Association (Constr, Ghdl_Sensitized_Process_Register);
+         New_Association
+           (Constr, New_Unchecked_Address
+            (Get_Instance_Ref (Base_Info.Block_Scope), 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_Scope),
+                  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_Var then
+            New_Assign_Stmt (Get_Var (Info.Psl_Bool_Var),
+                             New_Lit (Ghdl_Bool_False_Node));
+         end if;
+      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_Scope), 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_Scope : Var_Scope_Type;
+                                 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_Scope),
+                                           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_Scope),
+                                           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 : constant Comp_Info_Acc := Get_Info (Parent);
+                  begin
+                     Set_Links (Comp_Info.Comp_Scope, Comp_Info.Comp_Link);
+                  end;
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  --  Direct instantiation.
+                  declare
+                     Parent_Info : constant Block_Info_Acc :=
+                       Get_Info (Get_Parent (Parent));
+                  begin
+                     Set_Links (Parent_Info.Block_Scope,
+                                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.
+         Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, Var_Sub);
+         Chap5.Elab_Map_Aspect (Mapping, Entity);
+         Clear_Scope (Entity_Info.Block_Scope);
+
+         --  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 : constant Iir := Get_Generation_Scheme (Stmt);
+         Info : constant Block_Info_Acc := Get_Info (Stmt);
+         Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
+         Var : O_Dnode;
+         Blk : O_If_Block;
+         V : O_Lnode;
+      begin
+         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 (Get_Scope_Size (Info.Block_Scope)),
+                       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_Scope);
+         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
+         Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
+         Elab_Block_Declarations (Stmt, Stmt);
+         Clear_Scope (Info.Block_Scope);
+         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 : constant Iir := Get_Generation_Scheme (Stmt);
+         Iter_Type : constant Iir := Get_Type (Scheme);
+         Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
+         Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type);
+         Info : constant Block_Info_Acc := Get_Info (Stmt);
+         Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
+--         Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
+         Var_Inst : O_Dnode;
+         Var_I : O_Dnode;
+         Label : O_Snode;
+         V : O_Lnode;
+         Var : O_Dnode;
+         Range_Ptr : O_Dnode;
+      begin
+         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 (Get_Scope_Size (Info.Block_Scope))),
+             Info.Block_Decls_Array_Ptr_Type));
+
+         --  Add a link to child in parent.
+         V := Get_Instance_Ref (Parent_Info.Block_Scope);
+         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
+         Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
+         --  Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope,
+         --                            Info.Block_Origin_Field,
+         --                            Info.Block_Scope'Access);
+
+         --  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);
+
+--         Clear_Scope (Base_Info.Block_Scope);
+         Clear_Scope (Info.Block_Scope);
+
+         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_B1 =>
+                  Init_Subprg := Ghdl_Signal_Init_B1;
+                  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
+         Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
+         Stmt : Iir;
+         Final : Boolean;
+      begin
+         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 : constant Iir_Block_Header :=
+                    Get_Block_Header (Block);
+                  Guard : constant Iir := Get_Guard_Decl (Block);
+               begin
+                  if Guard /= Null_Iir then
+                     New_Debug_Line_Stmt (Get_Line_Number (Guard));
+                     Elab_Implicit_Guard_Signal (Block, Base_Info);
+                  end if;
+                  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, 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, Base_Info);
+               when Iir_Kind_Component_Instantiation_Statement =>
+                  declare
+                     Info : constant Block_Info_Acc := Get_Info (Stmt);
+                     Constr : O_Assoc_List;
+                  begin
+                     Start_Association (Constr, Info.Block_Elab_Subprg);
+                     New_Association
+                       (Constr, Get_Instance_Access (Base_Block));
+                     New_Procedure_Call (Constr);
+                  end;
+               when Iir_Kind_Block_Statement =>
+                  declare
+                     Mark : Id_Mark_Type;
+                  begin
+                     Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+                     Elab_Block_Declarations (Stmt, Base_Block);
+                     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;
+
+      function Get_Scope_Type (Scope : Var_Scope_Type) return O_Tnode is
+      begin
+         pragma Assert (Scope.Scope_Type /= O_Tnode_Null);
+         return Scope.Scope_Type;
+      end Get_Scope_Type;
+
+      function Get_Scope_Size (Scope : Var_Scope_Type) return O_Cnode is
+      begin
+         pragma Assert (Scope.Scope_Type /= O_Tnode_Null);
+         return New_Sizeof (Scope.Scope_Type, Ghdl_Index_Type);
+      end Get_Scope_Size;
+
+      function Has_Scope_Type (Scope : Var_Scope_Type) return Boolean is
+      begin
+         return Scope.Scope_Type /= O_Tnode_Null;
+      end Has_Scope_Type;
+
+      procedure Predeclare_Scope_Type (Scope : Var_Scope_Acc; Name : O_Ident)
+      is
+      begin
+         pragma Assert (Scope.Scope_Type = O_Tnode_Null);
+         New_Uncomplete_Record_Type (Scope.Scope_Type);
+         New_Type_Decl (Name, Scope.Scope_Type);
+      end Predeclare_Scope_Type;
+
+      procedure Declare_Scope_Acc
+        (Scope : Var_Scope_Type; Name : O_Ident; Ptr_Type : out O_Tnode) is
+      begin
+         Ptr_Type := New_Access_Type (Get_Scope_Type (Scope));
+         New_Type_Decl (Name, Ptr_Type);
+      end Declare_Scope_Acc;
+
+      procedure Push_Instance_Factory (Scope : Var_Scope_Acc)
+      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;
+         Inst.Scope := Scope;
+
+         Identifier_Start := Identifier_Len + 1;
+
+         if Scope.Scope_Type /= O_Tnode_Null then
+            Start_Uncomplete_Record_Type (Scope.Scope_Type, Inst.Elements);
+         else
+            Start_Record_Type (Inst.Elements);
+         end if;
+         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 Add_Scope_Field
+        (Name : O_Ident; Child : in out Var_Scope_Type)
+      is
+         Field : O_Fnode;
+      begin
+         Field := Add_Instance_Factory_Field (Name, Get_Scope_Type (Child));
+         Set_Scope_Via_Field (Child, Field, Inst_Build.Scope);
+      end Add_Scope_Field;
+
+      function Get_Scope_Offset (Child : Var_Scope_Type; Otype : O_Tnode)
+                                return O_Cnode is
+      begin
+         return New_Offsetof (Get_Scope_Type (Child.Up_Link.all),
+                              Child.Field, Otype);
+      end Get_Scope_Offset;
+
+      procedure Pop_Instance_Factory (Scope : in Var_Scope_Acc)
+      is
+         Res : O_Tnode;
+      begin
+         if Inst_Build.Kind /= Instance then
+            --  Not matching.
+            raise Internal_Error;
+         end if;
+         Finish_Record_Type (Inst_Build.Elements, Res);
+         Pop_Build_Instance;
+         Scope.Scope_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;
+
+      procedure Set_Scope_Via_Field
+        (Scope : in out Var_Scope_Type;
+         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc) is
+      begin
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         Scope := (Scope_Type => Scope.Scope_Type,
+                   Kind => Var_Scope_Field,
+                   Field => Scope_Field, Up_Link => Scope_Parent);
+      end Set_Scope_Via_Field;
+
+      procedure Set_Scope_Via_Field_Ptr
+        (Scope : in out Var_Scope_Type;
+         Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc) is
+      begin
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         Scope := (Scope_Type => Scope.Scope_Type,
+                   Kind => Var_Scope_Field_Ptr,
+                   Field => Scope_Field, Up_Link => Scope_Parent);
+      end Set_Scope_Via_Field_Ptr;
+
+      procedure Set_Scope_Via_Var_Ptr
+        (Scope : in out Var_Scope_Type; Var : Var_Type) is
+      begin
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         pragma Assert (Var.Kind = Var_Scope);
+         Scope := (Scope_Type => Scope.Scope_Type,
+                   Kind => Var_Scope_Field_Ptr,
+                   Field => Var.I_Field, Up_Link => Var.I_Scope);
+      end Set_Scope_Via_Var_Ptr;
+
+      procedure Set_Scope_Via_Param_Ptr
+        (Scope : in out Var_Scope_Type; Scope_Param : O_Dnode) is
+      begin
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         Scope := (Scope_Type => Scope.Scope_Type,
+                   Kind => Var_Scope_Ptr, D => Scope_Param);
+      end Set_Scope_Via_Param_Ptr;
+
+      procedure Set_Scope_Via_Decl
+        (Scope : in out Var_Scope_Type; Decl : O_Dnode) is
+      begin
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         Scope := (Scope_Type => Scope.Scope_Type,
+                   Kind => Var_Scope_Decl, D => Decl);
+      end Set_Scope_Via_Decl;
+
+      procedure Clear_Scope (Scope : in out Var_Scope_Type) is
+      begin
+         pragma Assert (Scope.Kind /= Var_Scope_None);
+         Scope := (Scope_Type => Scope.Scope_Type, Kind => Var_Scope_None);
+      end Clear_Scope;
+
+      function Create_Global_Var
+        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
+        return Var_Type
+      is
+         Var : O_Dnode;
+      begin
+         New_Var_Decl (Var, Name, Storage, Vtype);
+         return 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_Type
+      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 Var_Type'(Kind => Var_Global, E => Res);
+      end Create_Global_Const;
+
+      procedure Define_Global_Const (Const : in out Var_Type; 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_Type
+      is
+         Res : O_Dnode;
+         Field : O_Fnode;
+         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 Var_Type'(Kind => Var_Local, E => Res);
+            when Instance =>
+               --  Create a field.
+               New_Record_Field (Inst_Build.Elements, Field, Name.Id, Vtype);
+               return Var_Type'(Kind => Var_Scope, I_Field => Field,
+                                I_Scope => Inst_Build.Scope);
+         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 (Scope : Var_Scope_Type;
+                            Res : out O_Lnode;
+                            Is_Ptr : out Boolean) is
+      begin
+         case Scope.Kind is
+            when Var_Scope_None =>
+               raise Internal_Error;
+            when Var_Scope_Ptr
+              | Var_Scope_Decl =>
+               Res := New_Obj (Scope.D);
+               Is_Ptr := Scope.Kind = Var_Scope_Ptr;
+            when Var_Scope_Field
+              | Var_Scope_Field_Ptr =>
+               declare
+                  Parent : O_Lnode;
+                  Parent_Ptr : Boolean;
+               begin
+                  Find_Scope (Scope.Up_Link.all, Parent, Parent_Ptr);
+                  if Parent_Ptr then
+                     Parent := New_Acc_Value (Parent);
+                  end if;
+                  Res := New_Selected_Element (Parent, Scope.Field);
+                  Is_Ptr := Scope.Kind = Var_Scope_Field_Ptr;
+               end;
+         end case;
+      end Find_Scope;
+
+      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 (Info.Block_Scope, 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 (Scope : Var_Scope_Type) return O_Lnode
+      is
+         Res : O_Lnode;
+         Is_Ptr : Boolean;
+      begin
+         Check_Not_Building;
+         Find_Scope (Scope, 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_Type) return O_Lnode
+      is
+      begin
+         case Var.Kind is
+            when Var_None =>
+               raise Internal_Error;
+            when Var_Local
+              | Var_Global =>
+               return New_Obj (Var.E);
+            when Var_Scope =>
+               return New_Selected_Element
+                 (Get_Instance_Ref (Var.I_Scope.all), Var.I_Field);
+         end case;
+      end Get_Var;
+
+      function Get_Alloc_Kind_For_Var (Var : Var_Type)
+                                      return Allocation_Kind is
+      begin
+         case Var.Kind is
+            when Var_Local =>
+               return Alloc_Stack;
+            when Var_Global
+              | Var_Scope =>
+               return Alloc_System;
+            when Var_None =>
+               raise Internal_Error;
+         end case;
+      end Get_Alloc_Kind_For_Var;
+
+      function Is_Var_Stable (Var : Var_Type) return Boolean is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return True;
+            when Var_Scope =>
+               return False;
+            when Var_None =>
+               raise Internal_Error;
+         end case;
+      end Is_Var_Stable;
+
+      function Is_Var_Field (Var : Var_Type) return Boolean is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return False;
+            when Var_Scope =>
+               return True;
+            when Var_None =>
+               raise Internal_Error;
+         end case;
+      end Is_Var_Field;
+
+      function Get_Var_Offset (Var : Var_Type; Otype : O_Tnode) return O_Cnode
+      is
+      begin
+         return New_Offsetof (Get_Scope_Type (Var.I_Scope.all),
+                              Var.I_Field, Otype);
+      end Get_Var_Offset;
+
+      function Get_Var_Label (Var : Var_Type) return O_Dnode is
+      begin
+         case Var.Kind is
+            when Var_Local
+              | Var_Global =>
+               return Var.E;
+            when Var_Scope
+              | Var_None =>
+               raise Internal_Error;
+         end case;
+      end Get_Var_Label;
+
+      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;
+
+      type Instantiate_Var_Stack;
+      type Instantiate_Var_Stack_Acc is access Instantiate_Var_Stack;
+
+      type Instantiate_Var_Stack is record
+         Orig_Scope : Var_Scope_Acc;
+         Inst_Scope : Var_Scope_Acc;
+         Prev : Instantiate_Var_Stack_Acc;
+      end record;
+
+      Top_Instantiate_Var_Stack : Instantiate_Var_Stack_Acc := null;
+      Free_Instantiate_Var_Stack : Instantiate_Var_Stack_Acc := null;
+
+      procedure Push_Instantiate_Var_Scope
+        (Inst_Scope : Var_Scope_Acc; Orig_Scope : Var_Scope_Acc)
+      is
+         Inst : Instantiate_Var_Stack_Acc;
+      begin
+         if Free_Instantiate_Var_Stack = null then
+            Inst := new Instantiate_Var_Stack;
+         else
+            Inst := Free_Instantiate_Var_Stack;
+            Free_Instantiate_Var_Stack := Inst.Prev;
+         end if;
+         Inst.all := (Orig_Scope => Orig_Scope,
+                      Inst_Scope => Inst_Scope,
+                      Prev => Top_Instantiate_Var_Stack);
+         Top_Instantiate_Var_Stack := Inst;
+      end Push_Instantiate_Var_Scope;
+
+      procedure Pop_Instantiate_Var_Scope (Inst_Scope : Var_Scope_Acc)
+      is
+         Item : constant Instantiate_Var_Stack_Acc :=
+           Top_Instantiate_Var_Stack;
+      begin
+         pragma Assert (Item /= null);
+         pragma Assert (Item.Inst_Scope = Inst_Scope);
+         Top_Instantiate_Var_Stack := Item.Prev;
+         Item.all := (Orig_Scope => null,
+                      Inst_Scope => null,
+                      Prev => Free_Instantiate_Var_Stack);
+         Free_Instantiate_Var_Stack := Item;
+      end Pop_Instantiate_Var_Scope;
+
+      function Instantiated_Var_Scope (Scope : Var_Scope_Acc)
+                                      return Var_Scope_Acc
+      is
+         Item : Instantiate_Var_Stack_Acc;
+      begin
+         if Scope = null then
+            return null;
+         end if;
+
+         Item := Top_Instantiate_Var_Stack;
+         loop
+            pragma Assert (Item /= null);
+            if Item.Orig_Scope = Scope then
+               return Item.Inst_Scope;
+            end if;
+            Item := Item.Prev;
+         end loop;
+      end Instantiated_Var_Scope;
+
+      function Instantiate_Var (Var : Var_Type) return Var_Type is
+      begin
+         case Var.Kind is
+            when Var_None
+              | Var_Global
+              | Var_Local =>
+               return Var;
+            when Var_Scope =>
+               return Var_Type'
+                 (Kind => Var_Scope,
+                  I_Field => Var.I_Field,
+                  I_Scope => Instantiated_Var_Scope (Var.I_Scope));
+         end case;
+      end Instantiate_Var;
+
+      function Instantiate_Var_Scope (Scope : Var_Scope_Type)
+                                     return Var_Scope_Type is
+      begin
+         case Scope.Kind is
+            when Var_Scope_None
+              | Var_Scope_Ptr
+              | Var_Scope_Decl =>
+               return Scope;
+            when Var_Scope_Field =>
+               return Var_Scope_Type'
+                 (Kind => Var_Scope_Field,
+                  Scope_Type => Scope.Scope_Type,
+                  Field => Scope.Field,
+                  Up_Link => Instantiated_Var_Scope (Scope.Up_Link));
+            when Var_Scope_Field_Ptr =>
+               return Var_Scope_Type'
+                 (Kind => Var_Scope_Field_Ptr,
+                  Scope_Type => Scope.Scope_Type,
+                  Field => Scope.Field,
+                  Up_Link => Instantiated_Var_Scope (Scope.Up_Link));
+         end case;
+      end Instantiate_Var_Scope;
+   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
+        (Atype : Iir; Is_High : Boolean) return O_Enode
+      is
+         Cons : constant Iir := Get_Range_Constraint (Atype);
+      begin
+         --  FIXME: improve code if constraint is a range expression.
+         if Get_Type_Staticness (Atype) = Locally then
+            if Get_Direction (Cons) = Iir_To xor Is_High then
+               return New_Lit
+                 (Chap7.Translate_Static_Range_Left (Cons, Atype));
+            else
+               return New_Lit
+                 (Chap7.Translate_Static_Range_Right (Cons, Atype));
+            end if;
+         else
+            return M2E (Range_To_High_Low
+                          (Chap3.Type_To_Range (Atype), Atype, Is_High));
+         end if;
+      end Translate_High_Low_Type_Attribute;
+
+      function Translate_High_Low_Array_Attribute (Expr : Iir;
+                                                   Is_High : Boolean)
+                                                  return O_Enode
+      is
+      begin
+         --  FIXME: improve code if index is a range expression.
+         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_B1
+              | 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 : constant Iir := Get_Prefix (Attr);
+         Prefix_Type : constant Iir := Get_Type (Prefix);
+      begin
+         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_Otype,
+            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_Otype);
+
+         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_Otype, -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_Otype, 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_Otype, 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_B1 =>
+               Subprg := Ghdl_Signal_Driving_Value_B1;
+            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_B1 =>
+               Subprg := Ghdl_Image_B1;
+               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_B1
+              | 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_B1 =>
+               Subprg := Ghdl_Value_B1;
+            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_B1
+              | 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_b1"),
+               Ghdl_Rtik_Type_B1);
+            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,
+                              Wki_Val, 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_Type) return Rti_Depth_Type
+      is
+      begin
+         if Var = Null_Var 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_Type := Null_Var; 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_Type) return O_Cnode
+      is
+      begin
+         if Is_Var_Field (Var) then
+            return Get_Var_Offset (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
+         Info : constant Type_Info_Acc := Get_Info (Atype);
+         Val : O_Cnode;
+      begin
+         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_B1 =>
+                  Kind := Ghdl_Rtik_Type_B1;
+               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_Type;
+         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_Var 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_Var 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_Type;
+         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_Interface_Signal_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_Interface_Constant_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_Var;
+               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_Interface_Signal_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_Interface_Signal_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_Var 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_Interface_Signal_Declaration
+                 | Iir_Kind_Constant_Declaration
+                 | Iir_Kind_Interface_Constant_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_Scope_Type
+                                  (Get_Info (Get_Parent (Stmt)).Block_Scope),
+                                Info.Block_Link_Field,
+                                Ghdl_Ptr_Type));
+         New_Record_Aggr_El (List, New_Rti_Address (Parent));
+         if Is_Component_Instantiation (Stmt) then
+            Val := New_Rti_Address
+              (Get_Info (Get_Named_Entity (Inst)).Comp_Rti_Const);
+         else
+            declare
+               Ent : constant Iir := Get_Entity_From_Entity_Aspect (Inst);
+            begin
+               Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const);
+            end;
+         end if;
+
+         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_Interface_Signal_Declaration
+                 | Iir_Kind_Interface_Constant_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_Off : O_Cnode;
+         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_Off := O_Cnode_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);
+               Inst := Get_Scope_Type (Info.Block_Scope);
+               Field_Off := New_Offsetof
+                 (Get_Scope_Type (Info.Block_Scope),
+                  Info.Block_Parent_Field, Ghdl_Ptr_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 := Get_Scope_Type (Info.Block_Scope);
+            when Iir_Kind_Process_Statement
+              | Iir_Kind_Sensitized_Process_Statement =>
+               Kind := Ghdl_Rtik_Process;
+               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+               Field_Off :=
+                 Get_Scope_Offset (Info.Process_Scope, Ghdl_Ptr_Type);
+               Inst := Get_Scope_Type (Info.Process_Scope);
+            when Iir_Kind_Block_Statement =>
+               Kind := Ghdl_Rtik_Block;
+               declare
+                  Guard : constant Iir := Get_Guard_Decl (Blk);
+                  Header : constant Iir := Get_Block_Header (Blk);
+                  Guard_Info : Object_Info_Acc;
+               begin
+                  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;
+                  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_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type);
+               Inst := Get_Scope_Type (Info.Block_Scope);
+            when Iir_Kind_Generate_Statement =>
+               declare
+                  Scheme : constant Iir := Get_Generation_Scheme (Blk);
+                  Scheme_Rti : O_Dnode := O_Dnode_Null;
+               begin
+                  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);
+               Inst := Get_Scope_Type (Info.Block_Scope);
+               Field_Off := New_Offsetof
+                 (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
+                  Info.Block_Parent_Field, Ghdl_Ptr_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_Off = O_Cnode_Null then
+            Field_Off := Get_Null_Loc;
+         end if;
+         New_Record_Aggr_El (List, Field_Off);
+         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 : constant Ortho_Info_Acc := Get_Info (Node);
+         Ref : O_Lnode;
+      begin
+         case Get_Kind (Node) is
+            when Iir_Kind_Component_Declaration =>
+               Ref := Get_Instance_Ref (Node_Info.Comp_Scope);
+            when Iir_Kind_Entity_Declaration
+              | Iir_Kind_Architecture_Body
+              | Iir_Kind_Block_Statement
+              | Iir_Kind_Generate_Statement =>
+               Ref := Get_Instance_Ref (Node_Info.Block_Scope);
+            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 =>
+               Ref := Get_Instance_Ref (Node_Info.Process_Scope);
+            when Iir_Kind_Psl_Assert_Statement
+              | Iir_Kind_Psl_Cover_Statement =>
+               Ref := Get_Instance_Ref (Node_Info.Psl_Scope);
+            when others =>
+               Error_Kind ("get_context_addr", Node);
+         end case;
+         return New_Unchecked_Address (Ref, 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));
+            Chap2.Translate_Package_Body (El);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            New_Debug_Comment_Decl
+              ("package instantiation " & Image_Identifier (El));
+            Chap2.Translate_Package_Instantiation_Declaration (El);
+         when Iir_Kind_Entity_Declaration =>
+            New_Debug_Comment_Decl ("entity " & Image_Identifier (El));
+            Chap1.Translate_Entity_Declaration (El);
+         when Iir_Kind_Architecture_Body =>
+            New_Debug_Comment_Decl ("architecture " & Image_Identifier (El));
+            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");
+      Wki_Val := Get_Identifier ("val");
+      Wki_L_Len := Get_Identifier ("l_len");
+      Wki_R_Len := Get_Identifier ("r_len");
+
+      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, Wki_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, Wki_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_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Val,
+                          Val_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Otype);
+      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, Wki_Val,
+                          Val_Type);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Otype);
+      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, Wki_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, Wki_Val, Val_Type);
+      if Has_Td then
+         New_Interface_Decl
+           (Interfaces, Param, Wki_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, Wki_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;
+
+   --  function __ghdl_std_ulogic_match_NAME (l : __ghdl_e8; r : __ghdl_e8)
+   --    return __ghdl_e8;
+   procedure Create_Std_Ulogic_Match_Subprogram (Name : String;
+                                                 Subprg : out O_Dnode)
+   is
+      Interfaces : O_Inter_List;
+      Param : O_Dnode;
+   begin
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_std_ulogic_match_" & Name),
+         O_Storage_External, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Left, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Right, Ghdl_I32_Type);
+      Finish_Subprogram_Decl (Interfaces, Subprg);
+   end Create_Std_Ulogic_Match_Subprogram;
+
+   --  function __ghdl_std_ulogic_array_match_NAME
+   --    (l : __ghdl_ptr; l_len : ghdl_index_type;
+   --     r : __ghdl_ptr; r_len : ghdl_index_type)
+   --    return __ghdl_i32;
+   procedure Create_Std_Ulogic_Array_Match_Subprogram (Name : String;
+                                                       Subprg : out O_Dnode)
+   is
+      Interfaces : O_Inter_List;
+      Param : O_Dnode;
+   begin
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_std_ulogic_array_match_" & Name),
+         O_Storage_External, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Left, Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_L_Len, Ghdl_Index_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Right, Ghdl_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_R_Len, Ghdl_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Subprg);
+   end Create_Std_Ulogic_Array_Match_Subprogram;
+
+   --  procedure NAME (res : std_string_ptr_node;
+   --                  val : VAL_TYPE;
+   --                  ARG2_NAME : ARG2_TYPE);
+   procedure Create_To_String_Subprogram (Name : String;
+                                          Subprg : out O_Dnode;
+                                          Val_Type : O_Tnode;
+                                          Arg2_Type : O_Tnode := O_Tnode_Null;
+                                          Arg2_Id : O_Ident := O_Ident_Nul;
+                                          Arg3_Type : O_Tnode := O_Tnode_Null;
+                                          Arg3_Id : O_Ident := O_Ident_Nul)
+   is
+      Interfaces : O_Inter_List;
+      Param : O_Dnode;
+   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, Wki_Val, Val_Type);
+      if Arg2_Type /= O_Tnode_Null then
+         New_Interface_Decl
+           (Interfaces, Param, Arg2_Id, Arg2_Type);
+         if Arg3_Type /= O_Tnode_Null then
+            New_Interface_Decl
+              (Interfaces, Param, Arg3_Id, Arg3_Type);
+         end if;
+      end if;
+      Finish_Subprogram_Decl (Interfaces, Subprg);
+   end Create_To_String_Subprogram;
+
+   --  Do internal declarations that need std.standard declarations.
+   procedure Post_Initialize
+   is
+      Interfaces : O_Inter_List;
+      Rec : O_Element_List;
+      Param : O_Dnode;
+      Info : Type_Info_Acc;
+   begin
+      New_Debug_Comment_Decl ("internal declarations, part 2");
+
+      --  Remember some pervasive types.
+      Info := Get_Info (String_Type_Definition);
+      Std_String_Node := Info.Ortho_Type (Mode_Value);
+      Std_String_Ptr_Node := Info.Ortho_Ptr_Type (Mode_Value);
+
+      Std_Integer_Otype :=
+        Get_Ortho_Type (Integer_Type_Definition, Mode_Value);
+      Std_Real_Otype :=
+        Get_Ortho_Type (Real_Type_Definition, Mode_Value);
+      Std_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, Std_Time_Otype);
+
+      --  procedure __ghdl_assert_failed (str : __ghdl_array_template;
+      --                                  severity : ghdl_int);
+      --                                  loc : __ghdl_location_acc);
+
+      --  procedure __ghdl_report (str : __ghdl_array_template;
+      --                                  severity : ghdl_int);
+      --                                  loc : __ghdl_location_acc);
+      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);
+            Finish_Subprogram_Decl (Interfaces, Subprg);
+         end Create_Report_Subprg;
+      begin
+         Create_Report_Subprg
+           ("__ghdl_assert_failed", Ghdl_Assert_Failed);
+         Create_Report_Subprg
+           ("__ghdl_ieee_assert_failed", Ghdl_Ieee_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, Std_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,
+         Std_Real_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("left"),
+                          Std_Real_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("right"),
+                          Std_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,
+         Std_Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Left, Std_Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Exp);
+
+
+      --  procedure __ghdl_image_b1 (res : std_string_ptr_node;
+      --                             val : ghdl_bool_type;
+      --                             rti : ghdl_rti_access);
+      Create_Image_Value_Subprograms
+        ("b1", Ghdl_Bool_Type, True, Ghdl_Image_B1, Ghdl_Value_B1);
+
+      --  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);
+
+      --  procedure __ghdl_file_flush (file : file_index_type);
+      Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_file_flush"),
+                            O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
+                          Ghdl_File_Index_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Flush);
+
+      ---------------
+      --  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"),
+                        Std_Time_Otype);
+      New_Record_Field (Rec, Ghdl_Signal_Last_Active_Field,
+                        Get_Identifier ("last_active"),
+                        Std_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_Otype);
+      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_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Otype);
+      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_Otype);
+      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_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
+                          Std_Time_Otype);
+      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_Otype);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null);
+
+      --  function __ghdl_create_signal_e8 (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_e32 (init_val : ghdl_i32_type)
+      --                                     return __ghdl_signal_ptr;
+      --  procedure __ghdl_signal_simple_assign_e32 (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_b1 (init_val : ghdl_bool_type)
+      --                                    return __ghdl_signal_ptr;
+      --  procedure __ghdl_signal_simple_assign_b1 (sign : __ghdl_signal_ptr;
+      --                                            val : ghdl_bool_type);
+      Create_Signal_Subprograms ("b1", Ghdl_Bool_Type,
+                                 Ghdl_Create_Signal_B1,
+                                 Ghdl_Signal_Init_B1,
+                                 Ghdl_Signal_Simple_Assign_B1,
+                                 Ghdl_Signal_Start_Assign_B1,
+                                 Ghdl_Signal_Next_Assign_B1,
+                                 Ghdl_Signal_Associate_B1,
+                                 Ghdl_Signal_Driving_Value_B1);
+
+      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, Wki_Val, Std_Time_Otype);
+            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, Wki_Val, Std_Time_Otype);
+      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_Otype);
+      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_Otype);
+      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);
+
+      --  Create match subprograms for std_ulogic type.
+      Create_Std_Ulogic_Match_Subprogram ("eq", Ghdl_Std_Ulogic_Match_Eq);
+      Create_Std_Ulogic_Match_Subprogram ("ne", Ghdl_Std_Ulogic_Match_Ne);
+      Create_Std_Ulogic_Match_Subprogram ("lt", Ghdl_Std_Ulogic_Match_Lt);
+      Create_Std_Ulogic_Match_Subprogram ("le", Ghdl_Std_Ulogic_Match_Le);
+
+      Create_Std_Ulogic_Array_Match_Subprogram
+        ("eq", Ghdl_Std_Ulogic_Array_Match_Eq);
+      Create_Std_Ulogic_Array_Match_Subprogram
+        ("ne", Ghdl_Std_Ulogic_Array_Match_Ne);
+
+      --  Create To_String subprograms.
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_i32", Ghdl_To_String_I32, Ghdl_I32_Type);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_f64", Ghdl_To_String_F64, Ghdl_Real_Type);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_f64_digits", Ghdl_To_String_F64_Digits,
+         Ghdl_Real_Type, Ghdl_I32_Type, Get_Identifier ("nbr_digits"));
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_f64_format", Ghdl_To_String_F64_Format,
+         Ghdl_Real_Type, Std_String_Ptr_Node, Get_Identifier ("format"));
+      declare
+         Bv_Base_Ptr : constant O_Tnode :=
+           Get_Info (Bit_Vector_Type_Definition).T.Base_Ptr_Type (Mode_Value);
+      begin
+         Create_To_String_Subprogram
+           ("__ghdl_bv_to_ostring", Ghdl_BV_To_Ostring,
+            Bv_Base_Ptr, Ghdl_Index_Type, Wki_Length);
+         Create_To_String_Subprogram
+           ("__ghdl_bv_to_hstring", Ghdl_BV_To_Hstring,
+            Bv_Base_Ptr, Ghdl_Index_Type, Wki_Length);
+      end;
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_b1", Ghdl_To_String_B1, Ghdl_Bool_Type,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_e8", Ghdl_To_String_E8, Ghdl_I32_Type,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_char", Ghdl_To_String_Char,
+         Get_Ortho_Type (Character_Type_Definition, Mode_Value));
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_e32", Ghdl_To_String_E32, Ghdl_I32_Type,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_p32", Ghdl_To_String_P32, Ghdl_I32_Type,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_to_string_p64", Ghdl_To_String_P64, Ghdl_I64_Type,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_timue_to_string_unit", Ghdl_Time_To_String_Unit,
+         Std_Time_Otype, Std_Time_Otype, Get_Identifier ("unit"),
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_array_char_to_string_b1", Ghdl_Array_Char_To_String_B1,
+         Ghdl_Ptr_Type, Ghdl_Index_Type, Wki_Length,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_array_char_to_string_e8", Ghdl_Array_Char_To_String_E8,
+         Ghdl_Ptr_Type, Ghdl_Index_Type, Wki_Length,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+      Create_To_String_Subprogram
+        ("__ghdl_array_char_to_string_e32", Ghdl_Array_Char_To_String_E32,
+         Ghdl_Ptr_Type, Ghdl_Index_Type, Wki_Length,
+         Rtis.Ghdl_Rti_Access, Wki_Rti);
+
+   end Post_Initialize;
+
+   procedure Translate_Type_Implicit_Subprograms (Decl : in out Iir)
+   is
+      Infos : Chap7.Implicit_Subprogram_Infos;
+   begin
+      --  Skip type declaration.
+      pragma Assert (Get_Kind (Decl) in Iir_Kinds_Type_Declaration);
+      Decl := Get_Chain (Decl);
+
+      Chap7.Init_Implicit_Subprogram_Infos (Infos);
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Implicit_Function_Declaration
+              | Iir_Kind_Implicit_Procedure_Declaration =>
+               Chap7.Translate_Implicit_Subprogram (Decl, Infos);
+               Decl := Get_Chain (Decl);
+            when others =>
+               exit;
+         end case;
+      end loop;
+   end Translate_Type_Implicit_Subprograms;
+
+   procedure Translate_Standard (Main : Boolean)
+   is
+      Lib_Mark, Unit_Mark : Id_Mark_Type;
+      Info : Ortho_Info_Acc;
+      pragma Unreferenced (Info);
+      Decl : Iir;
+      Time_Type_Staticness : Iir_Staticness;
+      Time_Subtype_Staticness : Iir_Staticness;
+   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));
+
+      --  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.
+      Time_Type_Staticness := Get_Type_Staticness (Time_Type_Definition);
+      Time_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);
+      if Flags.Vhdl_Std > Vhdl_87 then
+         Set_Type_Staticness (Delay_Length_Subtype_Definition, Locally);
+      end if;
+
+      Decl := Get_Declaration_Chain (Standard_Package);
+
+      --  The first (and one of the most important) declaration is the
+      --  boolean type declaration.
+      pragma Assert (Decl = Boolean_Type_Declaration);
+      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);
+      Translate_Type_Implicit_Subprograms (Decl);
+
+      --  Second declaration: bit.
+      pragma Assert (Decl = Bit_Type_Declaration);
+      Chap4.Translate_Bool_Type_Declaration (Bit_Type_Declaration);
+      Translate_Type_Implicit_Subprograms (Decl);
+
+      --  Nothing special for other declarations.
+      while Decl /= Null_Iir loop
+         case Get_Kind (Decl) is
+            when Iir_Kind_Type_Declaration =>
+               Chap4.Translate_Type_Declaration (Decl);
+               Translate_Type_Implicit_Subprograms (Decl);
+            when Iir_Kind_Anonymous_Type_Declaration =>
+               Chap4.Translate_Anonymous_Type_Declaration (Decl);
+               Translate_Type_Implicit_Subprograms (Decl);
+            when Iir_Kind_Subtype_Declaration =>
+               Chap4.Translate_Subtype_Declaration (Decl);
+               Decl := Get_Chain (Decl);
+            when Iir_Kind_Attribute_Declaration =>
+               Decl := Get_Chain (Decl);
+            when Iir_Kind_Implicit_Function_Declaration =>
+               case Get_Implicit_Definition (Decl) is
+                  when Iir_Predefined_Now_Function =>
+                     null;
+                  when Iir_Predefined_Enum_To_String
+                    | Iir_Predefined_Integer_To_String
+                    | Iir_Predefined_Floating_To_String
+                    | Iir_Predefined_Real_To_String_Digits
+                    | Iir_Predefined_Real_To_String_Format
+                    | Iir_Predefined_Physical_To_String
+                    | Iir_Predefined_Time_To_String_Unit =>
+                     --  These are defined after the types.
+                     null;
+                  when others =>
+                     Error_Kind
+                       ("translate_standard ("
+                          & Iir_Predefined_Functions'Image
+                          (Get_Implicit_Definition (Decl)) & ")",
+                        Decl);
+               end case;
+               Decl := Get_Chain (Decl);
+            when others =>
+               Error_Kind ("translate_standard", Decl);
+         end case;
+         --  DECL was updated by Translate_Type_Implicit_Subprograms or
+         --  explicitly in other branches.
+      end loop;
+
+      --  These types don't appear in std.standard.
+      Chap4.Translate_Anonymous_Type_Declaration
+        (Convertible_Integer_Type_Declaration);
+      Chap4.Translate_Anonymous_Type_Declaration
+        (Convertible_Real_Type_Declaration);
+
+      --  Restore time type staticness.
+
+      if Flags.Vhdl_Std > Vhdl_87 then
+         Set_Type_Staticness (Delay_Length_Subtype_Definition,
+                              Time_Subtype_Staticness);
+      end if;
+      Set_Type_Staticness (Time_Type_Definition, Time_Type_Staticness);
+      Set_Type_Staticness (Time_Subtype_Definition, Time_Subtype_Staticness);
+
+      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);
+               when Iir_Kind_Array_Subtype_Definition =>
+                  if Get_Index_Constraint_Flag (I) then
+                     Info.T := Ortho_Info_Type_Array_Init;
+                     Free_Type_Info (Info);
+                  end if;
+               when Iir_Kind_Implicit_Function_Declaration =>
+                  case Get_Implicit_Definition (I) is
+                     when Iir_Predefined_Bit_Array_Match_Equality
+                       |  Iir_Predefined_Bit_Array_Match_Inequality =>
+                        --  Not in sequence.
+                        null;
+                     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;
+               when others =>
+                  --  By default, info are not shared.
+                  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 (Get_Scope_Size (Arch_Info.Block_Scope)),
+                       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
+         Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, 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);
+         Clear_Scope (Entity_Info.Block_Scope);
+         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, Get_Scope_Size (Arch_Info.Block_Scope));
+
+         --  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);
+               --  There cannot be remaining checks to do.
+               pragma Assert
+                 (Get_Analysis_Checks_List (Unit) = Null_Iir_List);
+            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
+                 | Iir_Kind_Package_Instantiation_Declaration =>
+                  --  For package spec, mark it as 'body is not present', this
+                  --  flag will be set below when the body is translated.
+                  Set_Elab_Flag (Unit, False);
+                  Translate (Unit, Whole);
+               when Iir_Kind_Package_Body =>
+                  --  Mark the spec with 'body is present' flag.
+                  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
+                 | Iir_Kind_Package_Instantiation_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;
diff --git a/src/translate/translation.ads b/src/translate/translation.ads
new file mode 100644
index 000000000..e779685f2
--- /dev/null
+++ b/src/translate/translation.ads
@@ -0,0 +1,120 @@
+--  Iir to ortho translator.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 Iirs; use Iirs;
+with Ortho_Nodes;
+
+package Translation is
+   --  Initialize the package: create internal nodes.
+   procedure Initialize;
+
+   --  Translate (generate code) for design unit UNIT.
+   --  If MAIN is true, the unit is really the unit being compiled (not an
+   --  external unit).  Code shouldn't be generated for external units.
+   procedure Translate (Unit : Iir_Design_Unit; Main : Boolean);
+
+   --  Translate std.standard.
+   procedure Translate_Standard (Main : Boolean);
+
+   --  Get the ortho node for subprogram declaration DECL.
+   function Get_Ortho_Decl (Subprg : Iir) return Ortho_Nodes.O_Dnode;
+
+   --  Get the internal _RESOLV function for FUNC.
+   function Get_Resolv_Ortho_Decl (Func : Iir) return Ortho_Nodes.O_Dnode;
+
+   procedure Finalize;
+
+   package Chap12 is
+      --  Primary unit + secondary unit (architecture name which may be null)
+      --  to elaborate.
+      procedure Elaborate (Primary : String;
+                           Secondary : String;
+                           Filelist : String;
+                           Whole : Boolean);
+   end Chap12;
+
+   --  If set, generate Run-Time Information nodes.
+   Flag_Rti : Boolean := True;
+
+   --  If set, do not generate 64 bits integer types and operations.
+   Flag_Only_32b : Boolean := False;
+
+   --  If set, do not generate code for unused subprograms.
+   --  Be careful: unless you are in whole compilation mode, this
+   --  flag shouldn't be set for packages and entities.
+   Flag_Discard_Unused : Boolean := False;
+
+   --  If set, do not generate code for unused implicit subprograms.
+   Flag_Discard_Unused_Implicit : Boolean := False;
+
+   --  If set, dump drivers per process during compilation.
+   Flag_Dump_Drivers : Boolean := False;
+
+   --  If set, try to create direct drivers.
+   Flag_Direct_Drivers : Boolean := True;
+
+   --  If set, checks ranges (subtype ranges).
+   Flag_Range_Checks : Boolean := True;
+
+   --  If set, checks indexes (arrays index and slice).
+   Flag_Index_Checks : Boolean := True;
+
+   --  If set, do not create identifiers (for in memory compilation).
+   Flag_Discard_Identifiers : Boolean := False;
+
+   --  If true, do not create nested subprograms.
+   --  This flag is forced during initialization if the code generated doesn't
+   --  support nested subprograms.
+   Flag_Unnest_Subprograms : Boolean := False;
+
+   type Foreign_Kind_Type is (Foreign_Unknown,
+                              Foreign_Vhpidirect,
+                              Foreign_Intrinsic);
+
+   type Foreign_Info_Type (Kind : Foreign_Kind_Type := Foreign_Unknown)
+   is record
+      case Kind is
+         when Foreign_Unknown =>
+            null;
+         when Foreign_Vhpidirect =>
+            --  Positions in name_table.name_buffer.
+            Lib_First : Natural;
+            Lib_Last : Natural;
+            Subprg_First : Natural;
+            Subprg_Last : Natural;
+         when Foreign_Intrinsic =>
+            null;
+      end case;
+   end record;
+
+   Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown);
+
+   --  Return a foreign_info for DECL.
+   --  Can generate error messages, if the attribute expression is ill-formed.
+   --  If EXTRACT_NAME is set, internal fields of foreign_info are set.
+   --  Otherwise, only KIND discriminent is set.
+   --  EXTRACT_NAME should be set only inside translation itself, since the
+   --  name can be based on the prefix.
+   function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type;
+
+   --  If not null, this procedure is called when a foreign subprogram is
+   --  created.
+   type Foreign_Hook_Access is access procedure (Decl : Iir;
+                                                 Info : Foreign_Info_Type;
+                                                 Ortho : Ortho_Nodes.O_Dnode);
+   Foreign_Hook : Foreign_Hook_Access := null;
+end Translation;
diff --git a/src/types.ads b/src/types.ads
new file mode 100644
index 000000000..4775484ff
--- /dev/null
+++ b/src/types.ads
@@ -0,0 +1,127 @@
+--  Common types.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces;
+
+package Types is
+   pragma Preelaborate (Types);
+
+   -- A tri state type.
+   type Tri_State_Type is (Unknown, False, True);
+
+   --  32 bits integer.
+   type Int32 is range -2**31 .. 2**31 - 1;
+   for Int32'Size use 32;
+
+   subtype Nat32 is Int32 range 0 .. Int32'Last;
+   subtype Pos32 is Nat32 range 1 .. Nat32'Last;
+
+   type Uns32 is new Interfaces.Unsigned_32;
+
+   type Fp64 is new Interfaces.IEEE_Float_64;
+
+   -- iir_int32 is aimed at containing integer literal values.
+   type Iir_Int32 is new Interfaces.Integer_32;
+
+   -- iir_int64 is aimed at containing units values.
+   type Iir_Int64 is new Interfaces.Integer_64;
+
+   -- iir_fp32 is aimed at containing floating point values.
+   type Iir_Fp32 is new Interfaces.IEEE_Float_32;
+
+   -- iir_fp64 is aimed at containing floating point values.
+   subtype Iir_Fp64 is Fp64;
+
+   --  iir_index32 is aimed at containing an array index.
+   type Iir_Index32 is new Nat32;
+
+   -- Useful type.
+   type String_Acc is access String;
+   type String_Cst is access constant String;
+   type String_Acc_Array is array (Natural range <>) of String_Acc;
+
+   type String_Fat is array (Pos32) of Character;
+   type String_Fat_Acc is access String_Fat;
+
+   -- Type of a name table element.
+   -- The name table is defined in the name_table package.
+   type Name_Id is new Nat32;
+
+   -- null entry in the name table.
+   -- It is sure that this entry is never allocated.
+   Null_Identifier: constant Name_Id := 0;
+
+   --  Type of a string stored into the string table.
+   type String_Id is new Nat32;
+   for String_Id'Size use 32;
+
+   Null_String : constant String_Id := 0;
+
+   -- Index type is the source file table.
+   -- This table is defined in the files_map package.
+   type Source_File_Entry is new Nat32;
+   No_Source_File_Entry: constant Source_File_Entry := 0;
+
+   --  FIXME: additional source file entries to create:
+   --  *std.standard*: for those created in std.standard
+   --  *error*: for erroneous one
+   --  *command-line*: used for identifiers from command line
+   --    (eg: unit to elab)
+
+   -- Index into a file buffer.
+   type Source_Ptr is new Int32;
+
+   --  Lower boundary of any file buffer.
+   Source_Ptr_Org : constant Source_Ptr := 0;
+
+   --  Bad file buffer index (used to mark no line).
+   Source_Ptr_Bad : constant Source_Ptr := -1;
+
+   -- This type contains everything necessary to get a file name, a line
+   -- number and a column number.
+   type Location_Type is new Nat32;
+   for Location_Type'Size use 32;
+   Location_Nil : constant Location_Type := 0;
+
+   -- Type of a file buffer.
+   type File_Buffer is array (Source_Ptr range <>) of Character;
+   type File_Buffer_Acc is access File_Buffer;
+
+   --  PSL Node.
+   type PSL_Node is new Int32;
+
+   --  PSL NFA
+   type PSL_NFA is new Int32;
+
+   -- Indentation.
+   -- This is used by all packages that display vhdl code or informations.
+   Indentation : constant := 2;
+
+   --  String representing a date/time (format is YYYYMMDDHHmmSS.sss).
+   subtype Time_Stamp_String is String (1 .. 18);
+   type Time_Stamp_Id is new String_Id;
+   Null_Time_Stamp : constant Time_Stamp_Id := 0;
+
+   --  Self-explaining: raised when an internal error (such as consistency)
+   --  is detected.
+   Internal_Error: exception;
+
+   --  In some case, a low level subprogram can't handle error
+   --  (e.g eval_pos).  In this case it is easier to raise an exception and
+   --  let upper level subprograms handle the case.
+   Node_Error : exception;
+end Types;
diff --git a/src/version.ads b/src/version.ads
new file mode 100644
index 000000000..11b2a0b72
--- /dev/null
+++ b/src/version.ads
@@ -0,0 +1,5 @@
+package Version is
+   Ghdl_Release : constant String :=
+      "GHDL 0.33dev (20141104) [Dunoon edition]";
+   Ghdl_Ver : constant String := "0.33dev";
+end Version;
diff --git a/src/xrefs.adb b/src/xrefs.adb
new file mode 100644
index 000000000..15696696b
--- /dev/null
+++ b/src/xrefs.adb
@@ -0,0 +1,279 @@
+--  Cross references.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with GNAT.Table;
+with GNAT.Heap_Sort_A;
+with Flags;
+with Std_Package;
+with Errorout; use Errorout;
+with Nodes;
+
+package body Xrefs is
+   type Xref_Type is record
+      --  Where the cross-reference (or the name) appears.
+      Loc : Location_Type;
+
+      --  What the name refer to.
+      Ref : Iir;
+
+      --  Kind of reference (See package specification).
+      Kind : Xref_Kind;
+   end record;
+
+   package Xref_Table is new GNAT.Table
+     (Table_Index_Type => Natural,
+      Table_Component_Type => Xref_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Xref_Location (N : Xref) return Location_Type is
+   begin
+      return Xref_Table.Table (N).Loc;
+   end Get_Xref_Location;
+
+   function Get_Xref_Kind (N : Xref) return Xref_Kind is
+   begin
+      return Xref_Table.Table (N).Kind;
+   end Get_Xref_Kind;
+
+   function Get_Xref_Node (N : Xref) return Iir is
+   begin
+      return Xref_Table.Table (N).Ref;
+   end Get_Xref_Node;
+
+   function Get_Last_Xref return Xref is
+   begin
+      return Xref_Table.Last;
+   end Get_Last_Xref;
+
+   procedure Init is
+   begin
+      Xref_Table.Set_Last (Bad_Xref);
+   end Init;
+
+   procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind) is
+   begin
+      --  Check there is no xref for the same location to the same reference.
+      --  (Note that a designatore may reference several declarations, this
+      --   is possible in attribute specification for an overloadable name).
+      --  This is a simple heuristic as this catch only two referenced in the
+      --  row but efficient and should be enough to catch errors.
+      pragma Assert
+        (Xref_Table.Last < Xref_Table.First
+           or else Xref_Table.Table (Xref_Table.Last).Loc /= Loc
+           or else Xref_Table.Table (Xref_Table.Last).Ref /= Ref);
+
+      Xref_Table.Append (Xref_Type'(Loc => Loc,
+                                    Ref => Ref,
+                                    Kind => Kind));
+   end Add_Xref;
+
+   procedure Xref_Decl (Decl : Iir) is
+   begin
+      if Flags.Flag_Xref then
+         Add_Xref (Get_Location (Decl), Decl, Xref_Decl);
+      end if;
+   end Xref_Decl;
+
+   procedure Xref_Ref (Name : Iir; Decl : Iir) is
+   begin
+      if Flags.Flag_Xref then
+         Add_Xref (Get_Location (Name), Decl, Xref_Ref);
+      end if;
+   end Xref_Ref;
+
+   procedure Xref_Body (Bod : Iir; Spec : Iir) is
+   begin
+      if Flags.Flag_Xref then
+         Add_Xref (Get_Location (Bod), Spec, Xref_Body);
+      end if;
+   end Xref_Body;
+
+   procedure Xref_End (Loc : Location_Type; Decl : Iir) is
+   begin
+      if Flags.Flag_Xref then
+         Add_Xref (Loc, Decl, Xref_End);
+      end if;
+   end Xref_End;
+
+   procedure Xref_Name_1 (Name : Iir) is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Character_Literal =>
+            declare
+               Res : constant Iir := Get_Named_Entity (Name);
+            begin
+               if Res = Std_Package.Error_Mark then
+                  return;
+               end if;
+               Add_Xref (Get_Location (Name), Res, Xref_Ref);
+            end;
+         when Iir_Kind_Selected_Element =>
+            Add_Xref (Get_Location (Name),
+                      Get_Selected_Element (Name), Xref_Ref);
+         when Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Function_Call =>
+            null;
+         when Iir_Kinds_Attribute =>
+            null;
+         when Iir_Kind_Attribute_Name =>
+            --  FIXME: user defined attributes.
+            null;
+         when Iir_Kind_Type_Conversion =>
+            return;
+         when others =>
+            Error_Kind ("xref_name_1", Name);
+      end case;
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Operator_Symbol
+           | Iir_Kind_Character_Literal =>
+            null;
+         when Iir_Kind_Selected_Name
+           | Iir_Kind_Selected_Element
+           | Iir_Kind_Attribute_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Indexed_Name
+           | Iir_Kind_Dereference
+           | Iir_Kind_Implicit_Dereference
+           | Iir_Kinds_Attribute
+           | Iir_Kind_Function_Call =>
+            Xref_Name_1 (Get_Prefix (Name));
+         when others =>
+            Error_Kind ("xref_name_1", Name);
+      end case;
+   end Xref_Name_1;
+
+   procedure Xref_Name (Name : Iir) is
+   begin
+      if Flags.Flag_Xref and Name /= Null_Iir then
+         Xref_Name_1 (Name);
+      end if;
+   end Xref_Name;
+
+   procedure Move (From : Natural; To : Natural)
+   is
+      Tmp : Xref_Type;
+   begin
+      Tmp := Xref_Table.Table (To);
+      Xref_Table.Table (To) := Xref_Table.Table (From);
+      Xref_Table.Table (From) := Tmp;
+   end Move;
+
+   function Loc_Lt (Op1, Op2 : Natural) return Boolean
+   is
+      L1 : constant Location_Type := Xref_Table.Table (Op1).Loc;
+      L2 : constant Location_Type := Xref_Table.Table (Op2).Loc;
+   begin
+      return L1 < L2;
+   end Loc_Lt;
+
+   procedure Sort_By_Location is
+   begin
+      GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Loc_Lt'Access);
+   end Sort_By_Location;
+
+   --  Sorting function by ref field.
+   --  If ref fields are the same, then compare by location.
+   function Node_Lt (Op1, Op2 : Natural) return Boolean
+   is
+      L1, L2 : Location_Type;
+      N1, N2 : Iir;
+      K1, K2 : Xref_Kind;
+   begin
+      L1 := Get_Location (Get_Xref_Node (Op1));
+      L2 := Get_Location (Get_Xref_Node (Op2));
+
+      if L1 /= L2 then
+         return L1 < L2;
+      end if;
+
+      --  L1 = L2.
+      --  Note: nodes of std_standard have the same location.  FIXME ?
+      N1 := Get_Xref_Node (Op1);
+      N2 := Get_Xref_Node (Op2);
+      if Iirs."/=" (N1, N2) then
+         return Nodes."<" (N1, N2);
+      end if;
+
+      --  Try to get declaration first.
+      K1 := Get_Xref_Kind (Op1);
+      K2 := Get_Xref_Kind (Op2);
+      if K1 /= K2 then
+         return K1 < K2;
+      end if;
+      L1 := Get_Xref_Location (Op1);
+      L2 := Get_Xref_Location (Op2);
+      return L1 < L2;
+   end Node_Lt;
+
+   procedure Sort_By_Node_Location is
+   begin
+      GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Node_Lt'Access);
+   end Sort_By_Node_Location;
+
+   function Find (Loc : Location_Type) return Xref
+   is
+      Low : Xref;
+      High : Xref;
+      Mid : Xref;
+      Mid_Loc : Location_Type;
+   begin
+      Low := First_Xref;
+      High := Xref_Table.Last;
+      loop
+         Mid := (Low + High + 1) / 2;
+         Mid_Loc := Xref_Table.Table (Mid).Loc;
+         if Loc = Mid_Loc then
+            return Mid;
+         end if;
+         if Mid = Low then
+            return Bad_Xref;
+         end if;
+         if Loc > Mid_Loc then
+            Low := Mid + 1;
+         else
+            High := Mid - 1;
+         end if;
+      end loop;
+   end Find;
+
+   procedure Fix_End_Xrefs
+   is
+      N : Iir;
+   begin
+      for I in First_Xref .. Get_Last_Xref loop
+         if Get_Xref_Kind (I) = Xref_End then
+            N := Get_Xref_Node (I);
+            case Get_Kind (N) is
+               when Iir_Kind_Function_Body
+                 | Iir_Kind_Procedure_Body =>
+                  Xref_Table.Table (I).Ref := Get_Subprogram_Specification (N);
+               when others =>
+                  null;
+            end case;
+         end if;
+      end loop;
+   end Fix_End_Xrefs;
+end Xrefs;
diff --git a/src/xrefs.ads b/src/xrefs.ads
new file mode 100644
index 000000000..74f2d0c7e
--- /dev/null
+++ b/src/xrefs.ads
@@ -0,0 +1,108 @@
+--  Cross references.
+--  Copyright (C) 2002, 2003, 2004, 2005 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Types; use Types;
+with Iirs; use Iirs;
+
+package Xrefs is
+   type Xref_Kind is
+     (
+      --  Declaration of an identifier.
+      Xref_Decl,
+
+      --  Use of a named entity.
+      Xref_Ref,
+
+      --  Identifier after the 'end' keyword.
+      Xref_End,
+
+      --  Body of a declaration (for package, subprograms or protected type).
+      Xref_Body
+     );
+
+   --  Initialize the xref table.
+   --  Must be called once.
+   procedure Init;
+
+   --  Low level xref addition.
+   --  An entity at LOC references REF with the KIND way.
+   procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind);
+
+   --  Add a declaration of an identifier.
+   --  This is somewhat a self-reference.
+   procedure Xref_Decl (Decl : Iir);
+   pragma Inline (Xref_Decl);
+
+   --  NAME refers to DECL.
+   procedure Xref_Ref (Name : Iir; Decl : Iir);
+   pragma Inline (Xref_Ref);
+
+   --  BODy refers to SPEC.
+   procedure Xref_Body (Bod : Iir; Spec : Iir);
+   pragma Inline (Xref_Body);
+
+   --  Just resolved NAME refers to its named entity.
+   procedure Xref_Name (Name : Iir);
+   pragma Inline (Xref_Name);
+
+   --  LOC is the location of the simple_name after 'end' for DECL.
+   procedure Xref_End (Loc : Location_Type; Decl : Iir);
+   pragma Inline (Xref_End);
+
+   --  Sort the xref table by location.  This is required before searching with
+   --  Find.
+   procedure Sort_By_Location;
+
+   --  Sort the xref table by location of the nodes.
+   procedure Sort_By_Node_Location;
+
+   subtype Xref is Natural;
+
+   --  A bad xref.
+   --  May be returned by Find.
+   Bad_Xref : constant Xref := 0;
+
+   --  First xref.
+   --  May be used to size a table.
+   First_Xref : constant Xref := 1;
+
+   --  Find a reference by location.
+   --  The table must already be sorted with Sort_By_Location.
+   --  Returns BAD_REF is does not exist.
+   function Find (Loc : Location_Type) return Xref;
+
+   --  End_Xrefs are added by parse and points to the subprogram_body.
+   --  This procedure make them points to the subprogram_decl node.
+   --  This is done so that every node has a name.
+   procedure Fix_End_Xrefs;
+
+   --  Get the last possible xref available.
+   --  May be used to size tables.
+   function Get_Last_Xref return Xref;
+
+   --  Get the location of N, ie where a name (or operator) appears.
+   function Get_Xref_Location (N : Xref) return Location_Type;
+   pragma Inline (Get_Xref_Location);
+
+   --  Get the kind of cross-reference.
+   function Get_Xref_Kind (N : Xref) return Xref_Kind;
+   pragma Inline (Get_Xref_Kind);
+
+   --  Get the node referenced by the name.
+   function Get_Xref_Node (N : Xref) return Iir;
+   pragma Inline (Get_Xref_Node);
+end Xrefs;
diff --git a/src/xtools/Makefile b/src/xtools/Makefile
new file mode 100644
index 000000000..6504fbc84
--- /dev/null
+++ b/src/xtools/Makefile
@@ -0,0 +1,35 @@
+#  Copyright (C) 2002, 2003, 2004, 2005 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.
+
+DEPS=../iirs.ads ../nodes.ads ./pnodes.py
+
+all: ../iirs.adb ../nodes_meta.ads ../nodes_meta.adb
+
+../iirs.adb: ../iirs.adb.in $(DEPS)
+	$(RM) $@
+	./pnodes.py body > $@
+	chmod -w $@
+
+../nodes_meta.ads: ../nodes_meta.ads.in $(DEPS)
+	$(RM) $@
+	./pnodes.py meta_specs > $@
+	chmod -w $@
+
+../nodes_meta.adb: ../nodes_meta.adb.in $(DEPS)
+	$(RM) $@
+	./pnodes.py meta_body > $@
+	chmod -w $@
diff --git a/src/xtools/pnodes.py b/src/xtools/pnodes.py
new file mode 100755
index 000000000..364f1254e
--- /dev/null
+++ b/src/xtools/pnodes.py
@@ -0,0 +1,716 @@
+#!/usr/bin/env python
+
+import re
+import sys
+import argparse
+
+field_file = "../nodes.ads"
+spec_file = "../iirs.ads"
+template_file = "../iirs.adb.in"
+meta_base_file = "../nodes_meta"
+prefix_name = "Iir_Kind_"
+prefix_range_name = "Iir_Kinds_"
+type_name = "Iir_Kind"
+conversions = ['uc', 'pos']
+
+class FuncDesc:
+    def __init__(self, name, field, conv, acc,
+                 pname, ptype, rname, rtype):
+        self.name = name
+        self.field = field
+        self.conv = conv
+        self.acc = acc  # access: Chain, Chain_Next, Ref, Of_Ref, Maybe_Ref
+        self.pname = pname # Parameter mame
+        self.ptype = ptype # Parameter type
+        self.rname = rname # value name (for procedure)
+        self.rtype = rtype # value type
+
+class NodeDesc:
+    def __init__(self, name, format, fields, attrs):
+        self.name = name
+        self.format = format
+        self.fields = fields # {field: FuncDesc} dict, defined for all fields
+        self.attrs = attrs # A {attr: FuncDesc} dict
+
+class line:
+    def __init__(self, string, no):
+        self.l = string
+        self.n = no
+
+class EndOfFile(Exception):
+    def __init__(self,filename):
+        self.filename = filename
+
+    def __str__(self):
+        return "end of file " + self.filename
+
+class linereader:
+    def __init__(self, filename):
+        self.filename = filename
+        self.f = open (filename)
+        self.lineno = 0
+        self.l = ''
+
+    def get(self):
+        self.l = self.f.readline()
+        if not self.l:
+            raise EndOfFile(self.filename)
+        self.lineno = self.lineno + 1
+        return self.l
+
+class ParseError(Exception):
+    def __init__(self, lr, msg):
+        self.lr = lr;
+        self.msg = msg
+
+    def __str__(self):
+        return 'Error: ' + self.msg
+        return 'Parse error at ' + self.lr.filname + ':' + self.lr.lineno + \
+               ': ' + self.msg
+
+# Return fields description.
+# This is a dictionary.  The keys represent the possible format of a node.
+# The values are dictionnaries representing fields.  Keys are fields name, and
+# values are fields type.
+def read_fields(file):
+    fields = {}
+    formats = []
+    lr = linereader(file)
+
+    #  Search for 'type Format_Type is'
+    while lr.get() != '   type Format_Type is\n':
+        pass
+
+    # Skip '('
+    if lr.get() != '     (\n':
+        raise 'no open parenthesis after Format_Type';
+
+    # Read formats
+    l = lr.get()
+    pat_field_name = re.compile('      Format_(\w+),?\n')
+    while l != '     );\n':
+        m = pat_field_name.match(l)
+        if m == None:
+            print l
+            raise 'bad literal within Format_Type'
+        name = m.group(1)
+        formats.append(name)
+        fields[name] = {}
+        l = lr.get()
+
+    # Read fields
+    l = lr.get()
+    pat_fields = re.compile('   -- Fields of Format_(\w+):\n')
+    pat_field_desc = re.compile('   --   (\w+) : (\w+).*\n')
+    format_name = ''
+    common_desc = {}
+
+    # Read until common fields.
+    while l != '   -- Common fields are:\n':
+        l = lr.get()
+    format_name = 'Common'
+    nbr_formats = 0
+
+    while True:
+        # 1) Read field description
+        l = lr.get()
+        desc = common_desc.copy()
+        while True:
+            m = pat_field_desc.match(l)
+            if m == None:
+                break
+            desc[m.group(1)] = m.group(2)
+            l = lr.get()
+            # print 'For: ' + format_name + ': ' + m.group(1)
+
+        # 2) Disp
+        if format_name == 'Common':
+            common_desc = desc
+        else:
+            fields[format_name] = desc
+
+        # 3) Read next format
+        if l == '\n':
+            if nbr_formats == len(fields):
+                break
+            else:
+                l = lr.get()
+
+        # One for a format
+        m = pat_fields.match(l)
+        if m != None:
+            format_name = m.group(1)
+            if not format_name in fields:
+                raise ParseError(
+                    lr, 'Format ' + format_name + ' is unknown')
+            nbr_formats = nbr_formats + 1
+        else:
+            raise ParseError(lr, 'unhandled format line')
+
+    return (formats, fields)
+
+# Read kinds, kinds ranges and methods
+def read_kinds(filename):
+    lr = linereader(filename)
+    kinds = []
+    #  Search for 'type Iir_Kind is'
+    while lr.get() != '   type ' + type_name + ' is\n':
+        pass
+    # Skip '('
+    if lr.get() != '      (\n':
+        raise ParseError(lr,
+                         'no open parenthesis after "type ' + type_name +'"')
+
+    # Read literals
+    pat_node = re.compile('       ' + prefix_name + '(\w+),?( +-- .*)?\n')
+    pat_comment = re.compile('( +-- .*)?\n')
+    while True:
+        l = lr.get()
+        if l == '      );\n':
+            break
+        m = pat_node.match(l)
+        if m:
+            kinds.append(m.group(1))
+            continue
+        m = pat_comment.match(l)
+        if not m:
+            raise ParseError(lr, 'Unknow line within kind declaration')
+
+    # Check subtypes
+    pat_subtype = re.compile('   subtype ' + prefix_range_name \
+                             + '(\w+) is ' + type_name + ' range\n')
+    pat_first = re.compile('     ' + prefix_name + '(\w+) ..\n')
+    pat_last = re.compile('     ' + prefix_name + '(\w+);\n')
+    pat_middle = re.compile('   --' + prefix_name + '(\w+)\n')
+    kinds_ranges={}
+    while True:
+        l = lr.get()
+        # Start of methods is also end of subtypes.
+        if l == '   -- General methods.\n':
+            break
+        # Found a subtype.
+        m = pat_subtype.match(l)
+        if m:
+            # Check first bound
+            name = m.group(1)
+            l = lr.get()
+            mf = pat_first.match(l)
+            if not mf:
+                raise ParseError(lr, 'badly formated first bound of subtype')
+            first = kinds.index(mf.group(1))
+            idx = first
+            has_middle = None
+            # Read until last bound
+            while True:
+                l = lr.get()
+                ml = pat_middle.match(l)
+                if ml:
+                    # Check element in the middle
+                    if kinds.index(ml.group(1)) != idx + 1:
+                        raise ParseError(lr,
+                            "missing " + kinds[idx] + " in subtype")
+                    has_middle = True
+                    idx = idx + 1
+                else:
+                    # Check last bound
+                    ml = pat_last.match(l)
+                    if ml:
+                        last = kinds.index(ml.group(1))
+                        if last != idx + 1 and has_middle:
+                            raise ParseError(lr,
+                                "missing " + kinds[idx] + " in subtype")
+                        break
+                    raise ParseError(lr,
+                                     "unhandled line in subtype")
+            kinds_ranges[name] = kinds[first:last+1]
+
+    # Read functions
+    funcs = []
+    pat_field = re.compile(
+        '   --  Field: (\w+)'
+        + '( Of_Ref| Ref| Maybe_Ref| Chain_Next| Chain)?( .*)?\n')
+    pat_conv = re.compile('^ \((\w+)\)$')
+    pat_func = \
+      re.compile('   function Get_(\w+) \((\w+) : (\w+)\) return (\w+);\n')
+    pat_proc = \
+      re.compile('   procedure Set_(\w+) \((\w+) : (\w+); (\w+) : (\w+)\);\n')
+    while True:
+        l = lr.get()
+        if l == 'end Iirs;\n':
+            break
+        m = pat_field.match(l)
+        if m:
+            # Extract conversion
+            acc = m.group(2)
+            if acc:
+                acc = acc.strip()
+            conv = m.group(3)
+            if conv:
+                mc = pat_conv.match(conv)
+                if not mc:
+                    raise ParseError(lr, 'conversion ill formed')
+                conv = mc.group(1)
+                if conv not in conversions:
+                    raise ParseError(lr, 'unknown conversion ' + conv)
+            else:
+                conv = None
+
+            # Read function
+            l = lr.get()
+            mf = pat_func.match(l)
+            if not mf:
+                raise ParseError(lr,
+                        'function declaration expected after Field')
+            # Read procedure
+            l = lr.get()
+            mp = pat_proc.match(l)
+            if not mp:
+                raise ParseError(lr,
+                        'procedure declaration expected after function')
+            # Consistency check between function and procedure
+            if mf.group(1) != mp.group(1):
+                raise ParseError(lr, 'function and procedure name mismatch')
+            if mf.group(2) != mp.group(2):
+                raise ParseError(lr, 'parameter name mismatch with function')
+            if mf.group(3) != mp.group(3):
+                raise ParseError(lr, 'parameter type mismatch with function')
+            if mf.group(4) != mp.group(5):
+                raise ParseError(lr, 'result type mismatch with function')
+            funcs.append(FuncDesc(mf.group(1), m.group(1), conv, acc,
+                                  mp.group(2), mp.group(3),
+                                  mp.group(4), mp.group(5)))
+
+    return (kinds, kinds_ranges, funcs)
+
+# Read description for one node
+def read_nodes_fields(lr, names, fields, nodes, funcs_dict):
+    pat_only = re.compile('   -- Only for ' + prefix_name + '(\w+):\n')
+    pat_field = re.compile('   --   Get/Set_(\w+) \((Alias )?(\w+)\)\n')
+    pat_comment = re.compile('   --.*\n')
+    pat_start = re.compile ('   --   \w.*\n')
+
+    # Create nodes
+    cur_nodes = []
+    for (nm, fmt) in names:
+        if fmt not in fields:
+            raise ParseError(lr, 'unknown format')
+        n = NodeDesc(nm, fmt, {x: None for x in fields[fmt]}, {})
+        nodes[nm] = n
+        cur_nodes.append(n)
+
+    # Look for fields
+    only_nodes = cur_nodes
+    l = lr.l
+    while l != '\n':
+        # Handle 'Only ...'
+        while True:
+            m = pat_only.match(l)
+            if not m:
+                break
+            name = m.group(1)
+            if name not in [x.name for x in cur_nodes]:
+                raise ParseError(lr, 'node not currently described')
+            if only_nodes == cur_nodes:
+                only_nodes = []
+            only_nodes.append(nodes[name])
+            l = lr.get()
+        # Handle field
+        m = pat_field.match(l)
+        if m:
+            # 1) Check the function exists
+            func = m.group(1)
+            alias = m.group(2)
+            field = m.group(3)
+            if func not in funcs_dict:
+                raise ParseError(lr, 'unknown function')
+            func = funcs_dict[func]
+            if func.field != field:
+                raise ParseError(lr, 'field mismatch')
+            for c in only_nodes:
+                if field not in c.fields:
+                    raise ParseError(lr, 'field ' + field + \
+                                     ' does not exist in node')
+                if not alias:
+                    if c.fields[field]:
+                        raise ParseError(lr, 'field already used')
+                    c.fields[field] = func
+                c.attrs[func.name] = func
+            only_nodes = cur_nodes
+        elif pat_start.match(l):
+            raise ParseError(lr, 'bad line in node description')
+        elif not pat_comment.match(l):
+            raise ParseError(lr, 'bad line in node description')
+        l = lr.get()
+
+# Read description for all nodes
+def read_nodes(filename, kinds, kinds_ranges, fields, funcs):
+    lr = linereader(filename)
+    funcs_dict = {x.name:x for x in funcs}
+    nodes = {}
+
+    # Skip until start
+    while lr.get() != '   -- Start of ' + type_name + '.\n':
+        pass
+
+    pat_decl = re.compile('   -- ' + prefix_name + '(\w+) \((\w+)\)\n')
+    pat_decls = re.compile('   -- ' + prefix_range_name + '(\w+) \((\w+)\)\n')
+    pat_comment_line = re.compile('   --+\n')
+    pat_comment_box = re.compile('   --(  .*)?\n')
+    while True:
+        l = lr.get()
+        if l == '   -- End of ' + type_name + '.\n':
+            return nodes
+        if l == '\n':
+            continue
+        m = pat_decl.match(l)
+        if m:
+            # List of nodes being described by the current description.
+            names = []
+
+            # Declaration of the first node
+            while True:
+                name=m.group(1)
+                if not name in kinds:
+                    raise ParseError(lr, 'unknown node')
+                fmt=m.group(2)
+                names.append((name,fmt))
+                # There might be several nodes described at once.
+                l = lr.get()
+                m = pat_decl.match(l)
+                if not m:
+                    break
+            read_nodes_fields(lr, names, fields, nodes, funcs_dict)
+            continue
+        m = pat_decls.match(l)
+        if m:
+            # List of nodes being described by the current description.
+            name=m.group(1)
+            fmt=m.group(2)
+            names = [(k,fmt) for k in kinds_ranges[name]]
+            l = lr.get()
+            read_nodes_fields(lr, names, fields, nodes, funcs_dict)
+            continue
+        if pat_comment_line.match(l) or pat_comment_box.match(l):
+            continue
+        raise ParseError(lr, 'bad line in node description')
+    return nodes
+
+# Generate a choice 'when A | B ... Z =>' using elements of CHOICES.
+def gen_choices(choices):
+    is_first=True
+    for c in choices:
+        if is_first:
+            print '        ',
+            print 'when',
+        else:
+            print
+            print '        ',
+            print '  |',
+        print prefix_name + c,
+        is_first=None
+    print '=>'
+
+# Generate the Get_Format function.
+def gen_get_format(formats, nodes, kinds):
+    print '   function Get_Format (Kind : ' + type_name + ') ' + \
+          'return Format_Type is'
+    print '   begin'
+    print '      case Kind is'
+    for f in formats:
+        choices = [k for k in kinds if nodes[k].format == f]
+        gen_choices(choices)
+        print '            return Format_' + f + ';'
+    print '      end case;'
+    print '   end Get_Format;'
+
+def gen_subprg_header(decl):
+    if len(decl) < 76:
+        print decl + ' is'
+    else:
+        print decl
+        print '   is'
+    print '   begin'
+
+def gen_assert(func):
+    print '      pragma Assert (' + func.pname + ' /= Null_Iir);'
+    cond = '(Has_' + func.name + ' (Get_Kind (' + func.pname + ')));'
+    if len (cond) < 60:
+        print '      pragma Assert ' + cond
+    else:
+        print '      pragma Assert'
+        print '         ' + cond
+
+# Generate Get_XXX/Set_XXX subprograms for FUNC.
+def gen_get_set(func, nodes, fields):
+    g = 'Get_' + func.field + ' (' + func.pname + ')'
+    s = func.rname
+    if func.conv:
+        field_type = None
+        for fld in fields.values():
+            if func.field in fld:
+                field_type = fld[func.field]
+                break
+        if func.conv == 'uc':
+            g = field_type + '_To_' + func.rtype + ' (' + g + ')'
+            s = func.rtype + '_To_' + field_type + ' (' + s + ')'
+        elif func.conv == 'pos':
+            g = func.rtype + "'Val (" + g + ')'
+            s = func.rtype + "'Pos (" + s + ')'
+
+    subprg = '   function Get_' + func.name + ' (' + func.pname \
+          + ' : ' + func.ptype + ') return ' + func.rtype
+    gen_subprg_header(subprg)
+    gen_assert(func)
+    print '      return ' + g + ';'
+    print '   end Get_' + func.name + ';'
+    print
+    subprg =  '   procedure Set_' + func.name + ' (' \
+          + func.pname + ' : ' + func.ptype + '; ' \
+          + func.rname + ' : ' + func.rtype + ')'
+    gen_subprg_header(subprg)
+    gen_assert(func)
+    print '      Set_' + func.field + ' (' + func.pname + ', ' + s + ');'
+    print '   end Set_' + func.name + ';'
+    print
+
+def funcs_of_node(n):
+    return sorted([fv.name for fv in n.fields.values() if fv])
+
+def gen_has_func_spec(name, suff):
+    spec='   function Has_' + f.name + ' (K : Iir_Kind)'
+    ret=' return Boolean' + suff;
+    if len(spec) < 60:
+        print spec + ret
+    else:
+        print spec
+        print '     ' + ret
+
+parser = argparse.ArgumentParser(description='Meta-grammar processor')
+parser.add_argument('action', choices=['disp-nodes', 'disp-kinds',
+                                       'disp-formats', 'disp-funcs',
+                                       'disp-types',
+                                       'get_format', 'body',
+                                       'meta_specs', 'meta_body'],
+                    default='disp-nodes')
+args = parser.parse_args()
+
+try:
+    (formats, fields) = read_fields(field_file)
+    (kinds, kinds_ranges, funcs) = read_kinds(spec_file)
+    nodes = read_nodes(spec_file,kinds,kinds_ranges,fields,funcs)
+
+except ParseError as e:
+    print >> sys.stderr, e
+    print >> sys.stderr, \
+          "in {0}:{1}:{2}".format(e.lr.filename, e.lr.lineno, e.lr.l)
+    sys.exit(1)
+
+if args.action == 'disp-formats':
+    for fmt in fields:
+        print "Fields of Format_"+fmt
+        fld=fields[fmt]
+        for k in fld:
+            print '  ' + k + ' (' + fld[k] + ')'
+elif args.action == 'disp-kinds':
+    print "Kinds are:"
+    for k in kinds:
+        print '  ' + prefix_name + k
+elif args.action == 'disp-funcs':
+    print "Functions are:"
+    for f in funcs:
+        s = '{0} ({1}: {2}'.format(f.name, f.field, f.rtype)
+        if f.acc:
+            s += ' acc:' + f.acc
+        if f.conv:
+            s += ' conv:' + f.conv
+        s += ')'
+        print s
+elif args.action == 'disp-types':
+    print "Types are:"
+    s = set([])
+    for f in funcs:
+        s |= set([f.rtype])
+    for t in sorted(s):
+        print '  ' + t
+elif args.action == 'disp-nodes':
+    for k in kinds:
+        v = nodes[k]
+        print prefix_name + k + ' (' + v.format + ')'
+        flds = [fk for fk, fv in v.fields.items() if fv]
+        for fk in sorted(flds):
+            print '  ' + fk + ': '+ v.fields[fk].name
+elif args.action == 'get_format':
+    gen_get_format(formats, nodes)
+elif args.action == 'body':
+    lr = linereader(template_file)
+    while True:
+        l = lr.get().rstrip()
+        print l
+        if l == '   --  Subprograms':
+            gen_get_format(formats, nodes, kinds)
+            print
+            for f in funcs:
+                gen_get_set(f, nodes, fields)
+        if l[0:3] == 'end':
+            break
+elif args.action == 'meta_specs':
+    lr = linereader(meta_base_file + '.ads.in')
+    # Build list of types
+    s = set([])
+    for f in funcs:
+        s |= set([f.rtype])
+    types = [t for t in sorted(s)]
+    while True:
+        l = lr.get().rstrip()
+        if l == '      --  TYPES':
+            last = None
+            for t in types:
+                if last:
+                    print last + ','
+                last = '      Type_' + t
+            print last
+        elif l == '      --  FIELDS':
+            last = None
+            for f in funcs:
+                if last:
+                    print last + ','
+                last = '      Field_' + f.name
+            print last
+        elif l == '   --  FUNCS':
+            for t in types:
+                print '   function Get_' + t
+                print '      (N : Iir; F : Fields_Enum) return ' + t + ';'
+                print '   procedure Set_' + t
+                print '      (N : Iir; F : Fields_Enum; V: ' + t + ');'
+                print
+            for f in funcs:
+                gen_has_func_spec(f.name, ';')
+        elif l[0:3] == 'end':
+            print l
+            break
+        else:
+            print l
+elif args.action == 'meta_body':
+    lr = linereader(meta_base_file + '.adb.in')
+    while True:
+        l = lr.get().rstrip()
+        if l == '      --  FIELDS_TYPE':
+            last = None
+            for f in funcs:
+                if last:
+                    print last + ','
+                last = '      Field_' + f.name + ' => Type_' + f.rtype
+            print last
+        elif l == '         --  FIELD_IMAGE':
+            for f in funcs:
+                print '         when Field_' + f.name + ' =>'
+                print '            return "' + f.name.lower() + '";'
+        elif l == '         --  IIR_IMAGE':
+            for k in kinds:
+                print '         when ' + prefix_name + k + ' =>'
+                print '            return "' + k.lower() + '";'
+        elif l == '         --  FIELD_ATTRIBUTE':
+            for f in funcs:
+                print '         when Field_' + f.name + ' =>'
+                if f.acc:
+                    attr = f.acc
+                else:
+                    attr = 'None'
+                print '            return Attr_' + attr + ';'
+        elif l == '      --  FIELDS_ARRAY':
+            last = None
+            nodes_types = ['Iir', 'Iir_List']
+            ref_names = ['Ref', 'Of_Ref', 'Maybe_Ref']
+            for k in kinds:
+                v = nodes[k]
+                if last:
+                    print last + ','
+                last = None
+                print '      --  ' + prefix_name + k
+                # Sort fields: first non Iir and non Iir_List,
+                #              then Iir and Iir_List that aren't references
+                #              then Maybe_Ref
+                #              then Ref and Ref_Of
+                flds = sorted([fk for fk, fv in v.fields.items() \
+                               if fv and fv.rtype not in nodes_types])
+                flds += sorted([fk for fk, fv in v.fields.items() \
+                                if fv and fv.rtype in nodes_types \
+                                      and fv.acc not in ref_names])
+                flds += sorted([fk for fk, fv in v.fields.items() \
+                                if fv and fv.rtype in nodes_types\
+                                      and fv.acc in ['Maybe_Ref']])
+                flds += sorted([fk for fk, fv in v.fields.items() \
+                                if fv and fv.rtype in nodes_types\
+                                      and fv.acc in ['Ref', 'Of_Ref']])
+                for fk in flds:
+                    if last:
+                        print last + ','
+                    last = '      Field_' + v.fields[fk].name
+            if last:
+                print last
+        elif l == '      --  FIELDS_ARRAY_POS':
+            pos = -1
+            last = None
+            for k in kinds:
+                v = nodes[k]
+                flds = [fk for fk, fv in v.fields.items() if fv]
+                pos += len(flds)
+                if last:
+                    print last + ','
+                last = '      ' + prefix_name + k + ' => {}'.format(pos)
+            print last
+        elif l == '   --  FUNCS_BODY':
+            # Build list of types
+            s = set([])
+            for f in funcs:
+                s |= set([f.rtype])
+            types = [t for t in sorted(s)]
+            for t in types:
+                print '   function Get_' + t
+                print '      (N : Iir; F : Fields_Enum) return ' + t + ' is'
+                print '   begin'
+                print '      pragma Assert (Fields_Type (F) = Type_' + t + ');'
+                print '      case F is'
+                for f in funcs:
+                    if f.rtype == t:
+                        print '         when Field_' + f.name + ' =>'
+                        print '            return Get_' + f.name + ' (N);';
+                print '         when others =>'
+                print '            raise Internal_Error;'
+                print '      end case;'
+                print '   end Get_' + t + ';'
+                print
+                print '   procedure Set_' + t
+                print '      (N : Iir; F : Fields_Enum; V: ' + t + ') is'
+                print '   begin'
+                print '      pragma Assert (Fields_Type (F) = Type_' + t + ');'
+                print '      case F is'
+                for f in funcs:
+                    if f.rtype == t:
+                        print '         when Field_' + f.name + ' =>'
+                        print '            Set_' + f.name + ' (N, V);';
+                print '         when others =>'
+                print '            raise Internal_Error;'
+                print '      end case;'
+                print '   end Set_' + t + ';'
+                print
+            for f in funcs:
+                gen_has_func_spec(f.name, ' is')
+                print '   begin'
+                choices = [k for k in kinds if f.name in nodes[k].attrs]
+                if len(choices) == 1:
+                    print '      return K = ' + prefix_name + choices[0] + ';'
+                else:
+                    print '      case K is'
+                    gen_choices(choices)
+                    print '            return True;'
+                    print '         when others =>'
+                    print '            return False;'
+                    print '      end case;'
+                print '   end Has_' + f.name + ';'
+                print
+        elif l[0:3] == 'end':
+            print l
+            break
+        else:
+            print l